{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances,
MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables #-}
module Text.XML.Expat.Tree (
Node,
NodeG(..),
UNode,
module Text.XML.Expat.Internal.NodeClass,
QNode,
module Text.XML.Expat.Internal.Qualified,
NNode,
module Text.XML.Expat.Internal.Namespaced,
ParseOptions(..),
defaultParseOptions,
Encoding(..),
parse,
parse',
parseG,
XMLParseError(..),
XMLParseLocation(..),
parseThrowing,
XMLParseException(..),
saxToTree,
saxToTreeG,
GenericXMLString(..)
) where
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.Arrow
import Control.Monad (mplus, mzero)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import Data.List.Class
import Data.Monoid (Monoid,mempty,mappend)
import Control.DeepSeq
data NodeG c tag text =
Element {
forall (c :: * -> *) tag text. NodeG c tag text -> tag
eName :: !tag,
forall (c :: * -> *) tag text. NodeG c tag text -> [(tag, text)]
eAttributes :: ![(tag,text)],
forall (c :: * -> *) tag text.
NodeG c tag text -> c (NodeG c tag text)
eChildren :: c (NodeG c tag text)
} |
Text !text
type instance ListOf (NodeG c tag text) = c (NodeG c tag text)
instance (Show tag, Show text) => Show (NodeG [] tag text) where
showsPrec :: Int -> NodeG [] tag text -> ShowS
showsPrec Int
d (Element tag
na [(tag, text)]
at [NodeG [] tag text]
ch) = 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 [] tag text] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [NodeG [] tag text]
ch
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 (NodeG [] tag text) where
Element tag
na1 [(tag, text)]
at1 [NodeG [] tag text]
ch1 == :: NodeG [] tag text -> NodeG [] tag text -> Bool
== Element tag
na2 [(tag, text)]
at2 [NodeG [] tag text]
ch2 =
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 [] tag text]
ch1 [NodeG [] tag text] -> [NodeG [] tag text] -> Bool
forall a. Eq a => a -> a -> Bool
== [NodeG [] tag text]
ch2
Text text
t1 == Text text
t2 = text
t1 text -> text -> Bool
forall a. Eq a => a -> a -> Bool
== text
t2
NodeG [] tag text
_ == NodeG [] tag text
_ = Bool
False
type Node tag text = NodeG [] tag text
instance (NFData tag, NFData text) => NFData (NodeG [] tag text) where
rnf :: NodeG [] tag text -> ()
rnf (Element tag
nam [(tag, text)]
att [NodeG [] tag text]
chi) = (tag, [(tag, text)], [NodeG [] tag text]) -> ()
forall a. NFData a => a -> ()
rnf (tag
nam, [(tag, text)]
att, [NodeG [] tag text]
chi)
rnf (Text text
txt) = text -> ()
forall a. NFData a => a -> ()
rnf text
txt
type UNode text = Node text text
type QNode text = Node (QName text) text
type NNode text = Node (NName text) text
instance (Functor c, List c) => NodeClass NodeG c where
textContentM :: forall text tag. Monoid text => NodeG c tag text -> ItemM c text
textContentM (Element tag
_ [(tag, text)]
_ c (NodeG c tag text)
children) = (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 c tag text -> ItemM c text)
-> c (NodeG 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 c tag text -> ItemM c text
forall text tag. Monoid text => NodeG 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 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 c tag text -> Bool
isElement (Element tag
_ [(tag, text)]
_ c (NodeG c tag text)
_) = Bool
True
isElement NodeG c tag text
_ = Bool
False
isText :: forall tag text. NodeG c tag text -> Bool
isText (Text text
_) = Bool
True
isText NodeG c tag text
_ = Bool
False
isCData :: forall tag text. NodeG c tag text -> Bool
isCData NodeG c tag text
_ = Bool
False
isProcessingInstruction :: forall tag text. NodeG c tag text -> Bool
isProcessingInstruction NodeG c tag text
_ = Bool
False
isComment :: forall tag text. NodeG c tag text -> Bool
isComment NodeG c tag text
_ = Bool
False
isNamed :: forall tag text. Eq tag => tag -> NodeG c tag text -> Bool
isNamed tag
_ (Text text
_) = Bool
False
isNamed tag
nm (Element tag
nm' [(tag, text)]
_ c (NodeG c tag text)
_) = tag
nm tag -> tag -> Bool
forall a. Eq a => a -> a -> Bool
== tag
nm'
getName :: forall tag text. Monoid tag => NodeG c tag text -> tag
getName (Text text
_) = tag
forall a. Monoid a => a
mempty
getName (Element tag
name [(tag, text)]
_ c (NodeG c tag text)
_) = tag
name
hasTarget :: forall text tag. Eq text => text -> NodeG c tag text -> Bool
hasTarget text
_ NodeG c tag text
_ = Bool
False
getTarget :: forall text tag. Monoid text => NodeG c tag text -> text
getTarget NodeG c tag text
_ = text
forall a. Monoid a => a
mempty
getAttributes :: forall tag text. NodeG c tag text -> [(tag, text)]
getAttributes (Text text
_) = []
getAttributes (Element tag
_ [(tag, text)]
attrs c (NodeG c tag text)
_) = [(tag, text)]
attrs
getChildren :: forall tag text. NodeG c tag text -> c (NodeG c tag text)
getChildren (Text text
_) = c (NodeG c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
getChildren (Element tag
_ [(tag, text)]
_ c (NodeG c tag text)
ch) = c (NodeG c tag text)
ch
getText :: forall text tag. Monoid text => NodeG c tag text -> text
getText (Text text
txt) = text
txt
getText (Element tag
_ [(tag, text)]
_ c (NodeG c tag text)
_) = text
forall a. Monoid a => a
mempty
modifyName :: forall tag text.
(tag -> tag) -> NodeG c tag text -> NodeG c tag text
modifyName tag -> tag
_ node :: NodeG c tag text
node@(Text text
_) = NodeG c tag text
node
modifyName tag -> tag
f (Element tag
n [(tag, text)]
a c (NodeG c tag text)
c) = tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element (tag -> tag
f tag
n) [(tag, text)]
a c (NodeG c tag text)
c
modifyAttributes :: forall tag text.
([(tag, text)] -> [(tag, text)])
-> NodeG c tag text -> NodeG c tag text
modifyAttributes [(tag, text)] -> [(tag, text)]
_ node :: NodeG c tag text
node@(Text text
_) = NodeG c tag text
node
modifyAttributes [(tag, text)] -> [(tag, text)]
f (Element tag
n [(tag, text)]
a c (NodeG c tag text)
c) = tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element tag
n ([(tag, text)] -> [(tag, text)]
f [(tag, text)]
a) c (NodeG c tag text)
c
modifyChildren :: forall tag text.
(c (NodeG c tag text) -> c (NodeG c tag text))
-> NodeG c tag text -> NodeG c tag text
modifyChildren c (NodeG c tag text) -> c (NodeG c tag text)
_ node :: NodeG c tag text
node@(Text text
_) = NodeG c tag text
node
modifyChildren c (NodeG c tag text) -> c (NodeG c tag text)
f (Element tag
n [(tag, text)]
a c (NodeG c tag text)
c) = tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element tag
n [(tag, text)]
a (c (NodeG c tag text) -> c (NodeG c tag text)
f c (NodeG c tag text)
c)
mapAllTags :: forall tag tag' text.
(tag -> tag') -> NodeG c tag text -> NodeG c tag' text
mapAllTags tag -> tag'
_ (Text text
t) = text -> NodeG c tag' text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text text
t
mapAllTags tag -> tag'
f (Element tag
n [(tag, text)]
a c (NodeG c tag text)
c) = tag'
-> [(tag', text)] -> c (NodeG c tag' text) -> NodeG c tag' text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG 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 c tag text -> NodeG c tag' text)
-> c (NodeG c tag text) -> c (NodeG 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 c tag text -> NodeG c tag' text
forall tag tag' text.
(tag -> tag') -> NodeG c tag text -> NodeG 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 c tag text)
c)
modifyElement :: forall tag text tag'.
((tag, [(tag, text)], c (NodeG c tag text))
-> (tag', [(tag', text)], c (NodeG c tag' text)))
-> NodeG c tag text -> NodeG c tag' text
modifyElement (tag, [(tag, text)], c (NodeG c tag text))
-> (tag', [(tag', text)], c (NodeG c tag' text))
_ (Text text
t) = text -> NodeG c tag' text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text text
t
modifyElement (tag, [(tag, text)], c (NodeG c tag text))
-> (tag', [(tag', text)], c (NodeG c tag' text))
f (Element tag
n [(tag, text)]
a c (NodeG c tag text)
c) =
let (tag'
n', [(tag', text)]
a', c (NodeG c tag' text)
c') = (tag, [(tag, text)], c (NodeG c tag text))
-> (tag', [(tag', text)], c (NodeG c tag' text))
f (tag
n, [(tag, text)]
a, c (NodeG c tag text)
c)
in tag'
-> [(tag', text)] -> c (NodeG c tag' text) -> NodeG c tag' text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element tag'
n' [(tag', text)]
a' c (NodeG c tag' text)
c'
mapNodeContainer :: forall (c' :: * -> *) tag text.
List c' =>
(forall a. c a -> ItemM c (c' a))
-> NodeG c tag text -> ItemM c (NodeG c' tag text)
mapNodeContainer forall a. c a -> ItemM c (c' a)
f (Element tag
n [(tag, text)]
a c (NodeG c tag text)
ch) = do
c' (NodeG c' tag text)
ch' <- (forall a. c a -> ItemM c (c' a))
-> c (NodeG c tag text) -> ItemM c (c' (NodeG 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 c tag text)
ch
NodeG c' tag text -> ItemM c (NodeG c' tag text)
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeG c' tag text -> ItemM c (NodeG c' tag text))
-> NodeG c' tag text -> ItemM c (NodeG c' tag text)
forall a b. (a -> b) -> a -> b
$ tag -> [(tag, text)] -> c' (NodeG c' tag text) -> NodeG c' tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element tag
n [(tag, text)]
a c' (NodeG c' tag text)
ch'
mapNodeContainer forall a. c a -> ItemM c (c' a)
_ (Text text
t) = NodeG c' tag text -> ItemM c (NodeG c' tag text)
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeG c' tag text -> ItemM c (NodeG c' tag text))
-> NodeG c' tag text -> ItemM c (NodeG c' tag text)
forall a b. (a -> b) -> a -> b
$ text -> NodeG c' tag text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text text
t
mkText :: forall text tag. text -> NodeG c tag text
mkText = text -> NodeG c tag text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text
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 (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element tag
name Attributes tag text
attrs c (NodeG c tag text)
children
parse' :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString
-> Either XMLParseError (Node tag text)
parse' :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> Either XMLParseError (Node tag text)
parse' ParseOptions tag text
opts ByteString
doc = case ParseOptions tag text
-> ByteString -> (Node tag text, Maybe XMLParseError)
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> (Node tag text, Maybe XMLParseError)
parse ParseOptions tag text
opts ([ByteString] -> ByteString
L.fromChunks [ByteString
doc]) of
(Node tag text
xml, Maybe XMLParseError
Nothing) -> Node tag text -> Either XMLParseError (Node tag text)
forall a b. b -> Either a b
Right Node tag text
xml
(Node tag text
_, Just XMLParseError
err) -> XMLParseError -> Either XMLParseError (Node tag text)
forall a b. a -> Either a b
Left XMLParseError
err
saxToTree :: GenericXMLString tag =>
[SAXEvent tag text]
-> (Node tag text, Maybe XMLParseError)
saxToTree :: forall tag text.
GenericXMLString tag =>
[SAXEvent tag text] -> (Node tag text, Maybe XMLParseError)
saxToTree [SAXEvent tag text]
events =
let ([NodeG [] tag text]
nodes, Maybe XMLParseError
mError, [SAXEvent tag text]
_) = [SAXEvent tag text]
-> ([NodeG [] tag text], Maybe XMLParseError, [SAXEvent tag text])
forall {tag} {text}.
[SAXEvent tag text]
-> ([NodeG [] tag text], Maybe XMLParseError, [SAXEvent tag text])
ptl [SAXEvent tag text]
events
in ([NodeG [] tag text] -> NodeG [] tag text
forall {tag} {text}.
GenericXMLString tag =>
[NodeG [] tag text] -> NodeG [] tag text
findRoot [NodeG [] tag text]
nodes, Maybe XMLParseError
mError)
where
findRoot :: [NodeG [] tag text] -> NodeG [] tag text
findRoot (elt :: NodeG [] tag text
elt@(Element tag
_ [(tag, text)]
_ [NodeG [] tag text]
_):[NodeG [] tag text]
_) = NodeG [] tag text
elt
findRoot (NodeG [] tag text
_:[NodeG [] tag text]
nodes) = [NodeG [] tag text] -> NodeG [] tag text
findRoot [NodeG [] tag text]
nodes
findRoot [] = tag -> [(tag, text)] -> [NodeG [] tag text] -> NodeG [] tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element (String -> tag
forall s. GenericXMLString s => String -> s
gxFromString String
"") [] []
ptl :: [SAXEvent tag text]
-> ([NodeG [] tag text], Maybe XMLParseError, [SAXEvent tag text])
ptl (StartElement tag
name [(tag, text)]
attrs:[SAXEvent tag text]
rema) =
let ([NodeG [] tag text]
children, Maybe XMLParseError
err1, [SAXEvent tag text]
rema') = [SAXEvent tag text]
-> ([NodeG [] tag text], Maybe XMLParseError, [SAXEvent tag text])
ptl [SAXEvent tag text]
rema
elt :: NodeG [] tag text
elt = tag -> [(tag, text)] -> [NodeG [] tag text] -> NodeG [] tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element tag
name [(tag, text)]
attrs [NodeG [] tag text]
children
([NodeG [] tag text]
out, Maybe XMLParseError
err2, [SAXEvent tag text]
rema'') = [SAXEvent tag text]
-> ([NodeG [] tag text], Maybe XMLParseError, [SAXEvent tag text])
ptl [SAXEvent tag text]
rema'
in (NodeG [] tag text
eltNodeG [] tag text -> [NodeG [] tag text] -> [NodeG [] tag text]
forall a. a -> [a] -> [a]
:[NodeG [] 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]
rema'')
ptl (EndElement tag
_:[SAXEvent tag text]
rema) = ([], Maybe XMLParseError
forall a. Maybe a
Nothing, [SAXEvent tag text]
rema)
ptl (CharacterData text
txt:[SAXEvent tag text]
rema) =
let ([NodeG [] tag text]
out, Maybe XMLParseError
err, [SAXEvent tag text]
rema') = [SAXEvent tag text]
-> ([NodeG [] tag text], Maybe XMLParseError, [SAXEvent tag text])
ptl [SAXEvent tag text]
rema
in (text -> NodeG [] tag text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text text
txtNodeG [] tag text -> [NodeG [] tag text] -> [NodeG [] tag text]
forall a. a -> [a] -> [a]
:[NodeG [] tag text]
out, Maybe XMLParseError
err, [SAXEvent tag text]
rema')
ptl (FailDocument XMLParseError
err:[SAXEvent tag text]
_) = ([], XMLParseError -> Maybe XMLParseError
forall a. a -> Maybe a
Just XMLParseError
err, [])
ptl (SAXEvent tag text
_:[SAXEvent tag text]
rema) = [SAXEvent tag text]
-> ([NodeG [] tag text], Maybe XMLParseError, [SAXEvent tag text])
ptl [SAXEvent tag text]
rema
ptl [] = ([], Maybe XMLParseError
forall a. Maybe a
Nothing, [])
saxToTreeG :: forall tag text l . (GenericXMLString tag, List l) =>
l (SAXEvent tag text)
-> ItemM l (NodeG l tag text)
saxToTreeG :: forall tag text (l :: * -> *).
(GenericXMLString tag, List l) =>
l (SAXEvent tag text) -> ItemM l (NodeG l tag text)
saxToTreeG l (SAXEvent tag text)
events = do
ListItem l (NodeG l tag text)
li <- l (NodeG l tag text) -> ItemM l (ListItem l (NodeG 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 (SAXEvent tag text) -> l (NodeG l tag text)
process l (SAXEvent tag text)
events)
case ListItem l (NodeG l tag text)
li of
Cons elt :: NodeG l tag text
elt@(Element tag
_ [(tag, text)]
_ l (NodeG l tag text)
_ ) l (NodeG l tag text)
_ -> NodeG l tag text -> ItemM l (NodeG l tag text)
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeG l tag text
elt
ListItem l (NodeG l tag text)
_ -> NodeG l tag text -> ItemM l (NodeG l tag text)
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeG l tag text -> ItemM l (NodeG l tag text))
-> NodeG l tag text -> ItemM l (NodeG l tag text)
forall a b. (a -> b) -> a -> b
$ tag -> [(tag, text)] -> l (NodeG l tag text) -> NodeG l tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG 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 l tag text)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
process :: l (SAXEvent tag text) -> l (NodeG l tag text)
process :: l (SAXEvent tag text) -> l (NodeG l tag text)
process l (SAXEvent tag text)
events = ItemM l (l (NodeG l tag text)) -> l (NodeG l tag text)
forall a. ItemM l (l a) -> l a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM l (l (NodeG l tag text)) -> l (NodeG l tag text))
-> ItemM l (l (NodeG l tag text)) -> l (NodeG l tag text)
forall a b. (a -> b) -> a -> b
$ l (SAXEvent tag text) -> ItemM l (l (NodeG l tag text))
process_ l (SAXEvent tag text)
events
where
process_ :: l (SAXEvent tag text) -> ItemM l (l (NodeG l tag text))
process_ :: l (SAXEvent tag text) -> ItemM l (l (NodeG l tag text))
process_ l (SAXEvent tag text)
events = do
ListItem l (SAXEvent tag text)
li <- l (SAXEvent tag text) -> ItemM l (ListItem l (SAXEvent 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 (SAXEvent tag text)
events
case ListItem l (SAXEvent tag text)
li of
ListItem l (SAXEvent tag text)
Nil -> l (NodeG l tag text) -> ItemM l (l (NodeG l tag text))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return l (NodeG l tag text)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Cons (StartElement tag
name [(tag, text)]
attrs) l (SAXEvent tag text)
rema -> do
l (NodeG l tag text) -> ItemM l (l (NodeG l tag text))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (l (NodeG l tag text) -> ItemM l (l (NodeG l tag text)))
-> l (NodeG l tag text) -> ItemM l (l (NodeG l tag text))
forall a b. (a -> b) -> a -> b
$ tag -> [(tag, text)] -> l (NodeG l tag text) -> NodeG l tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element tag
name [(tag, text)]
attrs (l (SAXEvent tag text) -> l (NodeG l tag text)
process l (SAXEvent tag text)
rema) NodeG l tag text -> l (NodeG l tag text) -> l (NodeG l tag text)
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
`cons` l (SAXEvent tag text) -> l (NodeG l tag text)
process (l (SAXEvent tag text) -> l (SAXEvent tag text)
stripElement l (SAXEvent tag text)
rema)
Cons (EndElement tag
_) l (SAXEvent tag text)
_ -> l (NodeG l tag text) -> ItemM l (l (NodeG l tag text))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return l (NodeG l tag text)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Cons (CharacterData text
txt) l (SAXEvent tag text)
rema -> l (NodeG l tag text) -> ItemM l (l (NodeG l tag text))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (l (NodeG l tag text) -> ItemM l (l (NodeG l tag text)))
-> l (NodeG l tag text) -> ItemM l (l (NodeG l tag text))
forall a b. (a -> b) -> a -> b
$ text -> NodeG l tag text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text text
txt NodeG l tag text -> l (NodeG l tag text) -> l (NodeG l tag text)
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
`cons` l (SAXEvent tag text) -> l (NodeG l tag text)
process l (SAXEvent tag text)
rema
Cons SAXEvent tag text
_ l (SAXEvent tag text)
rema -> l (SAXEvent tag text) -> ItemM l (l (NodeG l tag text))
process_ l (SAXEvent tag text)
rema
stripElement :: l (SAXEvent tag text) -> l (SAXEvent tag text)
stripElement :: l (SAXEvent tag text) -> l (SAXEvent tag text)
stripElement l (SAXEvent tag text)
events = ItemM l (l (SAXEvent tag text)) -> l (SAXEvent tag text)
forall a. ItemM l (l a) -> l a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM l (l (SAXEvent tag text)) -> l (SAXEvent tag text))
-> ItemM l (l (SAXEvent tag text)) -> l (SAXEvent tag text)
forall a b. (a -> b) -> a -> b
$ Int -> l (SAXEvent tag text) -> ItemM l (l (SAXEvent tag text))
stripElement_ Int
0 l (SAXEvent tag text)
events
where
stripElement_ :: Int -> l (SAXEvent tag text) -> ItemM l (l (SAXEvent tag text))
stripElement_ :: Int -> l (SAXEvent tag text) -> ItemM l (l (SAXEvent tag text))
stripElement_ Int
level l (SAXEvent tag text)
events = Int
level Int
-> ItemM l (l (SAXEvent tag text))
-> ItemM l (l (SAXEvent tag text))
forall a b. a -> b -> b
`seq` do
ListItem l (SAXEvent tag text)
li <- l (SAXEvent tag text) -> ItemM l (ListItem l (SAXEvent 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 (SAXEvent tag text)
events
case ListItem l (SAXEvent tag text)
li of
ListItem l (SAXEvent tag text)
Nil -> l (SAXEvent tag text) -> ItemM l (l (SAXEvent tag text))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return l (SAXEvent tag text)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Cons (StartElement tag
_ [(tag, text)]
_) l (SAXEvent tag text)
rema -> Int -> l (SAXEvent tag text) -> ItemM l (l (SAXEvent tag text))
stripElement_ (Int
levelInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) l (SAXEvent tag text)
rema
Cons (EndElement tag
_) l (SAXEvent tag text)
rema -> if Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then l (SAXEvent tag text) -> ItemM l (l (SAXEvent tag text))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return l (SAXEvent tag text)
rema
else Int -> l (SAXEvent tag text) -> ItemM l (l (SAXEvent tag text))
stripElement_ (Int
levelInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) l (SAXEvent tag text)
rema
Cons SAXEvent tag text
_ l (SAXEvent tag text)
rema -> Int -> l (SAXEvent tag text) -> ItemM l (l (SAXEvent tag text))
stripElement_ Int
level l (SAXEvent tag text)
rema
parse :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> L.ByteString
-> (Node tag text, Maybe XMLParseError)
parse :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> (Node tag text, Maybe XMLParseError)
parse ParseOptions tag text
opts ByteString
bs = [SAXEvent tag text] -> (Node tag text, Maybe XMLParseError)
forall tag text.
GenericXMLString tag =>
[SAXEvent tag text] -> (Node tag text, Maybe XMLParseError)
saxToTree ([SAXEvent tag text] -> (Node tag text, Maybe XMLParseError))
-> [SAXEvent tag text] -> (Node tag text, Maybe XMLParseError)
forall a b. (a -> b) -> a -> b
$ ParseOptions tag text -> ByteString -> [SAXEvent tag text]
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text -> ByteString -> [SAXEvent tag text]
SAX.parse ParseOptions tag text
opts ByteString
bs
parseG :: (GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString
-> ItemM l (NodeG l tag text)
parseG :: forall tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text -> l ByteString -> ItemM l (NodeG l tag text)
parseG ParseOptions tag text
opts = l (SAXEvent tag text) -> ItemM l (NodeG l tag text)
forall tag text (l :: * -> *).
(GenericXMLString tag, List l) =>
l (SAXEvent tag text) -> ItemM l (NodeG l tag text)
saxToTreeG (l (SAXEvent tag text) -> ItemM l (NodeG l tag text))
-> (l ByteString -> l (SAXEvent tag text))
-> l ByteString
-> ItemM l (NodeG l tag text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseOptions tag text -> l ByteString -> l (SAXEvent tag text)
forall tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text -> l ByteString -> l (SAXEvent tag text)
SAX.parseG ParseOptions tag text
opts
parseThrowing :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> L.ByteString
-> Node tag text
parseThrowing :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text -> ByteString -> Node tag text
parseThrowing ParseOptions tag text
opts ByteString
bs = (Node tag text, Maybe XMLParseError) -> Node tag text
forall a b. (a, b) -> a
fst ((Node tag text, Maybe XMLParseError) -> Node tag text)
-> (Node tag text, Maybe XMLParseError) -> Node tag text
forall a b. (a -> b) -> a -> b
$ [SAXEvent tag text] -> (Node tag text, Maybe XMLParseError)
forall tag text.
GenericXMLString tag =>
[SAXEvent tag text] -> (Node tag text, Maybe XMLParseError)
saxToTree ([SAXEvent tag text] -> (Node tag text, Maybe XMLParseError))
-> [SAXEvent tag text] -> (Node tag text, Maybe XMLParseError)
forall a b. (a -> b) -> a -> b
$ ParseOptions tag text -> ByteString -> [SAXEvent tag text]
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text -> ByteString -> [SAXEvent tag text]
SAX.parseThrowing ParseOptions tag text
opts ByteString
bs