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

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

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

   Parsec parser for DTD declarations for ELEMENT, ATTLIST, ENTITY and NOTATION declarations

-}

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

module Text.XML.HXT.Parser.XmlDTDParser
    ( parseXmlDTDdecl
    , parseXmlDTDdeclPart
    , parseXmlDTDEntityValue
    , elementDecl
    , attlistDecl
    , entityDecl
    , notationDecl
    )
where

import Data.Maybe

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Pos

import Text.XML.HXT.DOM.Interface

import Text.XML.HXT.DOM.ShowXml
    ( xshow
    )
import Text.XML.HXT.DOM.XmlNode                        ( mkDTDElem'
                                                       , mkText'
                                                       , mkError'
                                                       , isText
                                                       , isDTD
                                                       , getText
                                                       , getDTDPart
                                                       , getDTDAttrl
                                                       , getChildren
                                                       , setChildren
                                                       )
import qualified Text.XML.HXT.Parser.XmlTokenParser    as XT

import           Text.XML.HXT.Parser.XmlCharParser     ( XParser
                                                       , XPState(..)
                                                       , withoutNormNewline
                                                       )

import qualified Text.XML.HXT.Parser.XmlCharParser     as XC
                                                       ( xmlSpaceChar )

import qualified Text.XML.HXT.Parser.XmlDTDTokenParser as XD
                                                       ( dtdToken )

-----------------------------------------------------------
--
-- all parsers dealing with whitespace will be redefined
-- to handle parameter entity substitution

type LocalState = (Int, [(Int, String, SourcePos)])

type SParser a  = XParser LocalState a

initialState    :: SourcePos -> XPState LocalState
initialState :: SourcePos -> XPState LocalState
initialState SourcePos
p  = LocalState -> XPState LocalState
forall a. a -> XPState a
withoutNormNewline (Int
0, [(Int
0, SourcePos -> SourceName
sourceName SourcePos
p, SourcePos
p)])

updateLocalState :: (LocalState -> LocalState) -> SParser ()
updateLocalState :: (LocalState -> LocalState) -> SParser ()
updateLocalState LocalState -> LocalState
upd
                = (XPState LocalState -> XPState LocalState) -> SParser ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((XPState LocalState -> XPState LocalState) -> SParser ())
-> (XPState LocalState -> XPState LocalState) -> SParser ()
forall a b. (a -> b) -> a -> b
$ \ XPState LocalState
xps -> XPState LocalState
xps { xps_userState :: LocalState
xps_userState = LocalState -> LocalState
upd (LocalState -> LocalState) -> LocalState -> LocalState
forall a b. (a -> b) -> a -> b
$ XPState LocalState -> LocalState
forall s. XPState s -> s
xps_userState XPState LocalState
xps }

pushPar         :: String -> SParser ()
pushPar :: SourceName -> SParser ()
pushPar SourceName
n       = do
                  SourcePos
p <- ParsecT SourceName (XPState LocalState) Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                  (LocalState -> LocalState) -> SParser ()
updateLocalState (\ (Int
i, [(Int, SourceName, SourcePos)]
s) -> (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, SourceName
n, SourcePos
p) (Int, SourceName, SourcePos)
-> [(Int, SourceName, SourcePos)] -> [(Int, SourceName, SourcePos)]
forall a. a -> [a] -> [a]
: [(Int, SourceName, SourcePos)]
s))
                  SourcePos -> SParser ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition ( SourceName -> Int -> Int -> SourcePos
newPos (SourcePos -> SourceName
sourceName SourcePos
p SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
" (line " SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ Int -> SourceName
forall a. Show a => a -> SourceName
show (SourcePos -> Int
sourceLine SourcePos
p) SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
", column " SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ Int -> SourceName
forall a. Show a => a -> SourceName
show (SourcePos -> Int
sourceColumn SourcePos
p) SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
") in content of parameter entity ref %" SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
n SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
";") Int
1 Int
1)

popPar          :: SParser ()
popPar :: SParser ()
popPar          = do
                  SourcePos
oldPos <- ParsecT SourceName (XPState LocalState) Identity SourcePos
getPos
                  (LocalState -> LocalState) -> SParser ()
updateLocalState LocalState -> LocalState
forall a b c. Num a => (a, [(a, b, c)]) -> (a, [(a, b, c)])
pop
                  SourcePos -> SParser ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
oldPos
                where
                pop :: (a, [(a, b, c)]) -> (a, [(a, b, c)])
pop (a
i, [(a
_, b
s, c
p)]) = (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1, [(a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1, b
s, c
p)])     -- if param entity substitution is correctly implemented, this case does not occur
                pop (a
i, (a, b, c)
_t:[(a, b, c)]
s)        = (a
i, [(a, b, c)]
s)
                pop (a
_i, [])         = (a, [(a, b, c)])
forall a. HasCallStack => a
undefined                -- stack is never empty

getParNo        :: SParser Int
getParNo :: SParser Int
getParNo        = do
                  XPState LocalState
s <- ParsecT
  SourceName (XPState LocalState) Identity (XPState LocalState)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                  let (Int
_i, (Int
top, SourceName
_n, SourcePos
_p) : [(Int, SourceName, SourcePos)]
_s) = XPState LocalState -> LocalState
forall s. XPState s -> s
xps_userState XPState LocalState
s
                  Int -> SParser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
top

getPos          :: SParser SourcePos
getPos :: ParsecT SourceName (XPState LocalState) Identity SourcePos
getPos          = do
                  XPState LocalState
