{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies,
FlexibleContexts, ScopedTypeVariables #-}
module Text.XML.Expat.Annotated (
Node,
NodeG(..),
UNode,
LNode,
ULNode,
module Text.XML.Expat.Internal.NodeClass,
modifyAnnotation,
mapAnnotation,
QNode,
QLNode,
module Text.XML.Expat.Internal.Qualified,
NNode,
NLNode,
module Text.XML.Expat.Internal.Namespaced,
ParseOptions(..),
defaultParseOptions,
Encoding(..),
parse,
parse',
parseG,
XMLParseError(..),
XMLParseLocation(..),
parseThrowing,
XMLParseException(..),
saxToTree,
saxToTreeG,
GenericXMLString(..)
) where
import Control.Arrow (first)
import Text.XML.Expat.SAX ( Encoding(..)
, GenericXMLString(..)
, ParseOptions(..)
, defaultParseOptions
, SAXEvent(..)
, XMLParseError(..)
, XMLParseException(..)
, XMLParseLocation(..) )
import qualified Text.XML.Expat.SAX as SAX
import Text.XML.Expat.Internal.Namespaced
import Text.XML.Expat.Internal.NodeClass
import Text.XML.Expat.Internal.Qualified
import Control.Monad (mplus, mzero)
import Control.DeepSeq
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.List.Class (List(..), ListItem(..), cons, foldlL, joinM)
import Data.Monoid
data NodeG a c tag text =
Element {
forall a (c :: * -> *) tag text. NodeG a c tag text -> tag
eName :: !tag,
forall a (c :: * -> *) tag text.
NodeG a c tag text -> [(tag, text)]
eAttributes :: ![(tag,text)],
forall a (c :: * -> *) tag text.
NodeG a c tag text -> c (NodeG a c tag text)
eChildren :: c (NodeG a c tag text),
forall a (c :: * -> *) tag text. NodeG a c tag text -> a
eAnn :: a
} |
Text !text
type instance ListOf (NodeG a c tag text) = c (NodeG a c tag text)
type Node a tag text = NodeG a [] tag text
instance (Show tag, Show text, Show a) => Show (NodeG a [] tag text) where
showsPrec :: Int -> NodeG a [] tag text -> ShowS
showsPrec Int
d (Element tag
na [(tag, text)]
at [NodeG a [] tag text]
ch a
an) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
(String
"Element "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> tag -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 tag
na ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [(tag, text)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(tag, text)]
at ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [NodeG a [] tag text] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [NodeG a [] tag text]
ch ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
an
showsPrec Int
d (Text text
t) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String
"Text "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 text
t
instance (Eq tag, Eq text, Eq a) => Eq (NodeG a [] tag text) where
Element tag
na1 [(tag, text)]
at1 [NodeG a [] tag text]
ch1 a
an1 == :: NodeG a [] tag text -> NodeG a [] tag text -> Bool
== Element tag
na2 [(tag, text)]
at2 [NodeG a [] tag text]
ch2 a
an2 =
tag
na1 tag -> tag -> Bool
forall a. Eq a => a -> a -> Bool
== tag
na2 Bool -> Bool -> Bool
&&
[(tag, text)]
at1 [(tag, text)] -> [(tag, text)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(tag, text)]
at2 Bool -> Bool -> Bool
&&
[NodeG a [] tag text]
ch1 [NodeG a [] tag text] -> [NodeG a [] tag text] -> Bool
forall a. Eq a => a -> a -> Bool
== [NodeG a [] tag text]
ch2 Bool -> Bool -> Bool
&&
a
an1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
an2
Text text
t1 == Text text
t2 = text
t1 text -> text -> Bool
forall a. Eq a => a -> a -> Bool
== text
t2
NodeG a [] tag text
_ == NodeG a [] tag text
_ = Bool
False
instance (NFData tag, NFData text, NFData a) => NFData (NodeG a [] tag text) where
rnf :: NodeG a [] tag text -> ()
rnf (Element tag
nam [(tag, text)]
att [NodeG a [] tag text]
chi a
ann) = (tag, [(tag, text)], [NodeG a [] tag text], a) -> ()
forall a. NFData a => a -> ()
rnf (tag
nam, [(tag, text)]
att, [NodeG a [] tag text]
chi, a
ann)
rnf (Text text
txt) = text -> ()
forall a. NFData a => a -> ()
rnf text
txt
instance (Functor c, List c) => NodeClass (NodeG a) c where
textContentM :: forall text tag. Monoid text => NodeG a c tag text -> ItemM c text
textContentM (Element tag
_ [(tag, text)]
_ c (NodeG a c tag text)
children a
_) = (text -> text -> text) -> text -> c text -> ItemM c text
forall (l :: * -> *) a b.
List l =>
(a -> b -> a) -> a -> l b -> ItemM l a
foldlL text -> text -> text
forall a. Monoid a => a -> a -> a
mappend text
forall a. Monoid a => a
mempty (c text -> ItemM c text) -> c text -> ItemM c text
forall a b. (a -> b) -> a -> b
$ c (ItemM c text) -> c text
forall (l :: * -> *) a. List l => l (ItemM l a) -> l a
joinM (c (ItemM c text) -> c text) -> c (ItemM c text) -> c text
forall a b. (a -> b) -> a -> b
$ (NodeG a c tag text -> ItemM c text)
-> c (NodeG a c tag text) -> c (ItemM c text)
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeG a c tag text -> ItemM c text
forall text tag. Monoid text => NodeG a c tag text -> ItemM c text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> ItemM c text
textContentM c (NodeG a c tag text)
children
textContentM (Text text
txt) = text -> ItemM c text
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return text
txt
isElement :: forall tag text. NodeG a c tag text -> Bool
isElement (Element tag
_ [(tag, text)]
_ c (NodeG a c tag text)
_ a
_) = Bool
True
isElement NodeG a c tag text
_ = Bool
False
isText :: forall tag text. NodeG a c tag text -> Bool
isText (Text text
_) = Bool
True
isText NodeG a c tag text
_ = Bool
False
isCData :: forall tag text. NodeG a c tag text -> Bool
isCData NodeG a c tag text
_ = Bool
False
isProcessingInstruction :: forall tag text. NodeG a c tag text -> Bool
isProcessingInstruction NodeG a c tag text
_ = Bool
False
isComment :: forall tag text. NodeG a c tag text -> Bool
isComment NodeG a c tag text
_ = Bool
False
isNamed :: forall tag text. Eq tag => tag -> NodeG a c tag text -> Bool
isNamed tag
_ (Text text
_) = Bool
False
isNamed tag
nm (Element tag
nm' [(tag, text)]
_ c (NodeG a c tag text)
_ a
_) = tag
nm tag -> tag -> Bool
forall a. Eq a => a -> a -> Bool
== tag
nm'
getName :: forall tag text. Monoid tag => NodeG a c tag text -> tag
getName (Text text
_) = tag
forall a. Monoid a => a
mempty
getName (Element tag
name [(tag, text)]
_ c (NodeG a c tag text)
_ a
_) = tag
name
hasTarget :: forall text tag. Eq text => text -> NodeG a c tag text -> Bool
hasTarget text
_ NodeG a c tag text
_ = Bool
False
getTarget :: forall text tag. Monoid text => NodeG a c tag text -> text
getTarget NodeG a c tag text
_ = text
forall a. Monoid a => a
mempty
getAttributes :: forall tag text. NodeG a c tag text -> [(tag, text)]
getAttributes (Text text
_) = []
getAttributes (Element tag
_ [(tag, text)]
attrs c (NodeG a c tag text)
_ a
_) = [(tag, text)]
attrs
getChildren :: forall tag text. NodeG a c tag text -> c (NodeG a c tag text)
getChildren (Text text
_) = c (NodeG a c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
getChildren (Element tag
_ [(tag, text)]
_ c (NodeG a c tag text)
ch a
_) = c (NodeG a c tag text)
ch
getText :: forall text tag. Monoid text => NodeG a c tag text -> text
getText (Text text
txt) = text
txt
getText (Element tag
_ [(tag, text)]
_ c (NodeG a c tag text)
_ a
_) = text
forall a. Monoid a => a
mempty
modifyName :: forall tag text.
(tag -> tag) -> NodeG a c tag text -> NodeG a c tag text
modifyName tag -> tag
_ node :: NodeG a c tag text
node@(Text text
_) = NodeG a c tag text
node
modifyName tag -> tag
f (Element tag
n [(tag, text)]
a c (NodeG a c tag text)
c a
ann) = tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element (tag -> tag
f tag
n) [(tag, text)]
a c (NodeG a c tag text)
c a
ann
modifyAttributes :: forall tag text.
([(tag, text)] -> [(tag, text)])
-> NodeG a c tag text -> NodeG a c tag text
modifyAttributes [(tag, text)] -> [(tag, text)]
_ node :: NodeG a c tag text
node@(Text text
_) = NodeG a c tag text
node
modifyAttributes [(tag, text)] -> [(tag, text)]
f (Element tag
n [(tag, text)]
a c (NodeG a c tag text)
c a
ann) = tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
n ([(tag, text)] -> [(tag, text)]
f [(tag, text)]
a) c (NodeG a c tag text)
c a
ann
modifyChildren :: forall tag text.
(c (NodeG a c tag text) -> c (NodeG a c tag text))
-> NodeG a c tag text -> NodeG a c tag text
modifyChildren c (NodeG a c tag text) -> c (NodeG a c tag text)
_ node :: NodeG a c tag text
node@(Text text
_) = NodeG a c tag text
node
modifyChildren c (NodeG a c tag text) -> c (NodeG a c tag text)
f (Element tag
n [(tag, text)]
a c (NodeG a c tag text)
c a
ann) = tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
n [(tag, text)]
a (c (NodeG a c tag text) -> c (NodeG a c tag text)
f c (NodeG a c tag text)
c) a
ann
mapAllTags :: forall tag tag' text.
(tag -> tag') -> NodeG a c tag text -> NodeG a c tag' text
mapAllTags tag -> tag'
_ (Text text
t) = text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
t
mapAllTags tag -> tag'
f (Element tag
n [(tag, text)]
a c (NodeG a c tag text)
c a
ann) = tag'
-> [(tag', text)]
-> c (NodeG a c tag' text)
-> a
-> NodeG a c tag' text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element (tag -> tag'
f tag
n) (((tag, text) -> (tag', text)) -> [(tag, text)] -> [(tag', text)]
forall a b. (a -> b) -> [a] -> [b]
map ((tag -> tag') -> (tag, text) -> (tag', text)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first tag -> tag'
f) [(tag, text)]
a) ((NodeG a c tag text -> NodeG a c tag' text)
-> c (NodeG a c tag text) -> c (NodeG a c tag' text)
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((tag -> tag') -> NodeG a c tag text -> NodeG a c tag' text
forall tag tag' text.
(tag -> tag') -> NodeG a c tag text -> NodeG a c tag' text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag tag' text.
NodeClass n c =>
(tag -> tag') -> n c tag text -> n c tag' text
mapAllTags tag -> tag'
f) c (NodeG a c tag text)
c) a
ann
modifyElement :: forall tag text tag'.
((tag, [(tag, text)], c (NodeG a c tag text))
-> (tag', [(tag', text)], c (NodeG a c tag' text)))
-> NodeG a c tag text -> NodeG a c tag' text
modifyElement (tag, [(tag, text)], c (NodeG a c tag text))
-> (tag', [(tag', text)], c (NodeG a c tag' text))
_ (Text text
t) = text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
t
modifyElement (tag, [(tag, text)], c (NodeG a c tag text))
-> (tag', [(tag', text)], c (NodeG a c tag' text))
f (Element tag
n [(tag, text)]
a c (NodeG a c tag text)
c a
ann) =
let (tag'
n', [(tag', text)]
a', c (NodeG a c tag' text)
c') = (tag, [(tag, text)], c (NodeG a c tag text))
-> (tag', [(tag', text)], c (NodeG a c tag' text))
f (tag
n, [(tag, text)]
a, c (NodeG a c tag text)
c)
in tag'
-> [(tag', text)]
-> c (NodeG a c tag' text)
-> a
-> NodeG a c tag' text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag'
n' [(tag', text)]
a' c (NodeG a c tag' text)
c' a
ann
mapNodeContainer :: forall (c' :: * -> *) tag text.
List c' =>
(forall a. c a -> ItemM c (c' a))
-> NodeG a c tag text -> ItemM c (NodeG a c' tag text)
mapNodeContainer forall a. c a -> ItemM c (c' a)
f (Element tag
n [(tag, text)]
a c (NodeG a c tag text)
ch a
an) = do
c' (NodeG a c' tag text)
ch' <- (forall a. c a -> ItemM c (c' a))
-> c (NodeG a c tag text) -> ItemM c (c' (NodeG a c' tag text))
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) (c' :: * -> *)
tag text.
(NodeClass n c, List c') =>
(forall a. c a -> ItemM c (c' a))
-> c (n c tag text) -> ItemM c (c' (n c' tag text))
mapNodeListContainer c a -> ItemM c (c' a)
forall a. c a -> ItemM c (c' a)
f c (NodeG a c tag text)
ch
NodeG a c' tag text -> ItemM c (NodeG a c' tag text)
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeG a c' tag text -> ItemM c (NodeG a c' tag text))
-> NodeG a c' tag text -> ItemM c (NodeG a c' tag text)
forall a b. (a -> b) -> a -> b
$ tag
-> [(tag, text)]
-> c' (NodeG a c' tag text)
-> a
-> NodeG a c' tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
n [(tag, text)]
a c' (NodeG a c' tag text)
ch' a
an
mapNodeContainer forall a. c a -> ItemM c (c' a)
_ (Text text
t) = NodeG a c' tag text -> ItemM c (NodeG a c' tag text)
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeG a c' tag text -> ItemM c (NodeG a c' tag text))
-> NodeG a c' tag text -> ItemM c (NodeG a c' tag text)
forall a b. (a -> b) -> a -> b
$ text -> NodeG a c' tag text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
t
mkText :: forall text tag. text -> NodeG a c tag text
mkText = text -> NodeG a c tag text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text
instance (Functor c, List c) => MkElementClass (NodeG (Maybe a)) c where
mkElement :: forall tag text.
tag
-> Attributes tag text
-> c (NodeG (Maybe a) c tag text)
-> NodeG (Maybe a) c tag text
mkElement tag
name Attributes tag text
attrs c (NodeG (Maybe a) c tag text)
children = tag
-> Attributes tag text
-> c (NodeG (Maybe a) c tag text)
-> Maybe a
-> NodeG (Maybe a) c tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
name Attributes tag text
attrs c (NodeG (Maybe a) c tag text)
children Maybe a
forall a. Maybe a
Nothing
instance (Functor c, List c) => MkElementClass (NodeG ()) c where
mkElement :: forall tag text.
tag
-> Attributes tag text
-> c (NodeG () c tag text)
-> NodeG () c tag text
mkElement tag
name Attributes tag text
attrs c (NodeG () c tag text)
children = tag
-> Attributes tag text
-> c (NodeG () c tag text)
-> ()
-> NodeG () c tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
name Attributes tag text
attrs c (NodeG () c tag text)
children ()
type UNode a text = Node a text text
type LNode tag text = Node XMLParseLocation tag text
type ULNode text = LNode text text
type QNode a text = Node a (QName text) text
type QLNode text = LNode (QName text) text
type NNode a text = Node a (NName text) text
type NLNode text = LNode (NName text) text
modifyAnnotation :: (a -> a) -> Node a tag text -> Node a tag text
a -> a
f modifyAnnotation :: forall a tag text. (a -> a) -> Node a tag text -> Node a tag text
`modifyAnnotation` Element tag
na [(tag, text)]
at [NodeG a [] tag text]
ch a
an = tag
-> [(tag, text)]
-> [NodeG a [] tag text]
-> a
-> NodeG a [] tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
na [(tag, text)]
at [NodeG a [] tag text]
ch (a -> a
f a
an)
a -> a
_ `modifyAnnotation` Text text
t = text -> NodeG a [] tag text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
t
mapAnnotation :: (a -> b) -> Node a tag text -> Node b tag text
a -> b
f mapAnnotation :: forall a b tag text. (a -> b) -> Node a tag text -> Node b tag text
`mapAnnotation` Element tag
na [(tag, text)]
at [NodeG a [] tag text]
ch a
an = tag
-> [(tag, text)]
-> [NodeG b [] tag text]
-> b
-> NodeG b [] tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
na [(tag, text)]
at ((NodeG a [] tag text -> NodeG b [] tag text)
-> [NodeG a [] tag text] -> [NodeG b [] tag text]
forall a b. (a -> b) -> [a] -> [b]
map (a -> b
f (a -> b) -> NodeG a [] tag text -> NodeG b [] tag text
forall a b tag text. (a -> b) -> Node a tag text -> Node b tag text
`mapAnnotation`) [NodeG a [] tag text]
ch) (a -> b
f a
an)
a -> b
_ `mapAnnotation` Text text
t = text -> NodeG b [] tag text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
t
saxToTree :: GenericXMLString tag =>
[(SAXEvent tag text, a)]
-> (Node a tag text, Maybe XMLParseError)
saxToTree :: forall tag text a.
GenericXMLString tag =>
[(SAXEvent tag text, a)] -> (Node a tag text, Maybe XMLParseError)
saxToTree [(SAXEvent tag text, a)]
events =
let ([NodeG a [] tag text]
nodes, Maybe XMLParseError
mError, [(SAXEvent tag text, a)]
_) = [(SAXEvent tag text, a)]
-> ([NodeG a [] tag text], Maybe XMLParseError,
[(SAXEvent tag text, a)])
forall {tag} {text} {a}.
[(SAXEvent tag text, a)]
-> ([NodeG a [] tag text], Maybe XMLParseError,
[(SAXEvent tag text, a)])
ptl [(SAXEvent tag text, a)]
events
in ([NodeG a [] tag text] -> NodeG a [] tag text
forall {tag} {a} {text}.
GenericXMLString tag =>
[NodeG a [] tag text] -> NodeG a [] tag text
findRoot [NodeG a [] tag text]
nodes, Maybe XMLParseError
mError)
where
findRoot :: [NodeG a [] tag text] -> NodeG a [] tag text
findRoot (elt :: NodeG a [] tag text
elt@(Element tag
_ [(tag, text)]
_ [NodeG a [] tag text]
_ a
_):[NodeG a [] tag text]
_) = NodeG a [] tag text
elt
findRoot (NodeG a [] tag text
_:[NodeG a [] tag text]
nodes) = [NodeG a [] tag text] -> NodeG a [] tag text
findRoot [NodeG a [] tag text]
nodes
findRoot [] = tag
-> [(tag, text)]
-> [NodeG a [] tag text]
-> a
-> NodeG a [] tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element (String -> tag
forall s. GenericXMLString s => String -> s
gxFromString String
"") [] [] (String -> a
forall a. HasCallStack => String -> a
error String
"saxToTree null annotation")
ptl :: [(SAXEvent tag text, a)]
-> ([NodeG a [] tag text], Maybe XMLParseError,
[(SAXEvent tag text, a)])
ptl ((StartElement tag
name [(tag, text)]
attrs, a
ann):[(SAXEvent tag text, a)]
rema) =
let ([NodeG a [] tag text]
children, Maybe XMLParseError
err1, [(SAXEvent tag text, a)]
rema') = [(SAXEvent tag text, a)]
-> ([NodeG a [] tag text], Maybe XMLParseError,
[(SAXEvent tag text, a)])
ptl [(SAXEvent tag text, a)]
rema
elt :: NodeG a [] tag text
elt = tag
-> [(tag, text)]
-> [NodeG a [] tag text]
-> a
-> NodeG a [] tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
name [(tag, text)]
attrs [NodeG a [] tag text]
children a
ann
([NodeG a [] tag text]
out, Maybe XMLParseError
err2, [(SAXEvent tag text, a)]
rema'') = [(SAXEvent tag text, a)]
-> ([NodeG a [] tag text], Maybe XMLParseError,
[(SAXEvent tag text, a)])
ptl [(SAXEvent tag text, a)]
rema'
in (NodeG a [] tag text
eltNodeG a [] tag text
-> [NodeG a [] tag text] -> [NodeG a [] tag text]
forall a. a -> [a] -> [a]
:[NodeG a [] tag text]
out, Maybe XMLParseError
err1 Maybe XMLParseError -> Maybe XMLParseError -> Maybe XMLParseError
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe XMLParseError
err2, [(SAXEvent tag text, a)]
rema'')
ptl ((EndElement tag
_, a
_):[(SAXEvent tag text, a)]
rema) = ([], Maybe XMLParseError
forall a. Maybe a
Nothing, [(SAXEvent tag text, a)]
rema)
ptl ((CharacterData text
txt, a
_):[(SAXEvent tag text, a)]
rema) =
let ([NodeG a [] tag text]
out, Maybe XMLParseError
err, [(SAXEvent tag text, a)]
rema') = [(SAXEvent tag text, a)]
-> ([NodeG a [] tag text], Maybe XMLParseError,
[(SAXEvent tag text, a)])
ptl [(SAXEvent tag text, a)]
rema
in (text -> NodeG a [] tag text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
txtNodeG a [] tag text
-> [NodeG a [] tag text] -> [NodeG a [] tag text]
forall a. a -> [a] -> [a]
:[NodeG a [] tag text]
out, Maybe XMLParseError
err, [(SAXEvent tag text, a)]
rema')
ptl ((FailDocument XMLParseError
err, a
_):[(SAXEvent tag text, a)]
_) = ([], XMLParseError -> Maybe XMLParseError
forall a. a -> Maybe a
Just XMLParseError
err, [])
ptl ((SAXEvent tag text, a)
_:[(SAXEvent tag text, a)]
rema) = [(SAXEvent tag text, a)]
-> ([NodeG a [] tag text], Maybe XMLParseError,
[(SAXEvent tag text, a)])
ptl [(SAXEvent tag text, a)]
rema
ptl [] = ([], Maybe XMLParseError
forall a. Maybe a
Nothing, [])
saxToTreeG :: forall l a tag text . (GenericXMLString tag, List l, Monad (ItemM l)) =>
l (SAXEvent tag text, a)
-> ItemM l (NodeG a l tag text)
saxToTreeG :: forall (l :: * -> *) a tag text.
(GenericXMLString tag, List l, Monad (ItemM l)) =>
l (SAXEvent tag text, a) -> ItemM l (NodeG a l tag text)
saxToTreeG l (SAXEvent tag text, a)
events = do
(l (NodeG a l tag text)
elts, l (SAXEvent tag text, a)
_) <- l (SAXEvent tag text, a)
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
process l (SAXEvent tag text, a)
events
l (NodeG a l tag text) -> ItemM l (NodeG a l tag text)
findRoot l (NodeG a l tag text)
elts
where
findRoot :: l (NodeG a l tag text) -> ItemM l (NodeG a l tag text)
findRoot :: l (NodeG a l tag text) -> ItemM l (NodeG a l tag text)
findRoot l (NodeG a l tag text)
elts = do
ListItem l (NodeG a l tag text)
li <- l (NodeG a l tag text) -> ItemM l (ListItem l (NodeG a l tag text))
forall a. l a -> ItemM l (ListItem l a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList l (NodeG a l tag text)
elts
case ListItem l (NodeG a l tag text)
li of
Cons elt :: NodeG a l tag text
elt@(Element tag
_ [(tag, text)]
_ l (NodeG a l tag text)
_ a
_) l (NodeG a l tag text)
_ -> NodeG a l tag text -> ItemM l (NodeG a l tag text)
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeG a l tag text
elt
Cons NodeG a l tag text
_ l (NodeG a l tag text)
rema -> l (NodeG a l tag text) -> ItemM l (NodeG a l tag text)
findRoot l (NodeG a l tag text)
rema
ListItem l (NodeG a l tag text)
Nil -> NodeG a l tag text -> ItemM l (NodeG a l tag text)
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeG a l tag text -> ItemM l (NodeG a l tag text))
-> NodeG a l tag text -> ItemM l (NodeG a l tag text)
forall a b. (a -> b) -> a -> b
$ tag
-> [(tag, text)]
-> l (NodeG a l tag text)
-> a
-> NodeG a l tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element (String -> tag
forall s. GenericXMLString s => String -> s
gxFromString String
"") [(tag, text)]
forall a. [a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero l (NodeG a l tag text)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero (String -> a
forall a. HasCallStack => String -> a
error String
"saxToTree null annotation")
process :: l (SAXEvent tag text, a)
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
process :: l (SAXEvent tag text, a)
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
process l (SAXEvent tag text, a)
events = do
ListItem l (SAXEvent tag text, a)
li <- l (SAXEvent tag text, a)
-> ItemM l (ListItem l (SAXEvent tag text, a))
forall a. l a -> ItemM l (ListItem l a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList l (SAXEvent tag text, a)
events
case ListItem l (SAXEvent tag text, a)
li of
ListItem l (SAXEvent tag text, a)
Nil -> (l (NodeG a l tag text), l (SAXEvent tag text, a))
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (l (NodeG a l tag text)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero, l (SAXEvent tag text, a)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
Cons (StartElement tag
name [(tag, text)]
attrs, a
ann) l (SAXEvent tag text, a)
rema -> do
(l (NodeG a l tag text)
children, l (SAXEvent tag text, a)
rema') <- l (SAXEvent tag text, a)
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
process l (SAXEvent tag text, a)
rema
(l (NodeG a l tag text)
out, l (SAXEvent tag text, a)
rema'') <- l (SAXEvent tag text, a)
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
process l (SAXEvent tag text, a)
rema'
(l (NodeG a l tag text), l (SAXEvent tag text, a))
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (tag
-> [(tag, text)]
-> l (NodeG a l tag text)
-> a
-> NodeG a l tag text
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
name [(tag, text)]
attrs l (NodeG a l tag text)
children a
ann NodeG a l tag text
-> l (NodeG a l tag text) -> l (NodeG a l tag text)
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
`cons` l (NodeG a l tag text)
out, l (SAXEvent tag text, a)
rema'')
Cons (EndElement tag
_, a
_) l (SAXEvent tag text, a)
rema -> (l (NodeG a l tag text), l (SAXEvent tag text, a))
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (l (NodeG a l tag text)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero, l (SAXEvent tag text, a)
rema)
Cons (CharacterData text
txt, a
_) l (SAXEvent tag text, a)
rema -> do
(l (NodeG a l tag text)
out, l (SAXEvent tag text, a)
rema') <- l (SAXEvent tag text, a)
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
process l (SAXEvent tag text, a)
rema
(l (NodeG a l tag text), l (SAXEvent tag text, a))
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (text -> NodeG a l tag text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
txt NodeG a l tag text
-> l (NodeG a l tag text) -> l (NodeG a l tag text)
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
`cons` l (NodeG a l tag text)
out, l (SAXEvent tag text, a)
rema')
Cons (SAXEvent tag text, a)
_ l (SAXEvent tag text, a)
rema -> l (SAXEvent tag text, a)
-> ItemM l (l (NodeG a l tag text), l (SAXEvent tag text, a))
process l (SAXEvent tag text, a)
rema
parse :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> L.ByteString
-> (LNode tag text, Maybe XMLParseError)
parse :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> (LNode tag text, Maybe XMLParseError)
parse ParseOptions tag text
opts ByteString
bs = [(SAXEvent tag text, XMLParseLocation)]
-> (Node XMLParseLocation tag text, Maybe XMLParseError)
forall tag text a.
GenericXMLString tag =>
[(SAXEvent tag text, a)] -> (Node a tag text, Maybe XMLParseError)
saxToTree ([(SAXEvent tag text, XMLParseLocation)]
-> (Node XMLParseLocation tag text, Maybe XMLParseError))
-> [(SAXEvent tag text, XMLParseLocation)]
-> (Node XMLParseLocation tag text, Maybe XMLParseError)
forall a b. (a -> b) -> a -> b
$ ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
SAX.parseLocations ParseOptions tag text
opts ByteString
bs
parseG :: (GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString
-> ItemM l (NodeG XMLParseLocation l tag text)
parseG :: forall tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString -> ItemM l (NodeG XMLParseLocation l tag text)
parseG ParseOptions tag text
opts = l (SAXEvent tag text, XMLParseLocation)
-> ItemM l (NodeG XMLParseLocation l tag text)
forall (l :: * -> *) a tag text.
(GenericXMLString tag, List l, Monad (ItemM l)) =>
l (SAXEvent tag text, a) -> ItemM l (NodeG a l tag text)
saxToTreeG (l (SAXEvent tag text, XMLParseLocation)
-> ItemM l (NodeG XMLParseLocation l tag text))
-> (l ByteString -> l (SAXEvent tag text, XMLParseLocation))
-> l ByteString
-> ItemM l (NodeG XMLParseLocation l tag text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseOptions tag text
-> l ByteString -> l (SAXEvent tag text, XMLParseLocation)
forall tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString -> l (SAXEvent tag text, XMLParseLocation)
SAX.parseLocationsG ParseOptions tag text
opts
parseThrowing :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> L.ByteString
-> LNode tag text
parseThrowing :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text -> ByteString -> LNode tag text
parseThrowing ParseOptions tag text
opts ByteString
bs = (LNode tag text, Maybe XMLParseError) -> LNode tag text
forall a b. (a, b) -> a
fst ((LNode tag text, Maybe XMLParseError) -> LNode tag text)
-> (LNode tag text, Maybe XMLParseError) -> LNode tag text
forall a b. (a -> b) -> a -> b
$ [(SAXEvent tag text, XMLParseLocation)]
-> (LNode tag text, Maybe XMLParseError)
forall tag text a.
GenericXMLString tag =>
[(SAXEvent tag text, a)] -> (Node a tag text, Maybe XMLParseError)
saxToTree ([(SAXEvent tag text, XMLParseLocation)]
-> (LNode tag text, Maybe XMLParseError))
-> [(SAXEvent tag text, XMLParseLocation)]
-> (LNode tag text, Maybe XMLParseError)
forall a b. (a -> b) -> a -> b
$ ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
SAX.parseLocationsThrowing ParseOptions tag text
opts ByteString
bs
parse' :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> B.ByteString
-> Either XMLParseError (LNode tag text)
parse' :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> Either XMLParseError (LNode tag text)
parse' ParseOptions tag text
opts ByteString
doc = case ParseOptions tag text
-> ByteString -> (LNode tag text, Maybe XMLParseError)
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> (LNode tag text, Maybe XMLParseError)
parse ParseOptions tag text
opts ([ByteString] -> ByteString
L.fromChunks [ByteString
doc]) of
(LNode tag text
xml, Maybe XMLParseError
Nothing) -> LNode tag text -> Either XMLParseError (LNode tag text)
forall a b. b -> Either a b
Right LNode tag text
xml
(LNode tag text
_, Just XMLParseError
err) -> XMLParseError -> Either XMLParseError (LNode tag text)
forall a b. a -> Either a b
Left XMLParseError
err