{-# 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 :: XParser s XmlTrees
charData
    = ParsecT [Char] (XPState s) Identity XmlTree -> XParser s 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' :: XParser s XmlTree
charData'
    =  do
       [Char]
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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (\ Char
c -> Bool -> Bool
not (Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"<&")) [Char]
"]]>"
       XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> XmlTree
mkText' [Char]
t)

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

comment         :: XParser s XmlTree
comment :: 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' :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

comment''       :: XParser s () -> XParser s XmlTree
comment'' :: XParser s () -> XParser s XmlTree
comment'' XParser s ()
op
    = ( do
        [Char]
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]
"--")
        XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> XmlTree
mkCmt' [Char]
c)
      ) XParser s XmlTree -> [Char] -> XParser s 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 :: 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' :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

pI''             :: XParser s () -> XParser s XmlTree
pI'' :: XParser s () -> XParser s XmlTree
pI'' XParser s ()
op
    = XParser s ()
-> ParsecT [Char] (XPState s) Identity [Char]
-> XParser s XmlTree
-> XParser s 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
        [Char]
n <- ParsecT [Char] (XPState s) Identity [Char]
forall s. XParser s [Char]
pITarget
        [Char]
p <- [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (ParsecT [Char] (XPState s) Identity [Char]
forall s. XParser s [Char]
XT.sPace
                        ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                        (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]
"?>"
                       )
        XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> XmlTrees -> XmlTree
mkPi' ([Char] -> QName
mkName [Char]
n) [QName -> XmlTrees -> XmlTree
mkAttr' ([Char] -> QName
mkName [Char]
a_value) [[Char] -> XmlTree
mkText' [Char]
p]])
      ) XParser s XmlTree -> [Char] -> XParser s 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 :: XParser s [Char]
pITarget = ( do
                   [Char]
n <- XParser s [Char]
forall s. XParser s [Char]
XT.name
                   if (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
t_xml
                      then [Char] -> XParser s [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected [Char]
n
                      else [Char] -> XParser s [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
n
                 )

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

cDSect          :: XParser s XmlTree
cDSect :: 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' :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

cDSect''        :: XParser s () -> XParser s XmlTree
cDSect'' :: XParser s () -> XParser s XmlTree
cDSect'' XParser s ()
op
    = do
      [Char]
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]
"]]>")
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> XmlTree
mkCdata' [Char]
t)
      XParser s XmlTree -> [Char] -> XParser s 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 :: XParser s XmlTree
document
    = do
      SourcePos
pos <- ParsecT [Char] (XPState s) Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      XmlTrees
dl <- XParser s XmlTrees
forall s. XParser s XmlTrees
document'
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTrees -> XmlTrees -> XmlTree
mkRoot' [ QName -> XmlTrees -> XmlTree
mkAttr' ([Char] -> QName
mkName [Char]
a_source) [[Char] -> XmlTree
mkText' (SourcePos -> [Char]
sourceName SourcePos
pos)]
                      , QName -> XmlTrees -> XmlTree
mkAttr' ([Char] -> QName
mkName [Char]
a_status) [[Char] -> XmlTree
mkText' (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c_ok)]
                      ] XmlTrees
dl
             )

document'       :: XParser s XmlTrees
document' :: XParser s XmlTrees
document'
    = do
      XmlTrees
pl <- XParser s XmlTrees
forall s. XParser s XmlTrees
prolog
      XmlTree
el <- XParser s XmlTree
forall s. XParser s XmlTree
element
      XmlTrees
ml <- XParser s XmlTree -> XParser s XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many XParser s XmlTree
forall s. XParser s XmlTree
misc
      ParsecT [Char] (XPState s) Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
      XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTrees
pl XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++ [XmlTree
el] XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++ XmlTrees
ml)

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

xMLDecl         :: XParser s XmlTrees
xMLDecl :: XParser s XmlTrees
xMLDecl
    = ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> XParser s XmlTrees
-> XParser s 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
        XmlTrees
vi <- XParser s XmlTrees
forall s. XParser s XmlTrees
versionInfo
        XmlTrees
ed <- XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] XParser s XmlTrees
forall s. XParser s XmlTrees
encodingDecl
        XmlTrees