s <- ParsecT
  SourceName (XPState LocalState) Identity (XPState LocalState)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                  let (Int
_i, (Int
_top, SourceName
_n, SourcePos
p) : [(Int, SourceName, SourcePos)]
_s) = XPState LocalState -> LocalState
forall s. XPState s -> s
xps_userState XPState LocalState
s
                  SourcePos
-> ParsecT SourceName (XPState LocalState) Identity SourcePos
forall (m :: * -> *) a. Monad m => a -> m a
return SourcePos
p

delPE   :: SParser ()
delPE :: SParser ()
delPE   = do
          Char
_ <- Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\0'
          () -> SParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

startPE :: SParser ()
startPE :: SParser ()
startPE
    = do
      SParser () -> SParser ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
            SParser ()
delPE
            SourceName
n <- ParsecT SourceName (XPState LocalState) Identity Char
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool)
-> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0'))
            SParser ()
delPE
            SourceName -> SParser ()
pushPar SourceName
n
          )

endPE   :: SParser ()
endPE :: SParser ()
endPE
    = do
      SParser () -> SParser ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
           SParser ()
delPE
           SParser ()
delPE
           SParser ()
popPar
          )

inSamePE        :: SParser a -> SParser a
inSamePE :: SParser a -> SParser a
inSamePE SParser a
p
    = do
      Int
i <- SParser Int
getParNo
      a
r <- SParser a
p
      Int
j <- SParser Int
getParNo
      if (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j)
         then a -> SParser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
         else SourceName -> SParser a
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail (SourceName -> SParser a) -> SourceName -> SParser a
forall a b. (a -> b) -> a -> b
$ SourceName
"parameter entity contents does not fit into the structure of a DTD declarations"

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

xmlSpaceChar    :: SParser ()
xmlSpaceChar :: SParser ()
xmlSpaceChar    = ( ParsecT SourceName (XPState LocalState) Identity Char
forall s. XParser s Char
XC.xmlSpaceChar
                    ParsecT SourceName (XPState LocalState) Identity Char
-> SParser () -> SParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                    () -> SParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  )
                  SParser () -> SParser () -> SParser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  SParser ()
startPE
                  SParser () -> SParser () -> SParser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  SParser ()
endPE
                  SParser () -> SourceName -> SParser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"white space"

skipS           :: SParser ()
skipS :: SParser ()
skipS
    = SParser () -> SParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 SParser ()
xmlSpaceChar
      SParser () -> SParser () -> SParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      () -> SParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

skipS0          :: SParser ()
skipS0 :: SParser ()
skipS0
    = SParser () -> SParser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany SParser ()
xmlSpaceChar
      SParser () -> SParser () -> SParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      () -> SParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

name            :: SParser XmlTree
name :: SParser XmlTree
name
    = do
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
      XmlTree -> SParser XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
NAME [(SourceName
a_name, SourceName
n)] [])

nmtoken         :: SParser XmlTree
nmtoken :: SParser XmlTree
nmtoken
    = do
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.nmtoken
      XmlTree -> SParser XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
NAME [(SourceName
a_name, SourceName
n)] [])

-- ------------------------------------------------------------
--
-- Element Type Declarations (3.2)

elementDecl     :: SParser XmlTrees
elementDecl :: SParser XmlTrees
elementDecl
    = ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity Char
-> SParser XmlTrees
-> SParser 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 SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT SourceName (XPState LocalState) Identity SourceName
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"<!ELEMENT") (Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>') SParser XmlTrees
elementDeclBody

elementDeclBody :: SParser XmlTrees
elementDeclBody :: SParser XmlTrees
elementDeclBody
    = do
      SParser ()
skipS
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
      SParser ()
skipS
      (Attributes
al, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
contentspec
      SParser ()
skipS0
      XmlTrees -> SParser XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
ELEMENT ((SourceName
a_name, SourceName
n) (SourceName, SourceName) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl]

contentspec     :: SParser (Attributes, XmlTrees)
contentspec :: SParser (Attributes, XmlTrees)
contentspec
    = SourceName -> SourceName -> SParser (Attributes, XmlTrees)
forall b s a.
SourceName
-> b
-> ParsecT SourceName (XPState s) Identity ([(SourceName, b)], [a])
simplespec SourceName
k_empty SourceName
v_empty
      SParser (Attributes, XmlTrees)
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      SourceName -> SourceName -> SParser (Attributes, XmlTrees)
forall b s a.
SourceName
-> b
-> ParsecT SourceName (XPState s) Identity ([(SourceName, b)], [a])
simplespec SourceName
k_any SourceName
v_any
      SParser (Attributes, XmlTrees)
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall a. SParser a -> SParser a
inSamePE SParser (Attributes, XmlTrees)
mixed
      SParser (Attributes, XmlTrees)
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall a. SParser a -> SParser a
inSamePE SParser (Attributes, XmlTrees)
children
      SParser (Attributes, XmlTrees)
-> SourceName -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"content specification"
    where
    simplespec :: SourceName
-> b
-> ParsecT SourceName (XPState s) Identity ([(SourceName, b)], [a])
simplespec SourceName
kw b
v
        = do
          SourceName
_ <- SourceName -> XParser s SourceName
forall s. SourceName -> XParser s SourceName
XT.keyword SourceName
kw
          ([(SourceName, b)], [a])
-> ParsecT SourceName (XPState s) Identity ([(SourceName, b)], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceName
a_type, b
v)], [])

