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

{- |
   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 -> [Char]
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 = upd $ xps_userState xps }

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

popPar          :: SParser ()
popPar :: SParser ()
popPar          = do
                  oldPos <- ParsecT [Char] (XPState LocalState) Identity SourcePos
getPos
                  updateLocalState pop
                  setPosition 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
                  s <- ParsecT [Char] (XPState LocalState) Identity (XPState LocalState)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                  let (_i, (top, _n, _p) : _s) = xps_userState s
                  return top

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

delPE   :: SParser ()
delPE :: SParser ()
delPE   = do
          _ <- Char -> ParsecT [Char] (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\0'
          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
            n <- ParsecT [Char] (XPState LocalState) Identity Char
-> ParsecT [Char] (XPState LocalState) Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT [Char] (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'))
            delPE
            pushPar 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 :: forall a. SParser a -> SParser a
inSamePE SParser a
p
    = do
      i <- SParser Int
getParNo
      r <- p
      j <- getParNo
      if (i == j)
         then return r
         else fail $ "parameter entity contents does not fit into the structure of a DTD declarations"

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

xmlSpaceChar    :: SParser ()
xmlSpaceChar :: SParser ()
xmlSpaceChar    = ( ParsecT [Char] (XPState LocalState) Identity Char
forall s. XParser s Char
XC.xmlSpaceChar
                    ParsecT [Char] (XPState LocalState) Identity Char
-> SParser () -> SParser ()
forall a b.
ParsecT [Char] (XPState LocalState) Identity a
-> ParsecT [Char] (XPState LocalState) Identity b
-> ParsecT [Char] (XPState LocalState) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                    () -> SParser ()
forall a. a -> ParsecT [Char] (XPState LocalState) Identity a
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 () -> [Char] -> SParser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"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 a b.
ParsecT [Char] (XPState LocalState) Identity a
-> ParsecT [Char] (XPState LocalState) Identity b
-> ParsecT [Char] (XPState LocalState) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      () -> SParser ()
forall a. a -> ParsecT [Char] (XPState LocalState) Identity a
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 a b.
ParsecT [Char] (XPState LocalState) Identity a
-> ParsecT [Char] (XPState LocalState) Identity b
-> ParsecT [Char] (XPState LocalState) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      () -> SParser ()
forall a. a -> ParsecT [Char] (XPState LocalState) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

name            :: SParser XmlTree
name :: SParser XmlTree
name
    = do
      n <- ParsecT [Char] (XPState LocalState) Identity [Char]
forall s. XParser s [Char]
XT.name
      return (mkDTDElem' NAME [(a_name, n)] [])

nmtoken         :: SParser XmlTree
nmtoken :: SParser XmlTree
nmtoken
    = do
      n <- ParsecT [Char] (XPState LocalState) Identity [Char]
forall s. XParser s [Char]
XT.nmtoken
      return (mkDTDElem' NAME [(a_name, n)] [])

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

elementDecl     :: SParser XmlTrees
elementDecl :: SParser XmlTrees
elementDecl
    = ParsecT [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (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 [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (XPState LocalState) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (XPState LocalState) Identity [Char]
 -> ParsecT [Char] (XPState LocalState) Identity [Char])
-> ParsecT [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (XPState LocalState) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (XPState LocalState) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!ELEMENT") (Char -> ParsecT [Char] (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
      n <- ParsecT [Char] (XPState LocalState) Identity [Char]
forall s. XParser s [Char]
XT.name
      skipS
      (al, cl) <- contentspec
      skipS0
      return [mkDTDElem' ELEMENT ((a_name, n) : al) cl]

contentspec     :: SParser (Attributes, XmlTrees)
contentspec :: SParser (Attributes, XmlTrees)
contentspec
    = [Char] -> [Char] -> SParser (Attributes, XmlTrees)
forall {b} {s} {a}.
[Char]
-> b -> ParsecT [Char] (XPState s) Identity ([([Char], b)], [a])
simplespec [Char]
k_empty [Char]
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
<|>
      [Char] -> [Char] -> SParser (Attributes, XmlTrees)
forall {b} {s} {a}.
[Char]
-> b -> ParsecT [Char] (XPState s) Identity ([([Char], b)], [a])
simplespec [Char]
k_any [Char]
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)
-> [Char] -> SParser (Attributes, XmlTrees)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"content specification"
    where
    simplespec :: [Char]
-> b -> ParsecT [Char] (XPState s) Identity ([([Char], b)], [a])
simplespec [Char]
kw b
v
        = do
          _ <- [Char] -> XParser s [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
kw
          return ([(a_type, v)], [])

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

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

optOrRep        :: SParser Attributes
optOrRep :: SParser Attributes
optOrRep
    = do
      m <- [Char]
-> ParsecT [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (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]
"" (ParsecT [Char] (XPState LocalState) Identity Char
-> ParsecT [Char] (XPState LocalState) Identity [Char]
forall s a. XParser s a -> XParser s [a]
XT.mkList ([Char] -> ParsecT [Char] (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"?*+"))
      return [(a_modifier, 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
      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
                )
      rpar
      return cl

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

cp              :: SParser XmlTree
cp :: SParser XmlTree
cp
    = ( do
        n <- SParser XmlTree
name
        m <- optOrRep
        return ( case m of
                 [([Char]
_, [Char]
"")] -> XmlTree
n
                 Attributes
_         -> DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT (Attributes
m Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++ [([Char]
a_kind, [Char]
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
        (al, cl) <- SParser (Attributes, XmlTrees)
choiceOrSeq
        m <- optOrRep
        return (mkDTDElem' CONTENT (m ++ al) cl)
      )

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

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

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

attlistDecl             :: SParser XmlTrees
attlistDecl :: SParser XmlTrees
attlistDecl
    = ParsecT [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (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 [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (XPState LocalState) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (XPState LocalState) Identity [Char]
 -> ParsecT [Char] (XPState LocalState) Identity [Char])
-> ParsecT [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (XPState LocalState) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (XPState LocalState) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!ATTLIST") (Char -> ParsecT [Char] (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
      n <- ParsecT [Char] (XPState LocalState) Identity [Char]
forall s. XParser s [Char]
XT.name
      al <- many attDef
      skipS0
      return (map (mkDTree n) al)
    where
    mkDTree :: [Char] -> (Attributes, XmlTrees) -> XmlTree
mkDTree [Char]
n' (Attributes
al, XmlTrees
cl)
        = DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
ATTLIST (([Char]
a_name, [Char]
n') ([Char], [Char]) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl

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

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

enumeration     :: SParser (Attributes, XmlTrees)
enumeration :: SParser (Attributes, XmlTrees)
enumeration
    = do
      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))
      return ([(a_type, k_enumeration)], nl)

notationType    :: SParser (Attributes, XmlTrees)
notationType :: SParser (Attributes, XmlTrees)
notationType
    = do
      _ <- [Char] -> ParsecT [Char] (XPState LocalState) Identity [Char]
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_notation
      skipS
      nl <- inSamePE (between lpar rpar ( sepBy1 name bar ))
      return ([(a_type, k_notation)], nl)

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

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

entityDecl              :: SParser XmlTrees
entityDecl :: SParser XmlTrees
entityDecl
    = ParsecT [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (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 [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (XPState LocalState) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (XPState LocalState) Identity [Char]
 -> ParsecT [Char] (XPState LocalState) Identity [Char])
-> ParsecT [Char] (XPState LocalState) Identity [Char]
-> ParsecT [Char] (XPState LocalState) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (XPState LocalState) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!ENTITY" ) (Char -> ParsecT [Char] (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 -> [Char] -> SParser XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"entity declaration" )      -- don't move the ) to the next line

geDecl                  :: SParser XmlTrees
geDecl :: SParser XmlTrees
geDecl
    = do
      n <- ParsecT [Char] (XPState LocalState) Identity [Char]
forall s. XParser s [Char]
XT.name
      skipS
      (al, cl) <- entityDef
      skipS0
      return [mkDTDElem' ENTITY ((a_name, n) : al) 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
      al <- SParser Attributes
externalID
      nd <- option [] nDataDecl
      return ((al ++ nd), [])

peDecl                  :: SParser XmlTrees
peDecl :: SParser XmlTrees
peDecl
    = do
      _ <- Char -> ParsecT [Char] (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
      skipS
      n <- XT.name
      skipS
      (al, cs) <- peDef
      skipS0
      return [mkDTDElem' PENTITY ((a_name, n) : al) 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
      al <- SParser Attributes
externalID
      return (al, [])

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

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

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

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

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

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

notationDeclBody        :: SParser XmlTrees
notationDeclBody :: SParser XmlTrees
notationDeclBody
    = do
      SParser ()
skipS
      n <- ParsecT [Char] (XPState LocalState) Identity [Char]
forall s. XParser s [Char]
XT.name
      skipS
      eid <- ( try externalID
               <|>
               publicID
             )
      skipS0
      return [mkDTDElem' NOTATION ((a_name, n) : eid) []]

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

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

condSectCondBody        :: SParser XmlTrees
condSectCondBody :: SParser XmlTrees
condSectCondBody
    = do
      SParser ()
skipS0
      n <- ParsecT [Char] (XPState LocalState) Identity [Char]
forall s. XParser s [Char]
XT.name
      skipS0
      let n' = [Char] -> [Char]
stringToUpper [Char]
n
      if n' `elem` [k_include, k_ignore]
         then return [mkText'  n']
         else fail $ "INCLUDE or IGNORE expected in conditional section"

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

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

rpar :: SParser ()
rpar
    = do
      SParser ()
skipS0
      _ <- Char -> ParsecT [Char] (XPState LocalState) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
      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 -> [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
cl' -> if XmlTrees -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null XmlTrees
cl'
                         then [[Char] -> XmlTree
mkText' [Char]
""]
                         else XmlTrees
cl'
            )
            (Either ParseError XmlTrees -> XmlTrees)
-> ([Char] -> Either ParseError XmlTrees) -> [Char] -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            GenParser Char (XPState ()) XmlTrees
-> XPState () -> [Char] -> [Char] -> Either ParseError XmlTrees
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser GenParser Char (XPState ()) XmlTrees
forall s. XParser s XmlTrees
parser (() -> XPState ()
forall a. a -> XPState a
withoutNormNewline ()) [Char]
source
          ) [Char]
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 a. NTree a -> [NTree a]
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t
    parser :: XParser s XmlTrees
parser = [Char] -> XParser s XmlTrees
forall s. [Char] -> XParser s XmlTrees
XT.entityTokensT [Char]
"%&"
    source :: [Char]
source = [Char]
"value of parameter entity " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Attributes -> [Char]
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"" [Char]
a_peref Attributes
al
    input :: [Char]
input  = XmlTrees -> [Char]
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) -> ([Char] -> XmlTree) -> [Char] -> 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 -> [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 -> XmlTree -> XmlTree) -> XmlTree -> XmlTrees -> XmlTree
forall a b c. (a -> b -> c) -> b -> a -> c
flip XmlTrees -> XmlTree -> XmlTree
forall a. [NTree a] -> NTree a -> NTree a
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)
-> ([Char] -> Either ParseError XmlTrees) -> [Char] -> XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            GenParser Char (XPState ()) XmlTrees
-> XPState () -> [Char] -> [Char] -> Either ParseError XmlTrees
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser GenParser Char (XPState ()) XmlTrees
forall s. XParser s XmlTrees
parser (() -> XPState ()
forall a. a -> XPState a
withoutNormNewline ()) [Char]
source
          ) [Char]
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 a. NTree a -> [NTree a]
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t
    parser :: ParsecT [Char] (XPState s) Identity XmlTrees
parser = ParsecT [Char] (XPState s) Identity XmlTree
-> ParsecT [Char] (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] (XPState s) Identity XmlTree
forall s. XParser s XmlTree
XD.dtdToken
    source :: [Char]
source = [Char]
"value of parameter entity " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Attributes -> [Char]
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"" [Char]
a_peref Attributes
al
    input :: [Char]
input  = XmlTrees -> [Char]
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 -> [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
.
            SParser XmlTrees
-> XPState LocalState
-> [Char]
-> [Char]
-> Either ParseError XmlTrees
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser SParser XmlTrees
parser (SourcePos -> XPState LocalState
initialState SourcePos
pos) [Char]
source
          ) [Char]
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 a. NTree a -> [NTree a]
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 :: [Char]
source = [Char] -> [Char] -> Attributes -> [Char]
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"DTD declaration" [Char]
a_source Attributes
al
    line :: [Char]
line   = [Char] -> [Char] -> Attributes -> [Char]
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"1" [Char]
a_line Attributes
al
    column :: [Char]
column = [Char] -> [Char] -> Attributes -> [Char]
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"1" [Char]
a_column Attributes
al
    pos :: SourcePos
pos    = [Char] -> Int -> Int -> SourcePos
newPos [Char]
source ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
line) ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
column)
    parser :: SParser XmlTrees
parser = do
             SourcePos -> SParser ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
             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
             eof
             return res
    input :: [Char]
input  = (XmlTree -> [Char]) -> XmlTrees -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap XmlTree -> [Char]
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 -> [Char]
collectText XmlTree
t
    | XmlTree -> Bool
forall a. XmlNode a => a -> Bool
isText XmlTree
t
        = [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 -> [Char]) -> XmlTree -> [Char]
forall a b. (a -> b) -> a -> b
$ XmlTree
t
    | XmlTree -> Bool
isDTDPEref XmlTree
t
        = [Char]
prefixPe [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (XmlTree -> [Char]) -> XmlTrees -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap XmlTree -> [Char]
collectText (XmlTree -> XmlTrees
forall a. NTree a -> [NTree a]
forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
suffixPe
    | Bool
otherwise
        = [Char]
""
    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 :: [Char]
delPe    = [Char]
"\0"
    prefixPe :: [Char]
prefixPe = [Char]
delPe [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Attributes -> [Char]
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"???" [Char]
a_peref Attributes
al [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
delPe
    suffixPe :: [Char]
suffixPe = [Char]
delPe [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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

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