{-# LANGUAGE CPP                #-}

-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.Parser.XmlParsec
   Copyright  : Copyright (C) 2005 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   Xml Parsec parser with pure filter interface

-}

-- ------------------------------------------------------------

module Text.XML.HXT.Parser.XmlParsec
    ( charData
    , charData'
    , comment
    , pI
    , cDSect
    , document
    , document'
    , prolog
    , xMLDecl
    , xMLDecl'
    , versionInfo
    , misc
    , doctypedecl
    , markupdecl
    , sDDecl
    , element
    , content
    , contentWithTextDecl
    , textDecl
    , encodingDecl
    , xread
    , xreadDoc

    , parseXmlContent
    , parseXmlDocEncodingSpec
    , parseXmlDocument
    , parseXmlDTDPart
    , parseXmlEncodingSpec
    , parseXmlEntityEncodingSpec
    , parseXmlEntityValueAsAttrValue
    , parseXmlEntityValueAsContent

    , parseXmlPart
    , parseXmlText

    , parseNMToken
    , parseName

    , removeEncodingSpec
    )
where

#if MIN_VERSION_base(4,8,2)
#else
import           Control.Applicative                   ((<$>))
#endif

import           Text.ParserCombinators.Parsec         (between, char, eof,
                                                        getInput, getPosition,
                                                        many, many1,
                                                        notFollowedBy, option,
                                                        runParser, sourceName,
                                                        string, try, unexpected,
                                                        (<?>), (<|>))

import           Text.XML.HXT.DOM.Interface
import           Text.XML.HXT.DOM.ShowXml              (xshow)
import           Text.XML.HXT.DOM.XmlNode              (changeAttrl,
                                                        getAttrName, getAttrl,
                                                        getChildren, getText,
                                                        isRoot, isText,
                                                        mergeAttrl, mkAttr',
                                                        mkCdata', mkCmt',
                                                        mkDTDElem', mkElement',
                                                        mkError', mkPi',
                                                        mkRoot', mkText')
import           Text.XML.HXT.Parser.XmlCharParser     (SimpleXParser, XPState,
                                                        XParser,
                                                        withNormNewline,
                                                        withoutNormNewline,
                                                        xmlChar)
import qualified Text.XML.HXT.Parser.XmlDTDTokenParser as XD
import qualified Text.XML.HXT.Parser.XmlTokenParser    as XT

import           Control.FlatSeq

import           Data.Char                             (toLower)
import           Data.Maybe

-- import Debug.Trace

-- ------------------------------------------------------------
--
-- Character Data (2.4)

charData                :: XParser s XmlTrees
charData :: forall s. XParser s XmlTrees
charData
    = ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
charData' ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
XT.referenceT)

charData'               :: XParser s XmlTree
charData' :: forall s. XParser s XmlTree
charData'
    =  do
       t <- (XParser s Char -> XParser s [Char])