-- ------------------------------------------------------------
--
-- Element Content (3.2.1)

children        :: SParser (Attributes, XmlTrees)
children :: SParser (Attributes, XmlTrees)
children
    = ( do
        (Attributes
al, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
choiceOrSeq
        Attributes
modifier <- SParser Attributes
optOrRep
        (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceName
a_type, SourceName
v_children)], [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT (Attributes
modifier Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++ Attributes
al) XmlTrees
cl])
      )
      SParser (Attributes, XmlTrees)
-> SourceName -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"element content"

optOrRep        :: SParser Attributes
optOrRep :: SParser Attributes
optOrRep
    = do
      SourceName
m <- SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option SourceName
"" (ParsecT SourceName (XPState LocalState) Identity Char
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s a. XParser s a -> XParser s [a]
XT.mkList (SourceName -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
oneOf SourceName
"?*+"))
      Attributes -> SParser Attributes
forall (m :: * -> *) a. Monad m => a -> m a
return [(SourceName
a_modifier, SourceName
m)]

choiceOrSeq     :: SParser (Attributes, XmlTrees)
choiceOrSeq :: SParser (Attributes, XmlTrees)
choiceOrSeq
    = SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall a. SParser a -> SParser a
inSamePE (SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees))
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall a b. (a -> b) -> a -> b
$
      do
      (Attributes, XmlTrees)
cl <- SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                  SParser ()
lpar
                  SParser (Attributes, XmlTrees)
choiceOrSeqBody
                )
      SParser ()
rpar
      (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return (Attributes, XmlTrees)
cl

choiceOrSeqBody :: SParser (Attributes, XmlTrees)
choiceOrSeqBody :: SParser (Attributes, XmlTrees)
choiceOrSeqBody
    = do
      XmlTree
cp1 <- SParser XmlTree
cp
      XmlTree -> SParser (Attributes, XmlTrees)
choiceOrSeq1 XmlTree
cp1
    where
    choiceOrSeq1        :: XmlTree -> SParser (Attributes, XmlTrees)
    choiceOrSeq1 :: XmlTree -> SParser (Attributes, XmlTrees)
choiceOrSeq1 XmlTree
c1
        = ( do
            SParser ()
bar
            XmlTree
c2 <- SParser XmlTree
cp
            XmlTrees
cl <- SParser XmlTree -> SParser XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( do
                         SParser ()
bar
                         SParser XmlTree
cp
                       )
            (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceName
a_kind, SourceName
v_choice)], (XmlTree
c1 XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
: XmlTree
c2 XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
: XmlTrees
cl))
          )
          SParser (Attributes, XmlTrees)
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          ( do
            XmlTrees
cl <- SParser XmlTree -> SParser XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( do
                         SParser ()
comma
                         SParser XmlTree
cp
                       )
            (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceName
a_kind, SourceName
v_seq)], (XmlTree
c1 XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
: XmlTrees
cl))
          )
          SParser (Attributes, XmlTrees)
-> SourceName -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"sequence or choice"

cp              :: SParser XmlTree
cp :: SParser XmlTree
cp
    = ( do
        XmlTree
n <- SParser XmlTree
name
        Attributes
m <- SParser Attributes
optOrRep
        XmlTree -> SParser XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return ( case Attributes
m of
                 [(SourceName
_, SourceName
"")] -> XmlTree
n
                 Attributes
_         -> DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT (Attributes
m Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++ [(SourceName
a_kind, SourceName
v_seq)]) [XmlTree
n]
               )
      )
      SParser XmlTree -> SParser XmlTree -> SParser XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        (Attributes
al, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
choiceOrSeq
        Attributes
m <- SParser Attributes
optOrRep
        XmlTree -> SParser XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT (Attributes
m Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++ Attributes
al) XmlTrees
cl)
      )

-- ------------------------------------------------------------
--
-- Mixed Content (3.2.2)

mixed           :: SParser (Attributes, XmlTrees)
mixed :: SParser (Attributes, XmlTrees)
mixed
    = ( do
        SourceName
_ <- ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                   SParser ()
lpar
                   SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
k_pcdata
                 )
        XmlTrees
nl <- SParser XmlTree -> SParser XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( do
                     SParser ()
bar
                     SParser XmlTree
name
                   )
        SParser ()
rpar
        if XmlTrees -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null XmlTrees
nl
          then do
               Char