sd <- XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] XParser s XmlTrees
forall s. XParser s XmlTrees
sDDecl
        XParser s ()
forall s. XParser s ()
XT.skipS0
        XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTrees
vi XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++ XmlTrees
ed XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++ XmlTrees
sd)
      )
      XParser s XmlTrees -> [Char] -> XParser s 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' :: XParser s XmlTrees
xMLDecl'
    = do
      XmlTrees
al <- XParser s XmlTrees
forall s. XParser s XmlTrees
xMLDecl
      XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [QName -> XmlTrees -> XmlTree
mkPi' ([Char] -> QName
mkName [Char]
t_xml) XmlTrees
al]

xMLDecl''       :: XParser s XmlTree
xMLDecl'' :: XParser s XmlTree
xMLDecl''
    = do
      XmlTrees
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)
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTrees -> XmlTrees -> XmlTree
mkRoot' XmlTrees
al [])

versionInfo     :: XParser s XmlTrees
versionInfo :: 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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              () -> GenParser Char (XPState s) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            )
        GenParser Char (XPState s) ()
forall s. XParser s ()
XT.eq
        [Char]
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
        XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [QName -> XmlTrees -> XmlTree
mkAttr' ([Char] -> QName
mkName [Char]
a_version) [[Char] -> XmlTree
mkText' [Char]
vi]]
      )
      XParser s XmlTrees -> [Char] -> XParser s 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 :: 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
          [Char]
ws <- XParser s [Char]
forall s. XParser s [Char]
XT.sPace
          XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> XmlTree
mkText' [Char]
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 :: XParser s XmlTrees
doctypedecl
    = ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity Char
-> XParser s XmlTrees
-> XParser s 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
        [Char]
n <- ParsecT [Char] (XPState s) Identity [Char]
forall s. XParser s [Char]
XT.name
        [([Char], [Char])]
exId <- [([Char], [Char])]
-> ParsecT [Char] (XPState s) Identity [([Char], [Char])]
-> ParsecT [Char] (XPState s) Identity [([Char], [Char])]
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 [([Char], [Char])]
-> ParsecT [Char] (XPState s) Identity [([Char], [Char])]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                                  XParser s ()
forall s. XParser s ()
XT.skipS
                                  ParsecT [Char] (XPState s) Identity [([Char], [Char])]
forall s. XParser s [([Char], [Char])]
externalID
                                )
                          )
        XParser s ()
forall s. XParser s ()
XT.skipS0
        XmlTrees
markup <- XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option []
                  ( do
                    XmlTrees
m <- ParsecT [Char] (XPState s) Identity Char
-> ParsecT [Char] (XPState s) Identity Char
-> XParser s XmlTrees
-> XParser s 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 (Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ) (Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') XParser s XmlTrees
forall s. XParser s XmlTrees
markupOrDeclSep
                    XParser s ()
forall s. XParser s ()
XT.skipS0
                    XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
m
                  )
        XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> [([Char], [Char])] -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
DOCTYPE (([Char]
a_name, [Char]
n) ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
: [([Char], [Char])]
exId) XmlTrees
markup]
      )

markupOrDeclSep :: XParser s XmlTrees
markupOrDeclSep :: XParser s XmlTrees
markupOrDeclSep
    = ( do
        [XmlTrees]
ll <- XParser s XmlTrees
-> ParsecT [Char] (XPState s) Identity [XmlTrees]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( XParser s XmlTrees
forall s. XParser s XmlTrees
markupdecl
                     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
<|>
                     XParser s XmlTrees
forall s. XParser s XmlTrees
declSep
                     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
<|>
                     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
conditionalSect
                   )
        XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return ([XmlTrees] -> XmlTrees
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [XmlTrees]
ll)
      )

declSep         :: XParser s XmlTrees
declSep :: 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 (m :: * -> *) a. Monad m => a -> m a
return []
      )

markupdecl      :: XParser s XmlTrees
markupdecl :: 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 :: 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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            () -> GenParser Char (XPState s) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          )
      GenParser Char (XPState s) ()
forall s. XParser s ()
XT.eq
      [Char]
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])
      XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [QName -> XmlTrees -> XmlTree
mkAttr' ([Char] -> QName
mkName [Char]
a_standalone) [[Char] -> XmlTree
mkText' [Char]
sd]]

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

