{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies,
        FlexibleContexts, EmptyDataDecls #-}
-- | An extended variant of /Node/ intended to implement the entire XML
-- specification.  DTDs are not yet supported, however.
--
-- The names conflict with those in /Tree/ so you must use qualified import
-- if you want to use both modules.
module Text.XML.Expat.Extended (
  -- * Tree structure
  Document,
  DocumentG(..),
  Node,
  NodeG(..),
  UDocument,
  LDocument,
  ULDocument,
  UNode,
  LNode,
  ULNode,

  -- * Generic document/node manipulation
  module Text.XML.Expat.Internal.DocumentClass,
  module Text.XML.Expat.Internal.NodeClass,

  -- * Annotation-specific
  modifyAnnotation,
  mapAnnotation,
  mapDocumentAnnotation,

  -- * Qualified nodes
  QDocument,
  QLDocument,
  QNode,
  QLNode,
  module Text.XML.Expat.Internal.Qualified,

  -- * Namespaced nodes
  NDocument,
  NLDocument,
  NNode,
  NLNode,
  module Text.XML.Expat.Internal.Namespaced,

  -- * Parse to tree
  ParseOptions(..),
  defaultParseOptions,
  Encoding(..),
  parse,
  parse',
  XMLParseError(..),
  XMLParseLocation(..),

  -- * Variant that throws exceptions
  parseThrowing,
  XMLParseException(..),

  -- * Convert from SAX
  saxToTree,

  -- * Abstraction of string types
  GenericXMLString(..)
  ) where

import Control.Arrow
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.DocumentClass
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 qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.List.Class (List, foldlL, joinM)
import Data.Maybe
import Data.Monoid


-- | Document representation of the XML document, intended to support the entire
-- XML specification.  DTDs are not yet supported, however.
data DocumentG a c tag text = Document {
        forall a (c :: * -> *) tag text.
DocumentG a c tag text -> Maybe (XMLDeclaration text)
dXMLDeclaration          :: Maybe (XMLDeclaration text),
        forall a (c :: * -> *) tag text.
DocumentG a c tag text
-> Maybe (DocumentTypeDeclaration c tag text)
dDocumentTypeDeclaration :: Maybe (DocumentTypeDeclaration c tag text),
        forall a (c :: * -> *) tag text.
DocumentG a c tag text -> c (Misc text)
dTopLevelMiscs           :: c (Misc text),
        forall a (c :: * -> *) tag text.
DocumentG a c tag text -> NodeG a c tag text
dRoot                    :: NodeG a c tag text
    }

instance (Show tag, Show text, Show a) => Show (DocumentG a [] tag text) where
    showsPrec :: Int -> DocumentG a [] tag text -> ShowS
showsPrec Int
d (Document Maybe (XMLDeclaration text)
xd Maybe (DocumentTypeDeclaration [] tag text)
dtd [Misc text]
m NodeG a [] tag text
r) = 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
"Document "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (XMLDeclaration text) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (XMLDeclaration text)
xd 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 -> Maybe (DocumentTypeDeclaration [] tag text) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (DocumentTypeDeclaration [] tag text)
dtd 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 -> [Misc text] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Misc text]
m 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
r

instance (Eq tag, Eq text, Eq a) => Eq (DocumentG a [] tag text) where
    Document Maybe (XMLDeclaration text)
xd1 Maybe (DocumentTypeDeclaration [] tag text)
dtd1 [Misc text]
m1 NodeG a [] tag text
r1 == :: DocumentG a [] tag text -> DocumentG a [] tag text -> Bool
== Document Maybe (XMLDeclaration text)
xd2 Maybe (DocumentTypeDeclaration [] tag text)
dtd2 [Misc text]
m2 NodeG a [] tag text
r2 =
        Maybe (XMLDeclaration text)
xd1 Maybe (XMLDeclaration text) -> Maybe (XMLDeclaration text) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (XMLDeclaration text)
xd2 Bool -> Bool -> Bool
&&
        Maybe (DocumentTypeDeclaration [] tag text)