_ <- Char
-> ParsecT SourceName (XPState LocalState) Identity Char
-> ParsecT SourceName (XPState LocalState) 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
' ' (Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*')               -- (#PCDATA) or (#PCDATA)* , both are legal
               (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ( [ (SourceName
a_type, SourceName
v_pcdata) ]
                      , []
                      )
          else do
               Char
_ <- Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' ParsecT SourceName (XPState LocalState) Identity Char
-> SourceName
-> ParsecT SourceName (XPState LocalState) Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"closing parent for mixed content (\")*\")"
               (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ( [ (SourceName
a_type, SourceName
v_mixed) ]
                      , [ DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT [ (SourceName
a_modifier, SourceName
"*")
                                             , (SourceName
a_kind, SourceName
v_choice)
                                             ] XmlTrees
nl
                        ]
                      )
      )
      SParser (Attributes, XmlTrees)
-> SourceName -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"mixed content"

-- ------------------------------------------------------------
--
-- Attribute-List Declarations (3.3)

attlistDecl             :: SParser XmlTrees
attlistDecl :: SParser XmlTrees
attlistDecl
    = ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity Char
-> SParser XmlTrees
-> SParser 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 SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT SourceName (XPState LocalState) Identity SourceName
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"<!ATTLIST") (Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>') SParser XmlTrees
attlistDeclBody

attlistDeclBody         :: SParser XmlTrees
attlistDeclBody :: SParser XmlTrees
attlistDeclBody
    = do
      SParser ()
skipS
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
      [(Attributes, XmlTrees)]
al <- SParser (Attributes, XmlTrees)
-> ParsecT
     SourceName (XPState LocalState) Identity [(Attributes, XmlTrees)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many SParser (Attributes, XmlTrees)
attDef
      SParser ()
skipS0
      XmlTrees -> SParser XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return (((Attributes, XmlTrees) -> XmlTree)
-> [(Attributes, XmlTrees)] -> XmlTrees
forall a b. (a -> b) -> [a] -> [b]
map (SourceName -> (Attributes, XmlTrees) -> XmlTree
mkDTree SourceName
n) [(Attributes, XmlTrees)]
al)
    where
    mkDTree :: SourceName -> (Attributes, XmlTrees) -> XmlTree
mkDTree SourceName
n' (Attributes
al, XmlTrees
cl)
        = DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
ATTLIST ((SourceName
a_name, SourceName
n') (SourceName, SourceName) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl

attDef          :: SParser (Attributes, XmlTrees)
attDef :: SParser (Attributes, XmlTrees)
attDef
    = do
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                 SParser ()
skipS
                 ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
               ) ParsecT SourceName (XPState LocalState) Identity SourceName
-> SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"attribute name"
      SParser ()
skipS
      (Attributes
t, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
attType
      SParser ()
skipS
      Attributes
d <- SParser Attributes
defaultDecl
      (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return (((SourceName
a_value, SourceName
n) (SourceName, SourceName) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
d) Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++ Attributes
t, XmlTrees
cl)

attType :: SParser (Attributes, XmlTrees)
attType :: SParser (Attributes, XmlTrees)
attType
    = SParser (Attributes, XmlTrees)
tokenizedOrStringType
      SParser (Attributes, XmlTrees)
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      SParser (Attributes, XmlTrees)
enumeration
      SParser (Attributes, XmlTrees)
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      SParser (Attributes, XmlTrees)
notationType
      SParser (Attributes, XmlTrees)
-> SourceName -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"attribute type"

tokenizedOrStringType   :: SParser (Attributes, XmlTrees)
tokenizedOrStringType :: SParser (Attributes, XmlTrees)
tokenizedOrStringType
    = do
      SourceName
n <- [ParsecT SourceName (XPState LocalState) Identity SourceName]
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT SourceName (XPState LocalState) Identity SourceName]
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> [ParsecT SourceName (XPState LocalState) Identity SourceName]
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall a b. (a -> b) -> a -> b
$ (SourceName
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> [SourceName]
-> [ParsecT SourceName (XPState LocalState) Identity SourceName]
forall a b. (a -> b) -> [a] -> [b]
map SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. SourceName -> XParser s SourceName
XT.keyword [SourceName]
typl
      (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceName
a_type, SourceName
n)], [])
      where
      typl :: [SourceName]
typl      = [ SourceName
k_cdata
                  , SourceName
k_idrefs
                  , SourceName
k_idref
                  , SourceName
k_id
                  , SourceName
k_entity
                  , SourceName
k_entities
                  , SourceName
k_nmtokens
                  , SourceName
k_nmtoken
                  ]

enumeration     :: SParser (Attributes, XmlTrees)
enumeration :: SParser (Attributes, XmlTrees)
enumeration
    = do
      XmlTrees
nl <- SParser XmlTrees -> SParser XmlTrees
forall a. SParser a -> SParser a
inSamePE (SParser () -> SParser () -> SParser XmlTrees -> SParser 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 SParser ()
lpar SParser ()
rpar (SParser XmlTree -> SParser () -> SParser XmlTrees
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 SParser XmlTree
nmtoken SParser ()
bar))
      (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceName
a_type, SourceName
k_enumeration)], XmlTrees
nl)

notationType    :: SParser (Attributes, XmlTrees)
notationType :: SParser (Attributes, XmlTrees)
notationType
    = do
      SourceName
_ <- SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. SourceName -> XParser s SourceName
XT.keyword SourceName
k_notation
      SParser ()
skipS
      XmlTrees
nl <- SParser XmlTrees -> SParser XmlTrees
forall a. SParser a -> SParser a
inSamePE (SParser () -> SParser () -> SParser XmlTrees -> SParser 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 SParser ()
lpar SParser ()
rpar ( SParser XmlTree -> SParser () -> SParser XmlTrees
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 SParser XmlTree
name SParser ()
bar ))
      (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceName
a_type, SourceName
k_notation)], XmlTrees
nl)

defaultDecl     :: SParser Attributes
defaultDecl :: SParser Attributes
defaultDecl
    = ( do
        SourceName
str <- ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT SourceName (XPState LocalState) Identity SourceName
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
k_required
        Attributes -> SParser Attributes
forall (m :: * -> *) a. Monad m => a -> m a
return [(SourceName
a_kind, SourceName
str)]
      )
      SParser Attributes -> SParser Attributes -> SParser Attributes
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        SourceName
str <- ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT SourceName (XPState LocalState) Identity SourceName
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
k_implied
        Attributes -> SParser Attributes