-> (Char -> Bool) -> [Char] -> XParser s [Char]
forall s.
(XParser s Char -> XParser s [Char])
-> (Char -> Bool) -> [Char] -> XParser s [Char]
XT.allBut1 XParser s Char -> XParser s [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (\ Char
c -> Bool -> Bool
not (Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"<&")) [Char]
"]]>"
       return (mkText' t)

-- ------------------------------------------------------------
--
-- Comments (2.5)

comment         :: XParser s XmlTree
comment :: forall s. XParser s XmlTree
comment
    = XParser s () -> XParser s XmlTree
forall s. XParser s () -> XParser s XmlTree
comment'' (XParser s () -> XParser s XmlTree)
-> XParser s () -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"<!--"

-- the leading <! is already parsed

comment'        :: XParser s XmlTree
comment' :: forall s. XParser s XmlTree
comment'
    = XParser s () -> XParser s XmlTree
forall s. XParser s () -> XParser s XmlTree
comment'' ([Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"--" ParsecT [Char] (XPState s) Identity [Char]
-> XParser s () -> XParser s ()
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

comment''       :: XParser s () -> XParser s XmlTree
comment'' :: forall s. XParser s () -> XParser s XmlTree
comment'' XParser s ()
op
    = ( do
        c <- XParser s ()
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between XParser s ()
op ([Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string ([Char]
"-->")) ((XParser s Char -> ParsecT [Char] (XPState s) Identity [Char])
-> [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s.
(XParser s Char -> XParser s [Char]) -> [Char] -> XParser s [Char]
XT.allBut XParser s Char -> ParsecT [Char] (XPState s) Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many [Char]
"--")
        return (mkCmt' c)
      ) ParsecT [Char] (XPState s) Identity XmlTree
-> [Char] -> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"comment"

-- ------------------------------------------------------------
--
-- Processing Instructions

pI             :: XParser s XmlTree
pI :: forall s. XParser s XmlTree
pI = XParser s () -> XParser s XmlTree
forall s. XParser s () -> XParser s XmlTree
pI'' (XParser s () -> XParser s XmlTree)
-> XParser s () -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"<?"

-- the leading < is already parsed

pI'             :: XParser s XmlTree
pI' :: forall s. XParser s XmlTree
pI' = XParser s () -> XParser s XmlTree
forall s. XParser s () -> XParser s XmlTree
pI'' (Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?' ParsecT [Char] (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

pI''             :: XParser s () -> XParser s XmlTree
pI'' :: forall s. XParser s () -> XParser s XmlTree
pI'' XParser s ()
op
    = XParser s ()
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between XParser s ()
op ([Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"?>")
      ( do
        n <- ParsecT [Char] (XPState s) Identity [Char]
forall s. XParser s [Char]
pITarget
        p <- option "" (XT.sPace
                        >>
                        XT.allBut many "?>"
                       )
        return (mkPi' (mkName n) [mkAttr' (mkName a_value) [mkText' p]])
      ) ParsecT [Char] (XPState s) Identity XmlTree
-> [Char] -> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"processing instruction"
      where
      pITarget  :: XParser s String
      pITarget :: forall s. XParser s [Char]
pITarget = ( do
                   n <- XParser s [Char]
forall s. XParser s [Char]
XT.name
                   if map toLower n == t_xml
                      then unexpected n
                      else return n
                 )

-- ------------------------------------------------------------
--
-- CDATA Sections (2.7)

cDSect          :: XParser s XmlTree
cDSect :: forall s. XParser s XmlTree
cDSect
    = XParser s () -> XParser s XmlTree
forall s. XParser s () -> XParser s XmlTree
cDSect'' (XParser s () -> XParser s XmlTree)
-> XParser s () -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"<![CDATA["

-- the leading <! is already parsed, no try neccessary

cDSect'         :: XParser s XmlTree
cDSect' :: forall s. XParser s XmlTree
cDSect'
    = XParser s () -> XParser s XmlTree
forall s. XParser s () -> XParser s XmlTree
cDSect'' ([Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[CDATA[" ParsecT [Char] (XPState s) Identity [Char]
-> XParser s () -> XParser s ()
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

cDSect''        :: XParser s () -> XParser s XmlTree
cDSect'' :: forall s. XParser s () -> XParser s XmlTree
cDSect'' XParser s ()
op
    = do
      t <- XParser s ()
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between XParser s ()
op ([Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"]]>") ((XParser s Char -> ParsecT [Char] (XPState s) Identity [Char])
-> [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s.
(XParser s Char -> XParser s [Char]) -> [Char] -> XParser s [Char]
XT.allBut XParser s Char -> ParsecT [Char] (XPState s) Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many [Char]
"]]>")
      return (mkCdata' t)
      ParsecT [Char] (XPState s) Identity XmlTree
-> [Char] -> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"CDATA section"

-- ------------------------------------------------------------
--
-- Document (2.1) and Prolog (2.8)

document        :: XParser s XmlTree
document :: forall s. XParser s XmlTree
document
    = do
      pos <- ParsecT [Char] (XPState s) Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      dl <- document'
      return (mkRoot' [ mkAttr' (mkName a_source) [mkText' (sourceName pos)]
                      , mkAttr' (mkName a_status) [mkText' (show c_ok)]
                      ] dl
             )

document'       :: XParser s XmlTrees
document' :: forall s. XParser s XmlTrees
document'
    = do
      pl <- XParser s XmlTrees
forall s. XParser s XmlTrees
prolog
      el <- element
      ml <- many misc
      eof
      return (pl ++ [el] ++ ml)

prolog          :: XParser s XmlTrees
prolog :: forall s. XParser s XmlTrees
prolog
    = do
      xml     <- XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
xMLDecl'
      misc1   <- many misc
      dtdPart <- option [] doctypedecl
      misc2   <- many misc
      return (xml ++ misc1 ++ dtdPart ++ misc2)

xMLDecl         :: XParser s XmlTrees
xMLDecl :: forall s. XParser s XmlTrees
xMLDecl
    = ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (XPState s) Identity [Char]
 -> ParsecT [Char] (XPState s) Identity [Char])
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<?xml") ([Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"?>")
      ( do
        vi <- ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
versionInfo
        ed <- option [] encodingDecl
        sd <- option [] sDDecl
        XT.skipS0
        return (vi ++ ed ++ sd)
      )
      ParsecT [Char] (XPState s) Identity XmlTrees
-> [Char] -> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"xml declaration"

xMLDecl'        :: XParser s XmlTrees
xMLDecl' :: forall s. XParser s XmlTrees
xMLDecl'
    = do
      al <- XParser s XmlTrees
forall s. XParser s XmlTrees
xMLDecl
      return [mkPi' (mkName t_xml) al]

xMLDecl''       :: XParser s XmlTree
xMLDecl'' :: forall s. XParser s XmlTree
xMLDecl''
    = do
      al     <- XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
xMLDecl)
      return (mkRoot' al [])

versionInfo     :: XParser s XmlTrees
versionInfo :: forall s. XParser s XmlTrees
versionInfo
    = ( do
        GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( GenParser Char (XPState s) ()
forall s. XParser s ()
XT.skipS
              GenParser Char (XPState s) ()
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
a_version
              ParsecT [Char] (XPState s) Identity [Char]
-> GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              () -> GenParser Char (XPState s) ()
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            )
        GenParser Char (XPState s) ()
forall s. XParser s ()
XT.eq
        vi <- ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall s a. XParser s a -> XParser s a
XT.quoted ParsecT [Char] (XPState s) Identity [Char]
forall s. XParser s [Char]
XT.versionNum
        return [mkAttr' (mkName a_version) [mkText' vi]]
      )
      ParsecT [Char] (XPState s) Identity XmlTrees
-> [Char] -> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"version info (with quoted version number)"

misc            :: XParser s XmlTree
misc :: forall s. XParser s XmlTree
misc
    = XParser s XmlTree
forall s. XParser s XmlTree
comment
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s XmlTree
forall s. XParser s XmlTree
pI
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( ( do
          ws <- XParser s [Char]
forall s. XParser s [Char]
XT.sPace
          return (mkText' ws)
        ) XParser s XmlTree -> [Char] -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
""
      )

-- ------------------------------------------------------------
--
-- Document Type definition (2.8)

doctypedecl     :: XParser s XmlTrees
doctypedecl :: forall s. XParser s XmlTrees
doctypedecl
    = ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity Char
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (XPState s) Identity [Char]
 -> ParsecT [Char] (XPState s) Identity [Char])
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!DOCTYPE") (Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>')
      ( do
        XParser s ()
forall s. XParser s ()
XT.skipS
        n <- ParsecT [Char] (XPState s) Identity [Char]
forall s. XParser s [Char]
XT.name
        exId <- option [] ( try ( do
                                  XT.skipS
                                  externalID
                                )
                          )
        XT.skipS0
        markup <- option []
                  ( do
                    m <- between (char '[' ) (char ']') markupOrDeclSep
                    XT.skipS0
                    return m
                  )
        return [mkDTDElem' DOCTYPE ((a_name, n) : exId) markup]
      )

markupOrDeclSep :: XParser s XmlTrees
markupOrDeclSep :: forall s. XParser s XmlTrees
markupOrDeclSep
    = ( do
        ll <- ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity [XmlTrees]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
markupdecl
                     ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                     ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
declSep
                     ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                     XParser s XmlTree -> ParsecT [Char] (XPState s) Identity XmlTrees
forall s a. XParser s a -> XParser s [a]
XT.mkList XParser s XmlTree
forall s. XParser s XmlTree
conditionalSect
                   )
        return (concat ll)
      )

declSep         :: XParser s XmlTrees
declSep :: forall s. XParser s XmlTrees
declSep
    = XParser s XmlTree -> XParser s XmlTrees
forall s a. XParser s a -> XParser s [a]
XT.mkList XParser s XmlTree
forall s. XParser s XmlTree
XT.peReferenceT
      XParser s XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        XParser s ()
forall s. XParser s ()
XT.skipS
        XmlTrees -> XParser s XmlTrees
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      )

markupdecl      :: XParser s XmlTrees
markupdecl :: forall s. XParser s XmlTrees
markupdecl
    = XParser s XmlTree -> XParser s XmlTrees
forall s a. XParser s a -> XParser s [a]
XT.mkList
      ( XParser s XmlTree
forall s. XParser s XmlTree
pI
        XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        XParser s XmlTree
forall s. XParser s XmlTree
comment
        XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        XParser s XmlTree
forall s. XParser s XmlTree
XD.dtdDeclTokenizer
      )

-- ------------------------------------------------------------
--
-- Standalone Document Declaration (2.9)

sDDecl          :: XParser s XmlTrees
sDDecl :: forall s. XParser s XmlTrees
sDDecl
    = do
      GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( GenParser Char (XPState s) ()
forall s. XParser s ()
XT.skipS
            GenParser Char (XPState s) ()
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
a_standalone
            ParsecT [Char] (XPState s) Identity [Char]
-> GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            () -> GenParser Char (XPState s) ()
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          )
      GenParser Char (XPState s) ()
forall s. XParser s ()
XT.eq
      sd <- ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall s a. XParser s a -> XParser s a
XT.quoted ([[Char]] -> ParsecT [Char] (XPState s) Identity [Char]
forall s. [[Char]] -> XParser s [Char]
XT.keywords [[Char]
v_yes, [Char]
v_no])
      return [mkAttr' (mkName a_standalone) [mkText' sd]]

-- ------------------------------------------------------------
--
-- element, tags and content (3, 3.1)

element         :: XParser s XmlTree
element :: forall s. XParser s XmlTree
element
    = Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
      ParsecT [Char] (XPState s) Identity Char
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
element'

element'         :: XParser s XmlTree
element' :: forall s. XParser s XmlTree
element'
    = ( do
        e <- XParser s (QName, XmlTrees)
forall s. XParser s (QName, XmlTrees)
elementStart
        rwnf e `seq` elementRest e              -- evaluate name and attribute list before parsing contents
      ) ParsecT [Char] (XPState s) Identity XmlTree
-> [Char] -> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"element"


elementStart            :: XParser s (QName, XmlTrees)
elementStart :: forall s. XParser s (QName, XmlTrees)
elementStart
    = do
      n  <- XParser s [Char]
forall s. XParser s [Char]
XT.name
      al <- attrList
      XT.skipS0
      return (mkName n, al)
      where
      attrList :: ParsecT [Char] (XPState s) Identity XmlTrees
attrList
          = XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ( do
                        XParser s ()
forall s. XParser s ()
XT.skipS
                        ParsecT [Char] (XPState s) Identity XmlTrees
attrList'
                      )
      attrList' :: ParsecT [Char] (XPState s) Identity XmlTrees
attrList'
          = XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ( do
                        a1 <- XParser s XmlTree
forall s. XParser s XmlTree
attribute
                        al <- attrList
                        let n = Maybe QName -> QName
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe QName -> QName)
-> (XmlTree -> Maybe QName) -> XmlTree -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe QName
forall a. XmlNode a => a -> Maybe QName
getAttrName (XmlTree -> QName) -> XmlTree -> QName
forall a b. (a -> b) -> a -> b
$ XmlTree
a1
                        if n `elem` map (fromJust . getAttrName) al
                          then unexpected
                               ( "attribute name " ++
                                 show (qualifiedName n) ++
                                 " occurs twice in attribute list"
                               )
                          else return (a1 : al)
                      )

elementRest     :: (QName, XmlTrees) -> XParser s XmlTree
elementRest :: forall s. (QName, XmlTrees) -> XParser s XmlTree
elementRest (QName
n, XmlTrees
al)
    = ( do
        [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"/>"
        XmlTree -> ParsecT [Char] (XPState s) Identity XmlTree
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> ParsecT [Char] (XPState s) Identity XmlTree)
-> XmlTree -> ParsecT [Char] (XPState s) Identity XmlTree
forall a b. (a -> b) -> a -> b
$ QName -> XmlTrees -> XmlTrees -> XmlTree
mkElement' QName
n XmlTrees
al []
      )
      ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        XParser s ()
forall s. XParser s ()
XT.gt
        c <- XParser s XmlTrees
forall s. XParser s XmlTrees
content
        eTag n
        return $ mkElement' n al c
      )
      ParsecT [Char] (XPState s) Identity XmlTree
-> [Char] -> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"proper attribute list followed by \"/>\" or \">\""

eTag            :: QName -> XParser s ()
eTag :: forall s. QName -> XParser s ()
eTag QName
n'
    = do
      [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"</" XParser s () -> [Char] -> XParser s ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
""
      n <- XParser s [Char]
forall s. XParser s [Char]
XT.name
      XT.skipS0
      XT.gt
      if n == qualifiedName n'
         then return ()
         else unexpected ("illegal end tag </" ++ n ++ "> found, </" ++ qualifiedName n' ++ "> expected")

attribute       :: XParser s XmlTree
attribute :: forall s. XParser s XmlTree
attribute
    = do
      n <- XParser s [Char]
forall s. XParser s [Char]
XT.name
      XT.eq
      v <- XT.attrValueT
      return $ mkAttr' (mkName n) v

{- this parser corresponds to the XML spec but it's inefficent because of more than 1 char lookahead

content         :: XParser s XmlTrees
content
    = do
      c1 <- charData
      cl <- many
            ( do
              l <- ( element
                     <|>
                     cDSect
                     <|>
                     pI
                     <|>
                     comment
                   )
              c <- charData
              return (l : c)
            )
      return (c1 ++ concat cl)
-}

-- this simpler content parser does not need more than a single lookahead
-- so no try parsers (inefficient) are neccessary

content         :: XParser s XmlTrees
content :: forall s. XParser s XmlTrees
content
    = XmlTrees -> XmlTrees
XT.mergeTextNodes (XmlTrees -> XmlTrees)
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many
      ( ( do            -- parse markup but no closing tags
          GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( GenParser Char (XPState s) ()
forall s. XParser s ()
XT.lt
                GenParser Char (XPState s) ()
-> GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                ParsecT [Char] (XPState s) Identity Char
-> GenParser Char (XPState s) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/')
                GenParser Char (XPState s) ()
-> GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                () -> GenParser Char (XPState s) ()
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              )
          ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
markup
        )
        ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
charData'
        ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
XT.referenceT
      )
    where
    markup :: ParsecT [Char] (XPState s) Identity XmlTree
markup
        = ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
element'
          ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
pI'
          ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          ( Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!'
            ParsecT [Char] (XPState s) Identity Char
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            ( ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
comment'
              ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
cDSect'
            )
          )

contentWithTextDecl     :: XParser s XmlTrees
contentWithTextDecl :: forall s. XParser s XmlTrees
contentWithTextDecl
    = XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
textDecl
      ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
content

-- ------------------------------------------------------------
--
-- Conditional Sections (3.4)
--
-- conditional sections are parsed in two steps,
-- first the whole content is detected,
-- and then, after PE substitution include sections are parsed again

conditionalSect         :: XParser s XmlTree
conditionalSect :: forall s. XParser s XmlTree
conditionalSect
    = do
      [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"<!["
      cs <- ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
XD.dtdToken
      _ <- char '['
      sect <- condSectCont
      return (mkDTDElem' CONDSECT [(a_value, sect)] cs)
    where

    condSectCont        :: XParser s String
    condSectCont :: forall s. XParser s [Char]
condSectCont
        = ( [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"]]>"
            XParser s ()
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
          )
          ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          ( do
            [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"<!["
            cs1 <- ParsecT [Char] (XPState s) Identity [Char]
forall s. XParser s [Char]
condSectCont
            cs2 <- condSectCont
            return ("<![" ++ cs1 ++ "]]>" ++ cs2)
          )
          ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          ( do
            c  <- XParser s Char
forall s. XParser s Char
xmlChar
            cs <- condSectCont
            return (c : cs)
          )

-- ------------------------------------------------------------
--
-- External Entities (4.2.2)

externalID      :: XParser s Attributes
externalID :: forall s. XParser s [([Char], [Char])]
externalID
    = ( do
        _ <- [Char] -> XParser s [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_system
        XT.skipS
        lit <- XT.systemLiteral
        return [(k_system, lit)]
      )
      ParsecT [Char] (XPState s) Identity [([Char], [Char])]
-> ParsecT [Char] (XPState s) Identity [([Char], [Char])]
-> ParsecT [Char] (XPState s) Identity [([Char], [Char])]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        _ <- [Char] -> XParser s [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_public
        XT.skipS
        pl <- XT.pubidLiteral
        XT.skipS
        sl <- XT.systemLiteral
        return [ (k_system, sl)
               , (k_public, pl) ]
      )
      ParsecT [Char] (XPState s) Identity [([Char], [Char])]
-> [Char] -> ParsecT [Char] (XPState s) Identity [([Char], [Char])]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"SYSTEM or PUBLIC declaration"

-- ------------------------------------------------------------
--
-- Text Declaration (4.3.1)

textDecl        :: XParser s XmlTrees
textDecl :: forall s. XParser s XmlTrees
textDecl
    = ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (XPState s) Identity [Char]
 -> ParsecT [Char] (XPState s) Identity [Char])
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<?xml") ([Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"?>")
      ( do
        vi <- XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
versionInfo
        ed <- encodingDecl
        XT.skipS0
        return (vi ++ ed)
      )
      ParsecT [Char] (XPState s) Identity XmlTrees
-> [Char] -> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"text declaration"


textDecl''      :: XParser s XmlTree
textDecl'' :: forall s. XParser s XmlTree
textDecl''
    = do
      al    <- XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
textDecl)
      return (mkRoot' al [])

-- ------------------------------------------------------------
--
-- Encoding Declaration (4.3.3)

encodingDecl    :: XParser s XmlTrees
encodingDecl :: forall s. XParser s XmlTrees
encodingDecl
    = do
      GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( GenParser Char (XPState s) ()
forall s. XParser s ()
XT.skipS
            GenParser Char (XPState s) ()
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
a_encoding
            ParsecT [Char] (XPState s) Identity [Char]
-> GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            () -> GenParser Char (XPState s) ()
forall a. a -> ParsecT [Char] (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          )
      GenParser Char (XPState s) ()
forall s. XParser s ()
XT.eq
      ed <- ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall s a. XParser s a -> XParser s a
XT.quoted ParsecT [Char] (XPState s) Identity [Char]
forall s. XParser s [Char]
XT.encName
      return [mkAttr' (mkName a_encoding) [mkText' ed]]

-- ------------------------------------------------------------
--
-- the main entry points:
--      parsing the content of a text node
--      or parsing the text children from a tag node

-- |
-- the inverse function to 'xshow', (for XML content).
--
-- the string parameter is parsed with the XML content parser.
-- result is the list of trees or in case of an error a single element list with the
-- error message as node. No entity or character subtitution is done here,
-- but the XML parser can do this for the predefined XML or the char references for performance reasons
--
-- see also: 'parseXmlContent'

xread                   :: String -> XmlTrees
xread :: [Char] -> XmlTrees
xread                   = XParser () XmlTrees -> [Char] -> XmlTrees
xread' XParser () XmlTrees
forall s. XParser s XmlTrees
content         -- take the content parser for parsing the string

xreadDoc                :: String -> XmlTrees
xreadDoc :: [Char] -> XmlTrees
xreadDoc                = XParser () XmlTrees -> [Char] -> XmlTrees
xread' XParser () XmlTrees
forall s. XParser s XmlTrees
document'       -- take the document' parser for parsing the string

xread'                   :: XParser () XmlTrees -> String -> XmlTrees
xread' :: XParser () XmlTrees -> [Char] -> XmlTrees
xread' XParser () XmlTrees
content' [Char]
str
    = XParser () XmlTrees -> XPState () -> [Char] -> [Char] -> XmlTrees
parseXmlFromString XParser () XmlTrees
parser (() -> XPState ()
forall a. a -> XPState a
withNormNewline ()) [Char]
loc [Char]
str
    where
    loc :: [Char]
loc = [Char]
"string: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show (if [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
40 then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
40 [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..." else [Char]
str)
    parser :: XParser () XmlTrees
parser = do
             res <- XParser () XmlTrees
content'
             eof                        -- test on everything consumed
             return res

-- |
-- the filter version of 'xread'

parseXmlContent         :: XmlTree -> XmlTrees
parseXmlContent :: XmlTree -> XmlTrees
parseXmlContent
    = [Char] -> XmlTrees
xread ([Char] -> XmlTrees) -> (XmlTree -> [Char]) -> XmlTree -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> [Char]
xshow (XmlTrees -> [Char]) -> (XmlTree -> XmlTrees) -> XmlTree -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
:[])

-- |
-- a more general version of 'parseXmlContent'.
-- The parser to be used and the context are extra parameter

parseXmlText            :: SimpleXParser XmlTrees -> XPState () -> String -> XmlTree -> XmlTrees
parseXmlText :: XParser () XmlTrees -> XPState () -> [Char] -> XmlTree -> XmlTrees
parseXmlText XParser () XmlTrees
p XPState ()
s0 [Char]
loc   = XParser () XmlTrees -> XPState () -> [Char] -> [Char] -> XmlTrees
parseXmlFromString XParser () XmlTrees
p XPState ()
s0 [Char]
loc ([Char] -> XmlTrees) -> (XmlTree -> [Char]) -> XmlTree -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> [Char]
xshow (XmlTrees -> [Char]) -> (XmlTree -> XmlTrees) -> XmlTree -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
:[])

parseXmlDocument        :: String -> String -> XmlTrees
parseXmlDocument :: [Char] -> [Char] -> XmlTrees
parseXmlDocument        = XParser () XmlTrees -> XPState () -> [Char] -> [Char] -> XmlTrees
parseXmlFromString XParser () XmlTrees
forall s. XParser s XmlTrees
document' (() -> XPState ()
forall a. a -> XPState a
withNormNewline ())

parseXmlFromString      :: SimpleXParser XmlTrees -> XPState () -> String -> String -> XmlTrees
parseXmlFromString :: XParser () XmlTrees -> XPState () -> [Char] -> [Char] -> XmlTrees
parseXmlFromString XParser () XmlTrees
parser XPState ()
s0 [Char]
loc
    = (ParseError -> XmlTrees)
-> (XmlTrees -> XmlTrees) -> Either ParseError XmlTrees -> XmlTrees
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
:[]) (XmlTree -> XmlTrees)
-> (ParseError -> XmlTree) -> ParseError -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> XmlTree
mkError' Int
c_err ([Char] -> XmlTree)
-> (ParseError -> [Char]) -> ParseError -> XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n") ([Char] -> [Char])
-> (ParseError -> [Char]) -> ParseError -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
forall a. Show a => a -> [Char]
show) XmlTrees -> XmlTrees
forall a. a -> a
id
      (Either ParseError XmlTrees -> XmlTrees)
-> ([Char] -> Either ParseError XmlTrees) -> [Char] -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XParser () XmlTrees
-> XPState () -> [Char] -> [Char] -> Either ParseError XmlTrees
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser XParser () XmlTrees
parser XPState ()
s0 [Char]
loc

-- ------------------------------------------------------------
--

removeEncodingSpec      :: XmlTree -> XmlTrees
removeEncodingSpec :: XmlTree -> XmlTrees
removeEncodingSpec XmlTree
t
    | XmlTree -> Bool
forall a. XmlNode a => a -> Bool
isText XmlTree
t
        = ( (ParseError -> XmlTrees)
-> ([Char] -> XmlTrees) -> Either ParseError [Char] -> XmlTrees
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
:[]) (XmlTree -> XmlTrees)
-> (ParseError -> XmlTree) -> ParseError -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> XmlTree
mkError' Int
c_err ([Char] -> XmlTree)
-> (ParseError -> [Char]) -> ParseError -> XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n") ([Char] -> [Char])
-> (ParseError -> [Char]) -> ParseError -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
forall a. Show a => a -> [Char]
show) ((XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
:[]) (XmlTree -> XmlTrees) -> ([Char] -> XmlTree) -> [Char] -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> XmlTree
mkText')
            (Either ParseError [Char] -> XmlTrees)
-> (XmlTree -> Either ParseError [Char]) -> XmlTree -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenParser Char (XPState ()) [Char]
-> XPState () -> [Char] -> [Char] -> Either ParseError [Char]
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser GenParser Char (XPState ()) [Char]
forall s. XParser s [Char]
parser (() -> XPState ()
forall a. a -> XPState a
withNormNewline ()) [Char]
"remove encoding spec"
            ([Char] -> Either ParseError [Char])
-> (XmlTree -> [Char]) -> XmlTree -> Either ParseError [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
""
            (Maybe [Char] -> [Char])
-> (XmlTree -> Maybe [Char]) -> XmlTree -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe [Char]
forall a. XmlNode a => a -> Maybe [Char]
getText
          ) XmlTree
t
    | Bool
otherwise
        = [XmlTree
t]
    where
    parser :: XParser s String
    parser :: forall s. XParser s [Char]
parser = XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
textDecl
             ParsecT [Char] (XPState s) Identity XmlTrees
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall a b.
ParsecT [Char] (XPState s) Identity a
-> ParsecT [Char] (XPState s) Identity b
-> ParsecT [Char] (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             ParsecT [Char] (XPState s) Identity [Char]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput

-- ------------------------------------------------------------

-- |
-- general parser for parsing arbitray parts of a XML document

parseXmlPart    :: SimpleXParser XmlTrees -> String -> String -> XmlTree -> XmlTrees
parseXmlPart :: XParser () XmlTrees -> [Char] -> [Char] -> XmlTree -> XmlTrees
parseXmlPart XParser () XmlTrees
parser [Char]
expected [Char]
context XmlTree
t
    = XParser () XmlTrees -> XPState () -> [Char] -> XmlTree -> XmlTrees
parseXmlText
      ( do
        res <- XParser () XmlTrees
parser
        eof <?> expected
        return res
      ) (() -> XPState ()
forall a. a -> XPState a
withoutNormNewline ()) [Char]
context
      (XmlTree -> XmlTrees) -> XmlTree -> XmlTrees
forall a b. (a -> b) -> a -> b
$ XmlTree
t

-- ------------------------------------------------------------

-- |
-- Parser for parts of a DTD

parseXmlDTDPart :: String -> XmlTree -> XmlTrees
parseXmlDTDPart :: [Char] -> XmlTree -> XmlTrees
parseXmlDTDPart
    = XParser () XmlTrees -> [Char] -> [Char] -> XmlTree -> XmlTrees
parseXmlPart XParser () XmlTrees
forall s. XParser s XmlTrees
markupOrDeclSep [Char]
"markup declaration"

-- ------------------------------------------------------------

-- |
-- Parser for general entites

parseXmlEntityValueAsContent      :: String -> XmlTree -> XmlTrees
parseXmlEntityValueAsContent :: [Char] -> XmlTree -> XmlTrees
parseXmlEntityValueAsContent
    = XParser () XmlTrees -> [Char] -> [Char] -> XmlTree -> XmlTrees
parseXmlPart XParser () XmlTrees
forall s. XParser s XmlTrees
content [Char]
"general entity value"

-- ------------------------------------------------------------

-- |
-- Parser for entity substitution within attribute values

parseXmlEntityValueAsAttrValue       :: String -> XmlTree -> XmlTrees
parseXmlEntityValueAsAttrValue :: [Char] -> XmlTree -> XmlTrees
parseXmlEntityValueAsAttrValue
    = XParser () XmlTrees -> [Char] -> [Char] -> XmlTree -> XmlTrees
parseXmlPart ([Char] -> XParser () XmlTrees
forall s. [Char] -> XParser s XmlTrees
XT.attrValueT' [Char]
"<&") [Char]
"attribute value"

-- ------------------------------------------------------------

-- |
-- Parser for NMTOKENs

parseNMToken            :: String -> XmlTree -> XmlTrees
parseNMToken :: [Char] -> XmlTree -> XmlTrees
parseNMToken
    = XParser () XmlTrees -> [Char] -> [Char] -> XmlTree -> XmlTrees
parseXmlPart (ParsecT [Char] (XPState ()) Identity XmlTree -> XParser () XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] (XPState ()) Identity XmlTree
forall s. XParser s XmlTree
XT.nmtokenT) [Char]
"nmtoken"

-- ------------------------------------------------------------

-- |
-- Parser for XML names

parseName               :: String -> XmlTree -> XmlTrees
parseName :: [Char] -> XmlTree -> XmlTrees
parseName
    = XParser () XmlTrees -> [Char] -> [Char] -> XmlTree -> XmlTrees
parseXmlPart (ParsecT [Char] (XPState ()) Identity XmlTree -> XParser () XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] (XPState ()) Identity XmlTree
forall s. XParser s XmlTree
XT.nameT) [Char]
"name"

-- ------------------------------------------------------------

-- |
-- try to parse a xml encoding spec.
--
--
--    * 1.parameter encParse :  the parser for the encoding decl
--
--    - 2.parameter root :  a document root
--
--    - returns : the same tree, but with an additional
--                        attribute \"encoding\" in the root node
--                        in case of a valid encoding spec
--                        else the unchanged tree

parseXmlEncodingSpec    :: SimpleXParser XmlTree -> XmlTree -> XmlTrees
parseXmlEncodingSpec :: ParsecT [Char] (XPState ()) Identity XmlTree -> XmlTree -> XmlTrees
parseXmlEncodingSpec ParsecT [Char] (XPState ()) Identity XmlTree
encDecl XmlTree
x
    = (XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
:[]) (XmlTree -> XmlTrees)
-> (XmlTree -> XmlTree) -> XmlTree -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ( if XmlTree -> Bool
forall a. XmlNode a => a -> Bool
isRoot XmlTree
x
        then XmlTree -> XmlTree
parseEncSpec
        else XmlTree -> XmlTree
forall a. a -> a
id
      ) (XmlTree -> XmlTrees) -> XmlTree -> XmlTrees
forall a b. (a -> b) -> a -> b
$ XmlTree
x
    where
    parseEncSpec :: XmlTree -> XmlTree
parseEncSpec XmlTree
r
        = case ( ParsecT [Char] (XPState ()) Identity XmlTree
-> XPState () -> [Char] -> [Char] -> Either ParseError XmlTree
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser ParsecT [Char] (XPState ()) Identity XmlTree
encDecl (() -> XPState ()
forall a. a -> XPState a
withNormNewline ()) [Char]
source
                 ([Char] -> Either ParseError XmlTree)
-> (XmlTree -> [Char]) -> XmlTree -> Either ParseError XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> [Char]
xshow
                 (XmlTrees -> [Char]) -> (XmlTree -> XmlTrees) -> XmlTree -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> XmlTrees
forall a. NTree a -> [NTree a]
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren
                 (XmlTree -> Either ParseError XmlTree)
-> XmlTree -> Either ParseError XmlTree
forall a b. (a -> b) -> a -> b
$ XmlTree
r
               ) of
          Right XmlTree
t
              -> (XmlTrees -> XmlTrees) -> XmlTree -> XmlTree
forall a. XmlNode a => (XmlTrees -> XmlTrees) -> a -> a
changeAttrl (XmlTrees -> XmlTrees -> XmlTrees
mergeAttrl (XmlTrees -> XmlTrees -> XmlTrees)
-> (XmlTree -> XmlTrees) -> XmlTree -> XmlTrees -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> Maybe XmlTrees -> XmlTrees
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe XmlTrees -> XmlTrees)
-> (XmlTree -> Maybe XmlTrees) -> XmlTree -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe XmlTrees
forall a. XmlNode a => a -> Maybe XmlTrees
getAttrl (XmlTree -> XmlTrees -> XmlTrees)
-> XmlTree -> XmlTrees -> XmlTrees
forall a b. (a -> b) -> a -> b
$ XmlTree
t) XmlTree
r
          Left ParseError
_
              -> XmlTree
r
        where
        -- arrow \"getAttrValue a_source\" programmed on the tree level (oops!)
        source :: [Char]
source = XmlTrees -> [Char]
xshow
                 (XmlTrees -> [Char]) -> (XmlTree -> XmlTrees) -> XmlTree -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTrees] -> XmlTrees
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                 ([XmlTrees] -> XmlTrees)
-> (XmlTree -> [XmlTrees]) -> XmlTree -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XmlTree -> XmlTrees) -> XmlTrees -> [XmlTrees]
forall a b. (a -> b) -> [a] -> [b]
map XmlTree -> XmlTrees
forall a. NTree a -> [NTree a]
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren
                 (XmlTrees -> [XmlTrees])
-> (XmlTree -> XmlTrees) -> XmlTree -> [XmlTrees]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XmlTree -> Bool) -> XmlTrees -> XmlTrees
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
a_source)
                 ([Char] -> Bool) -> (XmlTree -> [Char]) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> (QName -> [Char]) -> Maybe QName -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" QName -> [Char]
qualifiedName (Maybe QName -> [Char])
-> (XmlTree -> Maybe QName) -> XmlTree -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe QName
forall a. XmlNode a => a -> Maybe QName
getAttrName)
                 (XmlTrees -> XmlTrees)
-> (XmlTree -> XmlTrees) -> XmlTree -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> Maybe XmlTrees -> XmlTrees
forall a. a -> Maybe a -> a
fromMaybe []
                 (Maybe XmlTrees -> XmlTrees)
-> (XmlTree -> Maybe XmlTrees) -> XmlTree -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe XmlTrees
forall a. XmlNode a => a -> Maybe XmlTrees
getAttrl (XmlTree -> [Char]) -> XmlTree -> [Char]
forall a b. (a -> b) -> a -> b
$ XmlTree
r

parseXmlEntityEncodingSpec      :: XmlTree -> XmlTrees
parseXmlEntityEncodingSpec :: XmlTree -> XmlTrees
parseXmlEntityEncodingSpec      = ParsecT [Char] (XPState ()) Identity XmlTree -> XmlTree -> XmlTrees
parseXmlEncodingSpec ParsecT [Char] (XPState ()) Identity XmlTree
forall s. XParser s XmlTree
textDecl''

parseXmlDocEncodingSpec         :: XmlTree -> XmlTrees
parseXmlDocEncodingSpec :: XmlTree -> XmlTrees
parseXmlDocEncodingSpec         = ParsecT [Char] (XPState ()) Identity XmlTree -> XmlTree -> XmlTrees
parseXmlEncodingSpec ParsecT [Char] (XPState ()) Identity XmlTree
forall s. XParser s XmlTree
xMLDecl''

-- ------------------------------------------------------------