dtd1 Maybe (DocumentTypeDeclaration [] tag text)
-> Maybe (DocumentTypeDeclaration [] tag text) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (DocumentTypeDeclaration [] tag text)
dtd2 Bool -> Bool -> Bool
&&
        [Misc text]
m1 [Misc text] -> [Misc text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Misc text]
m2 Bool -> Bool -> Bool
&&
        NodeG a [] tag text
r1 NodeG a [] tag text -> NodeG a [] tag text -> Bool
forall a. Eq a => a -> a -> Bool
== NodeG a [] tag text
r2

-- | A pure representation of an XML document that uses a list as its container type.
type Document a tag text = DocumentG a [] tag text

type instance NodeType (DocumentG ann) = NodeG ann

instance (Functor c, List c) => DocumentClass (DocumentG ann) c where
    getXMLDeclaration :: forall tag text.
DocumentG ann c tag text -> Maybe (XMLDeclaration text)
getXMLDeclaration          = DocumentG ann c tag text -> Maybe (XMLDeclaration text)
forall a (c :: * -> *) tag text.
DocumentG a c tag text -> Maybe (XMLDeclaration text)
dXMLDeclaration
    getDocumentTypeDeclaration :: forall tag text.
DocumentG ann c tag text
-> Maybe (DocumentTypeDeclaration c tag text)
getDocumentTypeDeclaration = DocumentG ann c tag text
-> Maybe (DocumentTypeDeclaration c tag text)
forall a (c :: * -> *) tag text.
DocumentG a c tag text
-> Maybe (DocumentTypeDeclaration c tag text)
dDocumentTypeDeclaration
    getTopLevelMiscs :: forall tag text. DocumentG ann c tag text -> c (Misc text)
getTopLevelMiscs           = DocumentG ann c tag text -> c (Misc text)
forall a (c :: * -> *) tag text.
DocumentG a c tag text -> c (Misc text)
dTopLevelMiscs
    getRoot :: forall tag text.
DocumentG ann c tag text -> NodeType (DocumentG ann) c tag text
getRoot                    = DocumentG ann c tag text -> NodeType (DocumentG ann) c tag text
DocumentG ann c tag text -> NodeG ann c tag text
forall a (c :: * -> *) tag text.
DocumentG a c tag text -> NodeG a c tag text
dRoot
    mkDocument :: forall text tag.
Maybe (XMLDeclaration text)
-> Maybe (DocumentTypeDeclaration c tag text)
-> c (Misc text)
-> NodeType (DocumentG ann) c tag text
-> DocumentG ann c tag text
mkDocument                 = Maybe (XMLDeclaration text)
-> Maybe (DocumentTypeDeclaration c tag text)
-> c (Misc text)
-> NodeType (DocumentG ann) c tag text
-> DocumentG ann c tag text
Maybe (XMLDeclaration text)
-> Maybe (DocumentTypeDeclaration c tag text)
-> c (Misc text)
-> NodeG ann c tag text
-> DocumentG ann c tag text
forall a (c :: * -> *) tag text.
Maybe (XMLDeclaration text)
-> Maybe (DocumentTypeDeclaration c tag text)
-> c (Misc text)
-> NodeG a c tag text
-> DocumentG a c tag text
Document

-- | Extended variant of the tree representation of the XML document, intended
-- to support the entire XML specification.  DTDs are not yet supported, however.
--
-- @c@ is the container type for the element's children, which is [] in the
-- @hexpat@ package, and a monadic list type for @hexpat-iteratee@.
--
-- @tag@ is the tag type, which can either be one of several string types,
-- or a special type from the @Text.XML.Expat.Namespaced@ or
-- @Text.XML.Expat.Qualified@ modules.
--
-- @text@ is the string type for text content.
--
-- @a@ is the type of the annotation.  One of the things this can be used for
-- is to store the XML parse location, which is useful for error handling.
--
-- Note that some functions in the @Text.XML.Expat.Cursor@ module need to create
-- new nodes through the 'MkElementClass' type class. Normally this can only be done
-- if @a@ is a Maybe type or () (so it can provide the Nothing value for the annotation
-- on newly created nodes).  Or, you can write your own 'MkElementClass' instance.
-- Apart from that, there is no requirement for @a@ to be a Maybe type.
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 |
    CData !text |
    Misc (Misc text)