forall (m :: * -> *) a. Monad m => a -> m a
return [(SourceName
a_kind, SourceName
str)]
      )
      SParser Attributes -> SParser Attributes -> SParser Attributes
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        Attributes
l <- SParser Attributes
fixed
        XmlTrees
v <- SParser XmlTrees
forall s. XParser s XmlTrees
XT.attrValueT
        Attributes -> SParser Attributes
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceName
a_default, XmlTrees -> SourceName
xshow XmlTrees
v) (SourceName, SourceName) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
l)
      )
      SParser Attributes -> SourceName -> SParser Attributes
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"default declaration"
    where
    fixed :: SParser Attributes
fixed = Attributes -> SParser Attributes -> SParser Attributes
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [(SourceName
a_kind, SourceName
k_default)]
            ( do
              SourceName
_ <- ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT SourceName (XPState LocalState) Identity SourceName
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
k_fixed
              SParser ()
skipS
              Attributes -> SParser Attributes
forall (m :: * -> *) a. Monad m => a -> m a
return [(SourceName
a_kind, SourceName
k_fixed)]
            )

-- ------------------------------------------------------------
--
-- Entity Declarations (4.2)

entityDecl              :: SParser XmlTrees
entityDecl :: SParser XmlTrees
entityDecl
    = ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity Char
-> SParser XmlTrees
-> SParser 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 SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT SourceName (XPState LocalState) Identity SourceName
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"<!ENTITY" ) (Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>') SParser XmlTrees
entityDeclBody

entityDeclBody          :: SParser XmlTrees
entityDeclBody :: SParser XmlTrees
entityDeclBody
    = do
      SParser ()
skipS
      ( SParser XmlTrees
peDecl
        SParser XmlTrees -> SParser XmlTrees -> SParser XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        SParser XmlTrees
geDecl
        SParser XmlTrees -> SourceName -> SParser XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"entity declaration" )      -- don't move the ) to the next line

geDecl                  :: SParser XmlTrees
geDecl :: SParser XmlTrees
geDecl
    = do
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
      SParser ()
skipS
      (Attributes
al, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
entityDef
      SParser ()
skipS0
      XmlTrees -> SParser XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
ENTITY ((SourceName
a_name, SourceName
n) (SourceName, SourceName) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl]

entityDef               :: SParser (Attributes, XmlTrees)
entityDef :: SParser (Attributes, XmlTrees)
entityDef
    = SParser (Attributes, XmlTrees)
forall s. XParser s (Attributes, XmlTrees)
entityValue
      SParser (Attributes, XmlTrees)
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      SParser (Attributes, XmlTrees)
externalEntitySpec

externalEntitySpec      :: SParser (Attributes, XmlTrees)
externalEntitySpec :: SParser (Attributes, XmlTrees)
externalEntitySpec
    = do
      Attributes
al <- SParser Attributes
externalID
      Attributes
nd <- Attributes -> SParser Attributes -> SParser Attributes
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] SParser Attributes
nDataDecl
      (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Attributes
al Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++ Attributes
nd), [])

peDecl                  :: SParser XmlTrees
peDecl :: SParser XmlTrees
peDecl
    = do
      Char
_ <- Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
      SParser ()
skipS
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
      SParser ()
skipS
      (Attributes
al, XmlTrees
cs) <- SParser (Attributes, XmlTrees)
peDef
      SParser ()
skipS0
      XmlTrees -> SParser XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
PENTITY ((SourceName
a_name, SourceName
n) (SourceName, SourceName) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cs]

peDef                   :: SParser (Attributes, XmlTrees)
peDef :: SParser (Attributes, XmlTrees)
peDef
    = SParser (Attributes, XmlTrees)
forall s. XParser s (Attributes, XmlTrees)
entityValue
      SParser (Attributes, XmlTrees)
-> SParser (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      Attributes
al <- SParser Attributes
externalID
      (Attributes, XmlTrees) -> SParser (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return (Attributes
al, [])

entityValue     :: XParser s (Attributes, XmlTrees)
entityValue :: XParser s (Attributes, XmlTrees)
entityValue
    = do
      XmlTrees
v <- XParser s XmlTrees
forall s. XParser s XmlTrees
XT.entityValueT
      (Attributes, XmlTrees) -> XParser s (Attributes, XmlTrees)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], XmlTrees
v)

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

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

nDataDecl       :: SParser Attributes
nDataDecl :: SParser Attributes
nDataDecl
    = do
      SourceName
_ <- ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                 SParser ()
skipS
                 SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. SourceName -> XParser s SourceName
XT.keyword SourceName
k_ndata
               )
      SParser ()
skipS
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
      Attributes -> SParser Attributes
forall (m :: * -> *) a. Monad m => a -> m a
return [(SourceName
k_ndata, SourceName
n)]

-- ------------------------------------------------------------
--
-- Notation Declarations (4.7)

notationDecl            :: SParser XmlTrees
notationDecl :: SParser XmlTrees
notationDecl
    = ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity Char
-> SParser XmlTrees
-> SParser 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 SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT SourceName (XPState LocalState) Identity SourceName
 -> ParsecT SourceName (XPState LocalState) Identity SourceName)
-> ParsecT SourceName (XPState LocalState) Identity SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall a b. (a -> b) -> a -> b
$ SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"<!NOTATION") (Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>' ParsecT SourceName (XPState LocalState) Identity Char
-> SourceName
-> ParsecT SourceName (XPState LocalState) Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"notation declaration") SParser XmlTrees
notationDeclBody

notationDeclBody        :: SParser XmlTrees
notationDeclBody :: SParser XmlTrees
notationDeclBody
    = do
      SParser ()