element         :: XParser s XmlTree
element :: 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
-> XParser s XmlTree -> XParser s XmlTree
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      XParser s XmlTree
forall s. XParser s XmlTree
element'

element'         :: XParser s XmlTree
element' :: XParser s XmlTree
element'
    = ( do
        (QName, XmlTrees)
e <- XParser s (QName, XmlTrees)
forall s. XParser s (QName, XmlTrees)
elementStart
        (QName, XmlTrees) -> ()
forall a. WNFData a => a -> ()
rwnf (QName, XmlTrees)
e () -> XParser s XmlTree -> XParser s XmlTree
`seq` (QName, XmlTrees) -> XParser s XmlTree
forall s. (QName, XmlTrees) -> XParser s XmlTree
elementRest (QName, XmlTrees)
e              -- evaluate name and attribute list before parsing contents
      ) XParser s XmlTree -> [Char] -> XParser s 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 :: XParser s (QName, XmlTrees)
elementStart
    = do
      [Char]
n  <- XParser s [Char]
forall s. XParser s [Char]
XT.name
      XmlTrees
al <- ParsecT [Char] (XPState s) Identity XmlTrees
forall s. XParser s XmlTrees
attrList
      XParser s ()
forall s. XParser s ()
XT.skipS0
      (QName, XmlTrees) -> XParser s (QName, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> QName
mkName [Char]
n, XmlTrees
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
                        XmlTree
a1 <- XParser s XmlTree
forall s. XParser s XmlTree
attribute
                        XmlTrees
al <- ParsecT [Char] (XPState s) Identity XmlTrees
attrList
                        let n :: QName
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 QName
n QName -> [QName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (XmlTree -> QName) -> XmlTrees -> [QName]
forall a b. (a -> b) -> [a] -> [b]
map (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) XmlTrees
al
                          then [Char] -> ParsecT [Char] (XPState s) Identity XmlTrees
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected
                               ( [Char]
"attribute name " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                 [Char] -> [Char]
forall a. Show a => a -> [Char]
show (QName -> [Char]
qualifiedName QName
n) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                 [Char]
" occurs twice in attribute list"
                               )
                          else XmlTrees -> ParsecT [Char] (XPState s) Identity XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree
a1 XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
: XmlTrees
al)
                      )

elementRest     :: (QName, XmlTrees) -> XParser s XmlTree
elementRest :: (QName, XmlTrees) -> XParser s XmlTree
elementRest (QName
n, XmlTrees
al)
    = ( do
        [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"/>"
        XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ QName -> XmlTrees -> XmlTrees -> XmlTree
mkElement' QName
n XmlTrees
al []
      )
      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
        XParser s ()
forall s. XParser s ()
XT.gt
        XmlTrees
c <- XParser s XmlTrees
forall s. XParser s XmlTrees
content
        QName -> XParser s ()
forall s. QName -> XParser s ()
eTag QName
n
        XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ QName -> XmlTrees -> XmlTrees -> XmlTree
mkElement' QName
n XmlTrees
al XmlTrees
c
      )
      XParser s XmlTree -> [Char] -> XParser s 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 :: 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]
""
      [Char]
n <- XParser s [Char]
forall s. XParser s [Char]
XT.name
      XParser s ()
forall s. XParser s ()
XT.skipS0
      XParser s ()
forall s. XParser s ()
XT.gt
      if [Char]
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== QName -> [Char]
qualifiedName QName
n'
         then () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         else [Char] -> XParser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected ([Char]
"illegal end tag </" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"> found, </" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
qualifiedName QName
n' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"> expected")

attribute       :: XParser s XmlTree
attribute :: XParser s XmlTree
attribute
    = do
      [Char]
n <- XParser s [Char]
forall s. XParser s [Char]
XT.name
      XParser s ()
forall s. XParser s ()
XT.eq
      XmlTrees
v <- XParser s XmlTrees
forall s. XParser s XmlTrees
XT.attrValueT
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ QName -> XmlTrees -> XmlTree
mkAttr' ([Char] -> QName
mkName [Char]
n) XmlTrees
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 :: XParser s XmlTrees
content
    = XmlTrees -> XmlTrees