type instance ListOf (NodeG a c tag text) = c (NodeG a c tag text)

-- | A pure tree representation that uses a list as its container type,
-- extended variant.
--
-- In the @hexpat@ package, a list of nodes has the type @[Node tag text]@, but note
-- that you can also use the more general type function 'ListOf' to give a list of
-- any node type, using that node's associated list type, e.g.
-- @ListOf (UNode 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
    showsPrec Int
d (CData 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
"CData "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
    showsPrec Int
d (Misc Misc text
m)  = 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
"Misc "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Misc text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Misc text
m

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
    CData text
t1 == CData text
t2 = text
t1 text -> text -> Bool
forall a. Eq a => a -> a -> Bool
== text
t2
    Misc Misc text
t1 == Misc Misc text
t2 = Misc text
t1 Misc text -> Misc text -> Bool
forall a. Eq a => a -> a -> Bool
== Misc 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
    rnf (CData text
txt) = text -> ()
forall a. NFData a => a -> ()
rnf text
txt
    rnf (Misc Misc text
m) = Misc text -> ()
forall a. NFData a => a -> ()
rnf Misc text
m

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
    textContentM (CData text
txt) = text -> ItemM c text
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return text
txt
    textContentM (Misc (ProcessingInstruction text
_ text
_)) = text -> ItemM c text
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return text
forall a. Monoid a => a
mempty
    textContentM (Misc (Comment text
_)) = text -> ItemM c text
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return text
forall a. Monoid a => a
mempty

    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 (CData text
_) = Bool
True
    isText NodeG a c tag text
_        = Bool
False
    
    isCData :: forall tag text. NodeG a c tag text -> Bool
isCData (CData text
_) = Bool
True
    isCData NodeG a c tag text
_        = Bool
False
    
    isProcessingInstruction :: forall tag text. NodeG a c tag text -> Bool
isProcessingInstruction (Misc (ProcessingInstruction text
_ text
_)) = Bool
True
    isProcessingInstruction NodeG a c tag text
_        = Bool
False
    
    isComment :: forall tag text. NodeG a c tag text -> Bool
isComment (Misc (Comment text
_)) = Bool
True
    isComment NodeG a c tag text
_                  = Bool
False
    
    isNamed :: forall tag text. Eq tag => tag -> NodeG a c tag text -> Bool
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'
    isNamed tag
_  NodeG a c tag text
_ = Bool
False
    
    getName :: forall tag text. Monoid tag => NodeG a c tag text -> tag
getName (Element tag
name [(tag, text)]
_ c (NodeG a c tag text)
_ a
_) = tag
name
    getName NodeG a c tag text
_             = tag
forall a. Monoid a => a
mempty
    
    hasTarget :: forall text tag. Eq text => text -> NodeG a c tag text -> Bool
hasTarget text
t (Misc (ProcessingInstruction text
t' text
_ )) = text
t text -> text -> Bool
forall a. Eq a => a -> a -> Bool
== text
t'
    hasTarget text
_  NodeG a c tag text
_ = Bool
False
    
    getTarget :: forall text tag. Monoid text => NodeG a c tag text -> text
getTarget (Misc (ProcessingInstruction text
target text
_)) = text
target
    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 (Element tag
_ [(tag, text)]
attrs c (NodeG a c tag text)
_ a
_) = [(tag, text)]
attrs
    getAttributes NodeG a c tag text
_              = []

    getChildren :: forall tag text. NodeG a c tag text -> c (NodeG a c tag text)
getChildren (Element tag
_ [(tag, text)]
_ c (NodeG a c tag text)
ch a
_) = c (NodeG a c tag text)
ch
    getChildren NodeG a c tag text
_           = c (NodeG a c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

    getText :: forall text tag. Monoid text => NodeG a c tag text -> text
getText (Text text
txt) = text
txt
    getText (CData text
txt) = text
txt
    getText (Misc (ProcessingInstruction text
_ text
txt)) = text
txt
    getText (Misc (Comment 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
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
    modifyName tag -> tag
_ NodeG a c tag text
node = NodeG a c tag text
node

    modifyAttributes :: forall tag text.
([(tag, text)] -> [(tag, text)])
-> NodeG a c tag text -> NodeG a c tag text
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
    modifyAttributes [(tag, text)] -> [(tag, text)]
_ NodeG a c tag text
node = NodeG a c tag text
node

    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)
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
    modifyChildren c (NodeG a c tag text) -> c (NodeG a c tag text)
_ NodeG a c tag text
node = NodeG a c tag text
node

    mapAllTags :: forall tag tag' text.
(tag -> tag') -> NodeG a c tag text -> NodeG a c tag' text
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
    mapAllTags tag -> tag'
_ (Text text
txt) = text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
txt
    mapAllTags tag -> tag'
_ (CData text
txt) = text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
CData text
txt
    mapAllTags tag -> tag'
_ (Misc (ProcessingInstruction text
n text
txt)) = Misc text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> text -> Misc text
forall text. text -> text -> Misc text
ProcessingInstruction text
n text
txt)
    mapAllTags tag -> tag'
_ (Misc (Comment text
txt)) = Misc text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> Misc text
forall text. text -> Misc text
Comment text
txt)

    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))
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
    modifyElement (tag, [(tag, text)], c (NodeG a c tag text))
-> (tag', [(tag', text)], c (NodeG a c tag' text))
_ (Text text
txt) = text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text text
txt
    modifyElement (tag, [(tag, text)], c (NodeG a c tag text))
-> (tag', [(tag', text)], c (NodeG a c tag' text))
_ (CData text
txt) = text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
CData text
txt
    modifyElement (tag, [(tag, text)], c (NodeG a c tag text))
-> (tag', [(tag', text)], c (NodeG a c tag' text))
_ (Misc (ProcessingInstruction text
n text
txt)) = Misc text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> text -> Misc text
forall text. text -> text -> Misc text
ProcessingInstruction text
n text
txt)
    modifyElement (tag, [(tag, text)], c (NodeG a c tag text))