skipS
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
      SParser ()
skipS
      Attributes
eid <- ( SParser Attributes -> SParser Attributes
forall tok st a. GenParser tok st a -> GenParser tok st a
try SParser Attributes
externalID
               SParser Attributes -> SParser Attributes -> SParser Attributes
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               SParser Attributes
publicID
             )
      SParser ()
skipS0
      XmlTrees -> SParser XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
NOTATION ((SourceName
a_name, SourceName
n) (SourceName, SourceName) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
eid) []]

publicID                :: SParser Attributes
publicID :: SParser Attributes
publicID
    = do
      SourceName
_ <- SourceName
-> ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. SourceName -> XParser s SourceName
XT.keyword SourceName
k_public
      SParser ()
skipS
      SourceName
l <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.pubidLiteral
      Attributes -> SParser Attributes
forall (m :: * -> *) a. Monad m => a -> m a
return [(SourceName
k_public, SourceName
l)]

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

condSectCondBody        :: SParser XmlTrees
condSectCondBody :: SParser XmlTrees
condSectCondBody
    = do
      SParser ()
skipS0
      SourceName
n <- ParsecT SourceName (XPState LocalState) Identity SourceName
forall s. XParser s SourceName
XT.name
      SParser ()
skipS0
      let n' :: SourceName
n' = SourceName -> SourceName
stringToUpper SourceName
n
      if SourceName
n' SourceName -> [SourceName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SourceName
k_include, SourceName
k_ignore]
         then XmlTrees -> SParser XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return [SourceName -> XmlTree
mkText'  SourceName
n']
         else SourceName -> SParser XmlTrees
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail (SourceName -> SParser XmlTrees) -> SourceName -> SParser XmlTrees
forall a b. (a -> b) -> a -> b
$ SourceName
"INCLUDE or IGNORE expected in conditional section"

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

separator       :: Char -> SParser ()
separator :: Char -> SParser ()
separator Char
c
    = do
      Char
_ <- ParsecT SourceName (XPState LocalState) Identity Char
-> ParsecT SourceName (XPState LocalState) Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                 SParser ()
skipS0
                 Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
               )
      SParser ()
skipS0
      SParser () -> SourceName -> SParser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> [Char
c]


bar, comma, lpar, rpar  :: SParser ()

bar :: SParser ()
bar     = Char -> SParser ()
separator Char
'|'
comma :: SParser ()
comma   = Char -> SParser ()
separator Char
','

lpar :: SParser ()
lpar
    = do
      Char
_ <- Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
      SParser ()
skipS0

rpar :: SParser ()
rpar
    = do
      SParser ()
skipS0
      Char
_ <- Char -> ParsecT SourceName (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
      () -> SParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

parseXmlDTDEntityValue  :: XmlTree -> XmlTrees
parseXmlDTDEntityValue :: XmlTree -> XmlTrees
parseXmlDTDEntityValue XmlTree
t        -- (NTree (XDTD PEREF al) cl)
    | XmlTree -> Bool
isDTDPEref XmlTree
t
        = ( (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 -> SourceName -> XmlTree
mkError' Int
c_err (SourceName -> XmlTree)
-> (ParseError -> SourceName) -> ParseError -> XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
"\n") (SourceName -> SourceName)
-> (ParseError -> SourceName) -> ParseError -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> SourceName
forall a. Show a => a -> SourceName
show )
            ( \XmlTrees
cl' -> if XmlTrees -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null XmlTrees
cl'
                         then [SourceName -> XmlTree
mkText' SourceName
""]
                         else XmlTrees
cl'
            )
            (Either ParseError XmlTrees -> XmlTrees)
-> (SourceName -> Either ParseError XmlTrees)
-> SourceName
-> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            GenParser Char (XPState ()) XmlTrees
-> XPState ()
-> SourceName
-> SourceName
-> Either ParseError XmlTrees
forall tok st a.
GenParser tok st a
-> st -> SourceName -> [tok] -> Either ParseError a
runParser GenParser Char (XPState ()) XmlTrees
forall s. XParser s XmlTrees
parser (() -> XPState ()
forall a. a -> XPState a
withoutNormNewline ()) SourceName
source
          ) SourceName
input
    | Bool
otherwise
        = []
    where
    al :: Attributes
al     = Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Attributes -> Attributes)
-> (XmlTree -> Maybe Attributes) -> XmlTree -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe Attributes
forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl (XmlTree -> Attributes) -> XmlTree -> Attributes
forall a b. (a -> b) -> a -> b
$ XmlTree
t
    cl :: XmlTrees
cl     = XmlTree -> XmlTrees
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t
    parser :: XParser s XmlTrees
parser = SourceName -> XParser s XmlTrees
forall s. SourceName -> XParser s XmlTrees
XT.entityTokensT SourceName
"%&"
    source :: SourceName
source = SourceName
"value of parameter entity " SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName -> SourceName -> Attributes -> SourceName
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef SourceName
"" SourceName
a_peref Attributes
al
    input :: SourceName
input  = XmlTrees -> SourceName
xshow XmlTrees
cl

{-
parseXmlDTDEntityValue n
    = error ("parseXmlDTDEntityValue: illegal argument: " ++ show n)
-}
-- ------------------------------------------------------------

parseXmlDTDdeclPart     :: XmlTree -> XmlTrees
parseXmlDTDdeclPart :: XmlTree -> XmlTrees
parseXmlDTDdeclPart XmlTree
t           -- @(NTree (XDTD PEREF al) cl)
    | XmlTree -> Bool