XT.mergeTextNodes (XmlTrees -> XmlTrees) -> XParser s XmlTrees -> XParser s XmlTrees
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ParsecT [Char] (XPState s) Identity XmlTree -> XParser s 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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                () -> GenParser Char (XPState s) ()
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 (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 :: XParser s XmlTrees
contentWithTextDecl
    = XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] XParser s XmlTrees
forall s. XParser s XmlTrees
textDecl
      XParser s XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      XParser s 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 :: XParser s XmlTree
conditionalSect
    = do
      [Char] -> XParser s ()
forall s. [Char] -> XParser s ()
XT.checkString [Char]
"<!["
      XmlTrees
cs <- XParser s XmlTree -> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many XParser s XmlTree
forall s. XParser s XmlTree
XD.dtdToken
      Char
_ <- Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
      [Char]
sect <- XParser s [Char]
forall s. XParser s [Char]
condSectCont
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> [([Char], [Char])] -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONDSECT [([Char]
a_value, [Char]
sect)] XmlTrees
cs)
    where

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

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

externalID      :: XParser s Attributes
externalID :: XParser s [([Char], [Char])]
externalID
    = ( do
        [Char]
_ <- [Char] -> XParser s [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_system
        XParser s ()
forall s. XParser s ()
XT.skipS
        [Char]
lit <- XParser s [Char]
forall s. XParser s [Char]
XT.systemLiteral
        [([Char], [Char])] -> XParser s [([Char], [Char])]
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
k_system, [Char]
lit)]
      )
      XParser s [([Char], [Char])]
-> XParser s [([Char], [Char])] -> XParser s [([Char], [Char])]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        [Char]
_ <- [Char] -> XParser s [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_public
        XParser s ()
forall s. XParser s ()
XT.skipS
        [Char]
pl <- XParser s [Char]
forall s. XParser s [Char]
XT.pubidLiteral
        XParser s ()
forall s. XParser s ()
XT.skipS
        [Char]
sl <- XParser s [Char]
forall s. XParser s [Char]
XT.systemLiteral
        [([Char], [Char])] -> XParser s [([Char], [Char])]
forall (m :: * -> *) a. Monad m => a -> m a
return [ ([Char]
k_system, [Char]
sl)
               , ([Char]
k_public, [Char]
pl) ]
      )
      XParser s [([Char], [Char])]
-> [Char] -> XParser s [([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 :: XParser s XmlTrees
textDecl
    = ParsecT [Char] (XPState s) Identity [Char]
-> ParsecT [Char] (XPState s) Identity [Char]
-> XParser s XmlTrees
-> XParser s 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
        XmlTrees
vi <- XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] XParser s XmlTrees
forall s. XParser s XmlTrees
versionInfo
        XmlTrees
ed <- XParser s XmlTrees
forall s. XParser s XmlTrees
encodingDecl
        XParser s ()
forall s. XParser s ()
XT.skipS0
        XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTrees
vi XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++ XmlTrees
ed)
      )
      XParser s XmlTrees -> [Char] -> XParser s 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'' :: XParser s XmlTree
textDecl''
    = do
      XmlTrees
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)
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTrees -> XmlTrees -> XmlTree
mkRoot' XmlTrees
al [])

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

encodingDecl    :: XParser s XmlTrees
encodingDecl :: 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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            () -> GenParser Char (XPState s) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          )
      GenParser Char (XPState s) ()
forall s. XParser s ()
XT.eq
      [Char]
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
      XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [QName -> XmlTrees -> XmlTree
mkAttr' ([Char] -> QName
mkName [Char]
a_encoding) [[Char] -> XmlTree
mkText' [Char]
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 (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
             XmlTrees
res <- XParser () XmlTrees
content'
             ParsecT [Char] (XPState ()) Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof                        -- test on everything consumed
             XmlTrees -> XParser () XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
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 :: 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
-> XParser s [Char] -> XParser s [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             XParser s [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
        XmlTrees
res <- XParser () XmlTrees
parser
        ParsecT [Char] (XPState ()) Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT [Char] (XPState ()) Identity ()
-> [Char] -> ParsecT [Char] (XPState ()) Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
expected
        XmlTrees -> XParser () XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
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 (m :: * -> *) t u a.
Stream s m t =>
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 (m :: * -> *) t u a.
Stream s m t =>
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 (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 (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''

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