-> (tag', [(tag', text)], c (NodeG a c tag' text))
_ (Misc (Comment text
txt)) = Misc text -> NodeG a c tag' text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> Misc text
forall text. text -> Misc text
Comment text
txt)

    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
txt) = 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
txt)
    mapNodeContainer forall a. c a -> ItemM c (c' a)
_ (CData text
txt) = 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
CData text
txt)
    mapNodeContainer forall a. c a -> ItemM c (c' a)
_ (Misc (ProcessingInstruction text
n text
txt)) = 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
$ Misc text -> NodeG a c' tag text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> text -> Misc text
forall text. text -> text -> Misc text
ProcessingInstruction text
n text
txt)
    mapNodeContainer forall a. c a -> ItemM c (c' a)
_ (Misc (Comment text
txt)) = 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
$ Misc text -> NodeG a c' tag text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> Misc text
forall text. text -> Misc text
Comment text
txt)

    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 alias for an extended document with unqualified tag names where
-- tag and text are the same string type
type UDocument a text = Document a text text

-- | Type alias for an extended document, annotated with parse location
type LDocument tag text = Document XMLParseLocation tag text

-- | Type alias for an extended document with unqualified tag names where
-- tag and text are the same string type, annotated with parse location
type ULDocument text = Document XMLParseLocation text text

-- | Type alias for an extended document where qualified names are used for tags
type QDocument a text = Document a (QName text) text

-- | Type alias for an extended document where qualified names are used for tags, annotated with parse location
type QLDocument text = Document XMLParseLocation (QName text) text

-- | Type alias for an extended document where namespaced names are used for tags
type NDocument a text = Document a (NName text) text

-- | Type alias for an extended document where namespaced names are used for tags, annotated with parse location
type NLDocument text = Document XMLParseLocation (NName text) text

-- | Type alias for an extended node with unqualified tag names where
-- tag and text are the same string type
type UNode a text = Node a text text

-- | Type alias for an extended node, annotated with parse location
type LNode tag text = Node XMLParseLocation tag text