isDTDPEref XmlTree
t
        = ( (XmlTree -> XmlTrees -> XmlTrees
forall a. a -> [a] -> [a]
:[])
            (XmlTree -> XmlTrees)
-> (SourceName -> XmlTree) -> SourceName -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (ParseError -> XmlTree)
-> (XmlTrees -> XmlTree) -> Either ParseError XmlTrees -> XmlTree
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
               ( Int -> SourceName -> XmlTree
mkError' Int
c_err (SourceName -> XmlTree)
-> (ParseError -> SourceName) -> ParseError -> XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
"\n") (SourceName -> SourceName)
-> (ParseError -> SourceName) -> ParseError -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> SourceName
forall a. Show a => a -> SourceName
show )
               ( (XmlTrees -> XmlTree -> XmlTree) -> XmlTree -> XmlTrees -> XmlTree
forall a b c. (a -> b -> c) -> b -> a -> c
flip XmlTrees -> XmlTree -> XmlTree
forall (t :: * -> *) a. Tree t => [t a] -> t a -> t a
setChildren (XmlTree -> XmlTrees -> XmlTree) -> XmlTree -> XmlTrees -> XmlTree
forall a b. (a -> b) -> a -> b
$ XmlTree
t ) -- \ cl' -> setChildren cl' t)
            (Either ParseError XmlTrees -> XmlTree)
-> (SourceName -> Either ParseError XmlTrees)
-> SourceName
-> XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            GenParser Char (XPState ()) XmlTrees
-> XPState ()
-> SourceName
-> SourceName
-> Either ParseError XmlTrees
forall tok st a.
GenParser tok st a
-> st -> SourceName -> [tok] -> Either ParseError a
runParser GenParser Char (XPState ()) XmlTrees
forall s. XParser s XmlTrees
parser (() -> XPState ()
forall a. a -> XPState a
withoutNormNewline ()) SourceName
source
          ) SourceName
input
    | Bool
otherwise
        = []
    where
    al :: Attributes
al     = Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Attributes -> Attributes)
-> (XmlTree -> Maybe Attributes) -> XmlTree -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe Attributes
forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl (XmlTree -> Attributes) -> XmlTree -> Attributes
forall a b. (a -> b) -> a -> b
$ XmlTree
t
    cl :: XmlTrees
cl     = XmlTree -> XmlTrees
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t
    parser :: ParsecT SourceName (XPState s) Identity XmlTrees
parser = ParsecT SourceName (XPState s) Identity XmlTree
-> ParsecT SourceName (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT SourceName (XPState s) Identity XmlTree
forall s. XParser s XmlTree
XD.dtdToken
    source :: SourceName
source = SourceName
"value of parameter entity " SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName -> SourceName -> Attributes -> SourceName
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef SourceName
"" SourceName
a_peref Attributes
al
    input :: SourceName
input  = XmlTrees -> SourceName
xshow XmlTrees
cl

{-
parseXmlDTDdeclPart n
    = error ("parseXmlDTDdeclPart: illegal argument: " ++ show n)
-}
-- ------------------------------------------------------------
--
-- the main entry point

-- | parse a tokenized DTD declaration represented by a DTD tree.
-- The content is represented by the children containing text and parameter entity reference nodes.
-- The parameter entity reference nodes contain their value in the children list, consisting of text
-- and possibly again parameter entity reference nodes. This structure is build by the parameter entity
-- substitution.
-- Output is again a DTD declaration node, but this time completely parsed and ready for further DTD processing

parseXmlDTDdecl :: XmlTree -> XmlTrees
parseXmlDTDdecl :: XmlTree -> XmlTrees
parseXmlDTDdecl XmlTree
t       -- (NTree (XDTD dtdElem al) cl)
    | XmlTree -> Bool
forall a. XmlNode a => a -> Bool
isDTD XmlTree
t
        = ( (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 -> SourceName -> XmlTree
mkError' Int
c_err (SourceName -> XmlTree)
-> (ParseError -> SourceName) -> ParseError -> XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
"\n") (SourceName -> SourceName)
-> (ParseError -> SourceName) -> ParseError -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> SourceName
forall a. Show a => a -> SourceName
show) XmlTrees -> XmlTrees
forall a. a -> a
id
            (Either ParseError XmlTrees -> XmlTrees)
-> (SourceName -> Either ParseError XmlTrees)
-> SourceName
-> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            SParser XmlTrees
-> XPState LocalState
-> SourceName
-> SourceName
-> Either ParseError XmlTrees
forall tok st a.
GenParser tok st a
-> st -> SourceName -> [tok] -> Either ParseError a
runParser SParser XmlTrees
parser (SourcePos -> XPState LocalState
initialState SourcePos
pos) SourceName
source
          ) SourceName
input
    | Bool
otherwise
        = []
    where
    dtdElem :: DTDElem
dtdElem = Maybe DTDElem -> DTDElem
forall a. HasCallStack => Maybe a -> a
fromJust     (Maybe DTDElem -> DTDElem)
-> (XmlTree -> Maybe DTDElem) -> XmlTree -> DTDElem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe DTDElem
forall a. XmlNode a => a -> Maybe DTDElem
getDTDPart  (XmlTree -> DTDElem) -> XmlTree -> DTDElem
forall a b. (a -> b) -> a -> b
$ XmlTree
t
    al :: Attributes
al      = Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Attributes -> Attributes)
-> (XmlTree -> Maybe Attributes) -> XmlTree -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe Attributes
forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl (XmlTree -> Attributes) -> XmlTree -> Attributes
forall a b. (a -> b) -> a -> b
$ XmlTree
t
    cl :: XmlTrees
cl      = XmlTree -> XmlTrees
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t
    dtdParsers :: [(DTDElem, SParser XmlTrees)]
dtdParsers
        = [ (DTDElem
ELEMENT,  SParser XmlTrees
elementDeclBody)
          , (DTDElem
ATTLIST,  SParser XmlTrees
attlistDeclBody)
          , (DTDElem
ENTITY,   SParser XmlTrees
entityDeclBody)
          , (DTDElem
NOTATION, SParser XmlTrees
notationDeclBody)
          , (DTDElem
CONDSECT, SParser XmlTrees
condSectCondBody)
          ]
    source :: SourceName
source = SourceName -> SourceName -> Attributes -> SourceName
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef SourceName
"DTD declaration" SourceName
a_source Attributes
al
    line :: SourceName
line   = SourceName -> SourceName -> Attributes -> SourceName
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef SourceName
"1" SourceName
a_line Attributes
al
    column :: SourceName
column = SourceName -> SourceName -> Attributes -> SourceName
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef SourceName
"1" SourceName
a_column Attributes
al
    pos :: SourcePos
pos    = SourceName -> Int -> Int -> SourcePos
newPos SourceName
source (SourceName -> Int
forall a. Read a => SourceName -> a
read SourceName
line) (SourceName -> Int
forall a. Read a => SourceName -> a
read SourceName
column)
    parser :: SParser XmlTrees
parser = do
             SourcePos -> SParser ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
             XmlTrees
res <- Maybe (SParser XmlTrees) -> SParser XmlTrees
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (SParser XmlTrees) -> SParser XmlTrees)
-> ([(DTDElem, SParser XmlTrees)] -> Maybe (SParser XmlTrees))
-> [(DTDElem, SParser XmlTrees)]
-> SParser XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DTDElem
-> [(DTDElem, SParser XmlTrees)] -> Maybe (SParser XmlTrees)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DTDElem
dtdElem ([(DTDElem, SParser XmlTrees)] -> SParser XmlTrees)
-> [(DTDElem, SParser XmlTrees)] -> SParser XmlTrees
forall a b. (a -> b) -> a -> b
$ [(DTDElem, SParser XmlTrees)]
dtdParsers
             SParser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             XmlTrees -> SParser XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
res
    input :: SourceName
input  = (XmlTree -> SourceName) -> XmlTrees -> SourceName
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap XmlTree -> SourceName
collectText XmlTrees
cl
{-
parseXmlDTDdecl _
    = []
-}

-- | collect the tokens of a DTD declaration body and build
-- a string ready for parsing. The structure of the parameter entity values
-- is stll stored in this string for checking the scope of the parameter values

collectText     :: XmlTree -> String

collectText :: XmlTree -> SourceName
collectText XmlTree
t
    | XmlTree -> Bool
forall a. XmlNode a => a -> Bool
isText XmlTree
t
        = SourceName -> Maybe SourceName -> SourceName
forall a. a -> Maybe a -> a
fromMaybe SourceName
"" (Maybe SourceName -> SourceName)
-> (XmlTree -> Maybe SourceName) -> XmlTree -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe SourceName
forall a. XmlNode a => a -> Maybe SourceName
getText (XmlTree -> SourceName) -> XmlTree -> SourceName
forall a b. (a -> b) -> a -> b
$ XmlTree
t
    | XmlTree -> Bool
isDTDPEref XmlTree
t
        = SourceName
prefixPe SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ (XmlTree -> SourceName) -> XmlTrees -> SourceName
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap XmlTree -> SourceName
collectText (XmlTree -> XmlTrees
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t) SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
suffixPe
    | Bool
otherwise
        = SourceName
""
    where
    al :: Attributes
al       = Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Attributes -> Attributes)
-> (XmlTree -> Maybe Attributes) -> XmlTree -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe Attributes
forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl (XmlTree -> Attributes) -> XmlTree -> Attributes
forall a b. (a -> b) -> a -> b
$ XmlTree
t
    delPe :: SourceName
delPe    = SourceName
"\0"
    prefixPe :: SourceName
prefixPe = SourceName
delPe SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName -> SourceName -> Attributes -> SourceName
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef SourceName
"???" SourceName
a_peref Attributes
al SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
delPe
    suffixPe :: SourceName
suffixPe = SourceName
delPe SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
delPe

{-

collectText (NTree n _)
    | isXTextNode n
        = textOfXNode n

collectText (NTree (XDTD PEREF al) cl)
    = prefixPe ++ concatMap collectText cl ++ suffixPe
      where
      delPe    = "\0"
      prefixPe = delPe ++ lookupDef "???" a_peref al ++ delPe
      suffixPe = delPe ++ delPe

collectText _
    = ""
-}

isDTDPEref      :: XmlTree -> Bool
isDTDPEref :: XmlTree -> Bool
isDTDPEref
    = Bool -> (DTDElem -> Bool) -> Maybe DTDElem -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (DTDElem -> DTDElem -> Bool
forall a. Eq a => a -> a -> Bool
== DTDElem
PEREF) (Maybe DTDElem -> Bool)
-> (XmlTree -> Maybe DTDElem) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe DTDElem
forall a. XmlNode a => a -> Maybe DTDElem
getDTDPart

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