-- | Type alias for an extended node with unqualified tag names where
-- tag and text are the same string type, annotated with parse location
type ULNode text = LNode text text 

-- | Type alias for an extended node where qualified names are used for tags
type QNode a text = Node a (QName text) text

-- | Type alias for an extended node where qualified names are used for tags, annotated with parse location
type QLNode text = LNode (QName text) text

-- | Type alias for an extended node where namespaced names are used for tags
type NNode a text = Node a (NName text) text

-- | Type alias for an extended node where namespaced names are used for tags, annotated with parse location
type NLNode text = LNode (NName text) text

-- | Modify this node's annotation (non-recursively) if it's an element, otherwise no-op.
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
a -> a
_ `modifyAnnotation` CData text
t = text -> NodeG a [] tag text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
CData text
t
a -> a
_ `modifyAnnotation` Misc (ProcessingInstruction text
n text
t) = Misc text -> NodeG a [] tag text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> text -> Misc text
forall text. text -> text -> Misc text
ProcessingInstruction text
n text
t)
a -> a
_ `modifyAnnotation` Misc (Comment text
t) = Misc text -> NodeG a [] tag text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> Misc text
forall text. text -> Misc text
Comment text
t)

-- | Modify this node's annotation and all its children recursively if it's an element, otherwise no-op.
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
a -> b
_ `mapAnnotation` CData text
t = text -> NodeG b [] tag text
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
CData text
t
a -> b
_ `mapAnnotation` Misc (ProcessingInstruction text
n text
t) = Misc text -> NodeG b [] tag text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> text -> Misc text
forall text. text -> text -> Misc text
ProcessingInstruction text
n text
t)
a -> b
_ `mapAnnotation` Misc (Comment text
t) = Misc text -> NodeG b [] tag text
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (text -> Misc text
forall text. text -> Misc text
Comment text
t)

-- | Modify the annotation of every node in the document recursively.
mapDocumentAnnotation :: (a -> b) -> Document a tag text -> Document b tag text
mapDocumentAnnotation :: forall a b tag text.
(a -> b) -> Document a tag text -> Document b tag text
mapDocumentAnnotation a -> b
f Document a tag text
doc = Document {
        dXMLDeclaration :: Maybe (XMLDeclaration text)
dXMLDeclaration          = Document a tag text -> Maybe (XMLDeclaration text)
forall a (c :: * -> *) tag text.
DocumentG a c tag text -> Maybe (XMLDeclaration text)
dXMLDeclaration Document a tag text
doc,
        dDocumentTypeDeclaration :: Maybe (DocumentTypeDeclaration [] tag text)
dDocumentTypeDeclaration = Document a tag text -> Maybe (DocumentTypeDeclaration [] tag text)
forall a (c :: * -> *) tag text.
DocumentG a c tag text
-> Maybe (DocumentTypeDeclaration c tag text)
dDocumentTypeDeclaration Document a tag text
doc,
        dTopLevelMiscs :: [Misc text]
dTopLevelMiscs           = Document a tag text -> [Misc text]
forall a (c :: * -> *) tag text.
DocumentG a c tag text -> c (Misc text)
dTopLevelMiscs Document a tag text
doc,
        dRoot :: NodeG b [] tag text
dRoot                    = (a -> b) -> Node a tag text -> NodeG b [] tag text
forall a b tag text. (a -> b) -> Node a tag text -> Node b tag text
mapAnnotation a -> b
f (Document a tag text -> Node a tag text
forall a (c :: * -> *) tag text.
DocumentG a c tag text -> NodeG a c tag text
dRoot Document a tag text
doc)
    }

-- | A lower level function that lazily converts a SAX stream into a tree structure.
-- Variant that takes annotations for start tags.
saxToTree :: (GenericXMLString tag, Monoid text) =>
             [(SAXEvent tag text, a)]
          -> (Document a tag text, Maybe XMLParseError)
saxToTree :: forall tag text a.
(GenericXMLString tag, Monoid text) =>
[(SAXEvent tag text, a)]
-> (Document a tag text, Maybe XMLParseError)
saxToTree ((SAX.XMLDeclaration text
ver Maybe text
mEnc Maybe Bool
mSD, a
_):[(SAXEvent tag text, a)]
events) =
    let (Document a tag text
doc, Maybe XMLParseError
mErr) = [(SAXEvent tag text, a)]
-> (Document a tag text, Maybe XMLParseError)
forall tag text a.
(GenericXMLString tag, Monoid text) =>
[(SAXEvent tag text, a)]
-> (Document a tag text, Maybe XMLParseError)
saxToTree [(SAXEvent tag text, a)]
events
    in  (Document a tag text
doc {
            dXMLDeclaration = Just $ XMLDeclaration ver mEnc mSD
        }, Maybe XMLParseError
mErr)
saxToTree [(SAXEvent tag text, a)]
events =
    let ([NodeG a [] tag text]
nodes, Maybe XMLParseError
mError, [(SAXEvent tag text, a)]
_) = [(SAXEvent tag text, a)]
-> Bool
-> [text]
-> ([NodeG a [] tag text], Maybe XMLParseError,
    [(SAXEvent tag text, a)])
forall {a} {tag} {a}.
Monoid a =>
[(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag text, a)]
events Bool
False []
        doc :: Document a tag text
doc = Document {
                dXMLDeclaration :: Maybe (XMLDeclaration text)
dXMLDeclaration          = Maybe (XMLDeclaration text)
forall a. Maybe a
Nothing,
                dDocumentTypeDeclaration :: Maybe (DocumentTypeDeclaration [] tag text)
dDocumentTypeDeclaration = Maybe (DocumentTypeDeclaration [] tag text)
forall a. Maybe a
Nothing,
                dTopLevelMiscs :: [Misc text]
dTopLevelMiscs           = [NodeG a [] tag text] -> [Misc text]
forall {a} {c :: * -> *} {tag} {text}.
[NodeG a c tag text] -> [Misc text]
findTopLevelMiscs [NodeG a [] tag text]
nodes,
                dRoot :: NodeG a [] tag text
dRoot                    = [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
            }
    in  (Document a tag text
doc, 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")
    findTopLevelMiscs :: [NodeG a c tag text] -> [Misc text]
findTopLevelMiscs = (NodeG a c tag text -> Maybe (Misc text))
-> [NodeG a c tag text] -> [Misc text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((NodeG a c tag text -> Maybe (Misc text))
 -> [NodeG a c tag text] -> [Misc text])
-> (NodeG a c tag text -> Maybe (Misc text))
-> [NodeG a c tag text]
-> [Misc text]
forall a b. (a -> b) -> a -> b
$ \NodeG a c tag text
node -> case NodeG a c tag text
node of
        Misc Misc text
m -> Misc text -> Maybe (Misc text)
forall a. a -> Maybe a
Just Misc text
m
        NodeG a c tag text
_      -> Maybe (Misc text)
forall a. Maybe a
Nothing
    ptl :: [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl ((SAX.StartElement tag
name [(tag, a)]
attrs,a
ann):[(SAXEvent tag a, a)]
rema) Bool
isCD [a]
cd =
        let ([NodeG a [] tag a]
children, Maybe XMLParseError
err1, [(SAXEvent tag a, a)]
rema') = [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema Bool
isCD [a]
cd
            elt :: NodeG a [] tag a
elt = tag -> [(tag, a)] -> [NodeG a [] tag a] -> a -> NodeG a [] tag a
forall a (c :: * -> *) tag text.
tag
-> [(tag, text)]
-> c (NodeG a c tag text)
-> a
-> NodeG a c tag text
Element tag
name [(tag, a)]
attrs [NodeG a [] tag a]
children a
ann
            ([NodeG a [] tag a]
out, Maybe XMLParseError
err2, [(SAXEvent tag a, a)]
rema'') = [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema' Bool
isCD [a]
cd
        in  (NodeG a [] tag a
eltNodeG a [] tag a -> [NodeG a [] tag a] -> [NodeG a [] tag a]
forall a. a -> [a] -> [a]
:[NodeG a [] tag a]
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 a, a)]
rema'')
    ptl ((SAX.EndElement tag
_, a
_):[(SAXEvent tag a, a)]
rema) Bool
_ [a]
_ = ([], Maybe XMLParseError
forall a. Maybe a
Nothing, [(SAXEvent tag a, a)]
rema)
    ptl ((SAX.CharacterData a
txt, a
_):[(SAXEvent tag a, a)]
rema) Bool
isCD [a]
cd =
        if Bool
isCD then
            [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema Bool
isCD (a
txta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cd)
        else
            let ([NodeG a [] tag a]
out, Maybe XMLParseError
err, [(SAXEvent tag a, a)]
rema') = [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema Bool
isCD [a]
cd
            in  (a -> NodeG a [] tag a
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
Text a
txtNodeG a [] tag a -> [NodeG a [] tag a] -> [NodeG a [] tag a]
forall a. a -> [a] -> [a]
:[NodeG a [] tag a]
out, Maybe XMLParseError
err, [(SAXEvent tag a, a)]
rema')
    ptl ((SAXEvent tag a
SAX.StartCData,a
_) :[(SAXEvent tag a, a)]
rema) Bool
_ [a]
_ =
        [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema Bool
True [a]
forall a. [a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    ptl ((SAXEvent tag a
SAX.EndCData, a
_) :[(SAXEvent tag a, a)]
rema) Bool
_ [a]
cd =
        let ([NodeG a [] tag a]
out, Maybe XMLParseError
err, [(SAXEvent tag a, a)]
rema') = [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema Bool
False [a]
forall a. [a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
        in  (a -> NodeG a [] tag a
forall a (c :: * -> *) tag text. text -> NodeG a c tag text
CData ([a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
cd)NodeG a [] tag a -> [NodeG a [] tag a] -> [NodeG a [] tag a]
forall a. a -> [a] -> [a]
:[NodeG a [] tag a]
out, Maybe XMLParseError
err, [(SAXEvent tag a, a)]
rema')
    ptl ((SAX.Comment a
txt, a
_):[(SAXEvent tag a, a)]
rema) Bool
isCD [a]
cd =
        let ([NodeG a [] tag a]
out, Maybe XMLParseError
err, [(SAXEvent tag a, a)]
rema') = [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema Bool
isCD [a]
cd
        in  (Misc a -> NodeG a [] tag a
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (a -> Misc a
forall text. text -> Misc text
Comment a
txt)NodeG a [] tag a -> [NodeG a [] tag a] -> [NodeG a [] tag a]
forall a. a -> [a] -> [a]
:[NodeG a [] tag a]
out, Maybe XMLParseError
err, [(SAXEvent tag a, a)]
rema')
    ptl ((SAX.ProcessingInstruction a
target a
txt, a
_):[(SAXEvent tag a, a)]
rema) Bool
isCD [a]
cd =
        let ([NodeG a [] tag a]
out, Maybe XMLParseError
err, [(SAXEvent tag a, a)]
rema') = [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema Bool
isCD [a]
cd
        in  (Misc a -> NodeG a [] tag a
forall a (c :: * -> *) tag text. Misc text -> NodeG a c tag text
Misc (a -> a -> Misc a
forall text. text -> text -> Misc text
ProcessingInstruction a
target a
txt)NodeG a [] tag a -> [NodeG a [] tag a] -> [NodeG a [] tag a]
forall a. a -> [a] -> [a]
:[NodeG a [] tag a]
out, Maybe XMLParseError
err, [(SAXEvent tag a, a)]
rema')
    ptl ((SAX.FailDocument XMLParseError
err, a
_):[(SAXEvent tag a, a)]
_) Bool
_ [a]
_ = ([], XMLParseError -> Maybe XMLParseError
forall a. a -> Maybe a
Just XMLParseError
err, [])
    ptl ((SAX.XMLDeclaration a
_ Maybe a
_ Maybe Bool
_, a
_):[(SAXEvent tag a, a)]
rema) Bool
isCD [a]
cd = [(SAXEvent tag a, a)]
-> Bool
-> [a]
-> ([NodeG a [] tag a], Maybe XMLParseError, [(SAXEvent tag a, a)])
ptl [(SAXEvent tag a, a)]
rema Bool
isCD [a]
cd  -- doesn't appear in the middle of a document
    ptl [] Bool
_ [a]
_ = ([], Maybe XMLParseError
forall a. Maybe a
Nothing, [])

-- | Lazily parse XML to tree. Note that forcing the XMLParseError return value
-- will force the entire parse.  Therefore, to ensure lazy operation, don't
-- check the error status until you have processed the tree.
parse :: (GenericXMLString tag, GenericXMLString text) =>
         ParseOptions tag text    -- ^ Parse options
      -> L.ByteString             -- ^ Input text (a lazy ByteString)
      -> (LDocument tag text, Maybe XMLParseError)
parse :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> (LDocument tag text, Maybe XMLParseError)
parse ParseOptions tag text
opts ByteString
bs = [(SAXEvent tag text, XMLParseLocation)]
-> (Document XMLParseLocation tag text, Maybe XMLParseError)
forall tag text a.
(GenericXMLString tag, Monoid text) =>
[(SAXEvent tag text, a)]
-> (Document a tag text, Maybe XMLParseError)
saxToTree ([(SAXEvent tag text, XMLParseLocation)]
 -> (Document XMLParseLocation tag text, Maybe XMLParseError))
-> [(SAXEvent tag text, XMLParseLocation)]
-> (Document 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

-- | Lazily parse XML to tree. In the event of an error, throw 'XMLParseException'.
--
-- @parseThrowing@ can throw an exception from pure code, which is generally a bad
-- way to handle errors, because Haskell\'s lazy evaluation means it\'s hard to
-- predict where it will be thrown from.  However, it may be acceptable in
-- situations where it's not expected during normal operation, depending on the
-- design of your program.
parseThrowing :: (GenericXMLString tag, GenericXMLString text) =>
                 ParseOptions tag text    -- ^ Parse options
              -> L.ByteString             -- ^ Input text (a lazy ByteString)
              -> LDocument tag text
parseThrowing :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text -> ByteString -> LDocument tag text
parseThrowing ParseOptions tag text
opts ByteString
bs = (LDocument tag text, Maybe XMLParseError) -> LDocument tag text
forall a b. (a, b) -> a
fst ((LDocument tag text, Maybe XMLParseError) -> LDocument tag text)
-> (LDocument tag text, Maybe XMLParseError) -> LDocument tag text
forall a b. (a -> b) -> a -> b
$ [(SAXEvent tag text, XMLParseLocation)]
-> (LDocument tag text, Maybe XMLParseError)
forall tag text a.
(GenericXMLString tag, Monoid text) =>
[(SAXEvent tag text, a)]
-> (Document a tag text, Maybe XMLParseError)
saxToTree ([(SAXEvent tag text, XMLParseLocation)]
 -> (LDocument tag text, Maybe XMLParseError))
-> [(SAXEvent tag text, XMLParseLocation)]
-> (LDocument 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

-- | Strictly parse XML to tree. Returns error message or valid parsed tree.
parse' :: (GenericXMLString tag, GenericXMLString text) =>
          ParseOptions tag text   -- ^ Parse options
       -> B.ByteString            -- ^ Input text (a strict ByteString)
       -> Either XMLParseError (LDocument tag text)
parse' :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> Either XMLParseError (LDocument tag text)
parse' ParseOptions tag text
opts ByteString
bs = case ParseOptions tag text
-> ByteString -> (LDocument tag text, Maybe XMLParseError)
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> (LDocument tag text, Maybe XMLParseError)
parse ParseOptions tag text
opts ([ByteString] -> ByteString
L.fromChunks [ByteString
bs]) of
    (LDocument tag text
_, Just XMLParseError
err)   -> XMLParseError -> Either XMLParseError (LDocument tag text)
forall a b. a -> Either a b
Left XMLParseError
err
    (LDocument tag text
root, Maybe XMLParseError
Nothing) -> LDocument tag text -> Either XMLParseError (LDocument tag text)
forall a b. b -> Either a b
Right LDocument tag text
root