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 )
type LocalState = (Int, [(Int, String, SourcePos)])
type SParser a = XParser LocalState a
initialState :: SourcePos -> XPState LocalState
initialState :: SourcePos -> XPState LocalState
initialState SourcePos
p = 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
= forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ XPState LocalState
xps -> XPState LocalState
xps { xps_userState :: LocalState
xps_userState = LocalState -> LocalState
upd forall a b. (a -> b) -> a -> b
$ forall s. XPState s -> s
xps_userState XPState LocalState
xps }
pushPar :: String -> SParser ()
pushPar :: [Char] -> SParser ()
pushPar [Char]
n = do
SourcePos
p <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(LocalState -> LocalState) -> SParser ()
updateLocalState (\ (Int
i, [(Int, [Char], SourcePos)]
s) -> (Int
iforall a. Num a => a -> a -> a
+Int
1, (Int
iforall a. Num a => a -> a -> a
+Int
1, [Char]
n, SourcePos
p) forall a. a -> [a] -> [a]
: [(Int, [Char], SourcePos)]
s))
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition ( [Char] -> Int -> Int -> SourcePos
newPos (SourcePos -> [Char]
sourceName SourcePos
p forall a. [a] -> [a] -> [a]
++ [Char]
" (line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SourcePos -> Int
sourceLine SourcePos
p) forall a. [a] -> [a] -> [a]
++ [Char]
", column " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SourcePos -> Int
sourceColumn SourcePos
p) forall a. [a] -> [a] -> [a]
++ [Char]
") in content of parameter entity ref %" forall a. [a] -> [a] -> [a]
++ [Char]
n forall a. [a] -> [a] -> [a]
++ [Char]
";") Int
1 Int
1)
popPar :: SParser ()
popPar :: SParser ()
popPar = do
SourcePos
oldPos <- SParser SourcePos
getPos
(LocalState -> LocalState) -> SParser ()
updateLocalState forall {a} {b} {c}. Num a => (a, [(a, b, c)]) -> (a, [(a, b, c)])
pop
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
iforall a. Num a => a -> a -> a
+a
1, [(a
iforall a. Num a => a -> a -> a
+a
1, b
s, c
p)])
pop (a
i, (a, b, c)
_t:[(a, b, c)]
s) = (a
i, [(a, b, c)]
s)
pop (a
_i, []) = forall a. HasCallStack => a
undefined
getParNo :: SParser Int
getParNo :: SParser Int
getParNo = do
XPState LocalState
s <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let (Int
_i, (Int
top, [Char]
_n, SourcePos
_p) : [(Int, [Char], SourcePos)]
_s) = forall s. XPState s -> s
xps_userState XPState LocalState
s
forall (m :: * -> *) a. Monad m => a -> m a
return Int
top
getPos :: SParser SourcePos
getPos :: SParser SourcePos
getPos = do
XPState LocalState
s <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let (Int
_i, (Int
_top, [Char]
_n, SourcePos
p) : [(Int, [Char], SourcePos)]
_s) = forall s. XPState s -> s
xps_userState XPState LocalState
s
forall (m :: * -> *) a. Monad m => a -> m a
return SourcePos
p
delPE :: SParser ()
delPE :: SParser ()
delPE = do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\0'
forall (m :: * -> *) a. Monad m => a -> m a
return ()
startPE :: SParser ()
startPE :: SParser ()
startPE
= do
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
SParser ()
delPE
[Char]
n <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
'\0'))
SParser ()
delPE
[Char] -> SParser ()
pushPar [Char]
n
)
endPE :: SParser ()
endPE :: SParser ()
endPE
= do
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
Int
i <- SParser Int
getParNo
a
r <- SParser a
p
Int
j <- SParser Int
getParNo
if (Int
i forall a. Eq a => a -> a -> Bool
== Int
j)
then forall (m :: * -> *) a. Monad m => a -> m a
return a
r
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"parameter entity contents does not fit into the structure of a DTD declarations"
xmlSpaceChar :: SParser ()
xmlSpaceChar :: SParser ()
xmlSpaceChar = ( forall s. XParser s Char
XC.xmlSpaceChar
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
SParser ()
startPE
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
SParser ()
endPE
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"white space"
skipS :: SParser ()
skipS :: SParser ()
skipS
= forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 SParser ()
xmlSpaceChar
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) a. Monad m => a -> m a
return ()
skipS0 :: SParser ()
skipS0 :: SParser ()
skipS0
= forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany SParser ()
xmlSpaceChar
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) a. Monad m => a -> m a
return ()
name :: SParser XmlTree
name :: SParser XmlTree
name
= do
[Char]
n <- forall s. XParser s [Char]
XT.name
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
NAME [([Char]
a_name, [Char]
n)] [])
nmtoken :: SParser XmlTree
nmtoken :: SParser XmlTree
nmtoken
= do
[Char]
n <- forall s. XParser s [Char]
XT.nmtoken
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
NAME [([Char]
a_name, [Char]
n)] [])
elementDecl :: SParser XmlTrees
elementDecl :: SParser XmlTrees
elementDecl
= 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 (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!ELEMENT") (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
[Char]
n <- forall s. XParser s [Char]
XT.name
SParser ()
skipS
(Attributes
al, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
contentspec
SParser ()
skipS0
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
ELEMENT (([Char]
a_name, [Char]
n) forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl]
contentspec :: SParser (Attributes, XmlTrees)
contentspec :: SParser (Attributes, XmlTrees)
contentspec
= forall {b} {s} {a}.
[Char]
-> b -> ParsecT [Char] (XPState s) Identity ([([Char], b)], [a])
simplespec [Char]
k_empty [Char]
v_empty
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall {b} {s} {a}.
[Char]
-> b -> ParsecT [Char] (XPState s) Identity ([([Char], b)], [a])
simplespec [Char]
k_any [Char]
v_any
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall a. SParser a -> SParser a
inSamePE SParser (Attributes, XmlTrees)
mixed
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall a. SParser a -> SParser a
inSamePE SParser (Attributes, XmlTrees)
children
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]
_ <- forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
kw
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char]
a_type, b
v)], [])
children :: SParser (Attributes, XmlTrees)
children :: SParser (Attributes, XmlTrees)
children
= ( do
(Attributes
al, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
choiceOrSeq
Attributes
modifier <- SParser Attributes
optOrRep
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char]
a_type, [Char]
v_children)], [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT (Attributes
modifier forall a. [a] -> [a] -> [a]
++ Attributes
al) XmlTrees
cl])
)
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
[Char]
m <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (forall s a. XParser s a -> XParser s [a]
XT.mkList (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"?*+"))
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
a_modifier, [Char]
m)]
choiceOrSeq :: SParser (Attributes, XmlTrees)
choiceOrSeq :: SParser (Attributes, XmlTrees)
choiceOrSeq
= forall a. SParser a -> SParser a
inSamePE forall a b. (a -> b) -> a -> b
$
do
(Attributes, XmlTrees)
cl <- forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
SParser ()
lpar
SParser (Attributes, XmlTrees)
choiceOrSeqBody
)
SParser ()
rpar
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 <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( do
SParser ()
bar
SParser XmlTree
cp
)
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char]
a_kind, [Char]
v_choice)], (XmlTree
c1 forall a. a -> [a] -> [a]
: XmlTree
c2 forall a. a -> [a] -> [a]
: XmlTrees
cl))
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
( do
XmlTrees
cl <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( do
SParser ()
comma
SParser XmlTree
cp
)
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char]
a_kind, [Char]
v_seq)], (XmlTree
c1 forall a. a -> [a] -> [a]
: XmlTrees
cl))
)
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
XmlTree
n <- SParser XmlTree
name
Attributes
m <- SParser Attributes
optOrRep
forall (m :: * -> *) a. Monad m => a -> m a
return ( case Attributes
m of
[([Char]
_, [Char]
"")] -> XmlTree
n
Attributes
_ -> DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT (Attributes
m forall a. [a] -> [a] -> [a]
++ [([Char]
a_kind, [Char]
v_seq)]) [XmlTree
n]
)
)
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
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT (Attributes
m forall a. [a] -> [a] -> [a]
++ Attributes
al) XmlTrees
cl)
)
mixed :: SParser (Attributes, XmlTrees)
mixed :: SParser (Attributes, XmlTrees)
mixed
= ( do
[Char]
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
SParser ()
lpar
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
k_pcdata
)
XmlTrees
nl <- 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null XmlTrees
nl
then do
Char
_ <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Char
' ' (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*')
forall (m :: * -> *) a. Monad m => a -> m a
return ( [ ([Char]
a_type, [Char]
v_pcdata) ]
, []
)
else do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"closing parent for mixed content (\")*\")"
forall (m :: * -> *) a. Monad m => a -> m a
return ( [ ([Char]
a_type, [Char]
v_mixed) ]
, [ DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
CONTENT [ ([Char]
a_modifier, [Char]
"*")
, ([Char]
a_kind, [Char]
v_choice)
] XmlTrees
nl
]
)
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"mixed content"
attlistDecl :: SParser XmlTrees
attlistDecl :: SParser XmlTrees
attlistDecl
= 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 (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!ATTLIST") (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
[Char]
n <- forall s. XParser s [Char]
XT.name
[(Attributes, XmlTrees)]
al <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many SParser (Attributes, XmlTrees)
attDef
SParser ()
skipS0
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> (Attributes, XmlTrees) -> XmlTree
mkDTree [Char]
n) [(Attributes, XmlTrees)]
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') forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl
attDef :: SParser (Attributes, XmlTrees)
attDef :: SParser (Attributes, XmlTrees)
attDef
= do
[Char]
n <- forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
SParser ()
skipS
forall s. XParser s [Char]
XT.name
) forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"attribute name"
SParser ()
skipS
(Attributes
t, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
attType
SParser ()
skipS
Attributes
d <- SParser Attributes
defaultDecl
forall (m :: * -> *) a. Monad m => a -> m a
return ((([Char]
a_value, [Char]
n) forall a. a -> [a] -> [a]
: Attributes
d) forall a. [a] -> [a] -> [a]
++ Attributes
t, XmlTrees
cl)
attType :: SParser (Attributes, XmlTrees)
attType :: SParser (Attributes, XmlTrees)
attType
= SParser (Attributes, XmlTrees)
tokenizedOrStringType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
SParser (Attributes, XmlTrees)
enumeration
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
SParser (Attributes, XmlTrees)
notationType
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
[Char]
n <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall s. [Char] -> XParser s [Char]
XT.keyword [[Char]]
typl
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char]
a_type, [Char]
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
XmlTrees
nl <- forall a. SParser a -> SParser a
inSamePE (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 (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))
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char]
a_type, [Char]
k_enumeration)], XmlTrees
nl)
notationType :: SParser (Attributes, XmlTrees)
notationType :: SParser (Attributes, XmlTrees)
notationType
= do
[Char]
_ <- forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_notation
SParser ()
skipS
XmlTrees
nl <- forall a. SParser a -> SParser a
inSamePE (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 ( 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 ))
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char]
a_type, [Char]
k_notation)], XmlTrees
nl)
defaultDecl :: SParser Attributes
defaultDecl :: SParser Attributes
defaultDecl
= ( do
[Char]
str <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
k_required
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
a_kind, [Char]
str)]
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
( do
[Char]
str <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
k_implied
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
a_kind, [Char]
str)]
)
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 <- forall s. XParser s XmlTrees
XT.attrValueT
forall (m :: * -> *) a. Monad m => a -> m a
return (([Char]
a_default, XmlTrees -> [Char]
xshow XmlTrees
v) forall a. a -> [a] -> [a]
: Attributes
l)
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"default declaration"
where
fixed :: SParser Attributes
fixed = 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
[Char]
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
k_fixed
SParser ()
skipS
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
a_kind, [Char]
k_fixed)]
)
entityDecl :: SParser XmlTrees
entityDecl :: SParser XmlTrees
entityDecl
= 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 ( forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!ENTITY" ) (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
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
SParser XmlTrees
geDecl
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"entity declaration" )
geDecl :: SParser XmlTrees
geDecl :: SParser XmlTrees
geDecl
= do
[Char]
n <- forall s. XParser s [Char]
XT.name
SParser ()
skipS
(Attributes
al, XmlTrees
cl) <- SParser (Attributes, XmlTrees)
entityDef
SParser ()
skipS0
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
ENTITY (([Char]
a_name, [Char]
n) forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl]
entityDef :: SParser (Attributes, XmlTrees)
entityDef :: SParser (Attributes, XmlTrees)
entityDef
= forall s. XParser s (Attributes, XmlTrees)
entityValue
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 <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return ((Attributes
al forall a. [a] -> [a] -> [a]
++ Attributes
nd), [])
peDecl :: SParser XmlTrees
peDecl :: SParser XmlTrees
peDecl
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
SParser ()
skipS
[Char]
n <- forall s. XParser s [Char]
XT.name
SParser ()
skipS
(Attributes
al, XmlTrees
cs) <- SParser (Attributes, XmlTrees)
peDef
SParser ()
skipS0
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
PENTITY (([Char]
a_name, [Char]
n) forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cs]
peDef :: SParser (Attributes, XmlTrees)
peDef :: SParser (Attributes, XmlTrees)
peDef
= forall s. XParser s (Attributes, XmlTrees)
entityValue
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
forall (m :: * -> *) a. Monad m => a -> m a
return (Attributes
al, [])
entityValue :: XParser s (Attributes, XmlTrees)
entityValue :: forall s. XParser s (Attributes, XmlTrees)
entityValue
= do
XmlTrees
v <- forall s. XParser s XmlTrees
XT.entityValueT
forall (m :: * -> *) a. Monad m => a -> m a
return ([], XmlTrees
v)
externalID :: SParser Attributes
externalID :: SParser Attributes
externalID
= ( do
[Char]
_ <- forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_system
SParser ()
skipS
[Char]
lit <- forall s. XParser s [Char]
XT.systemLiteral
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
k_system, [Char]
lit)]
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
( do
[Char]
_ <- forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_public
SParser ()
skipS
[Char]
pl <- forall s. XParser s [Char]
XT.pubidLiteral
SParser ()
skipS
[Char]
sl <- forall s. XParser s [Char]
XT.systemLiteral
forall (m :: * -> *) a. Monad m => a -> m a
return [ ([Char]
k_system, [Char]
sl)
, ([Char]
k_public, [Char]
pl) ]
)
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
[Char]
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
SParser ()
skipS
forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_ndata
)
SParser ()
skipS
[Char]
n <- forall s. XParser s [Char]
XT.name
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
k_ndata, [Char]
n)]
notationDecl :: SParser XmlTrees
notationDecl :: SParser XmlTrees
notationDecl
= 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 (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!NOTATION") (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 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
[Char]
n <- forall s. XParser s [Char]
XT.name
SParser ()
skipS
Attributes
eid <- ( forall tok st a. GenParser tok st a -> GenParser tok st a
try SParser Attributes
externalID
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
forall (m :: * -> *) a. Monad m => a -> m a
return [DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
NOTATION (([Char]
a_name, [Char]
n) forall a. a -> [a] -> [a]
: Attributes
eid) []]
publicID :: SParser Attributes
publicID :: SParser Attributes
publicID
= do
[Char]
_ <- forall s. [Char] -> XParser s [Char]
XT.keyword [Char]
k_public
SParser ()
skipS
[Char]
l <- forall s. XParser s [Char]
XT.pubidLiteral
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
k_public, [Char]
l)]
condSectCondBody :: SParser XmlTrees
condSectCondBody :: SParser XmlTrees
condSectCondBody
= do
SParser ()
skipS0
[Char]
n <- forall s. XParser s [Char]
XT.name
SParser ()
skipS0
let n' :: [Char]
n' = [Char] -> [Char]
stringToUpper [Char]
n
if [Char]
n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
k_include, [Char]
k_ignore]
then forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> XmlTree
mkText' [Char]
n']
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"INCLUDE or IGNORE expected in conditional section"
separator :: Char -> SParser ()
separator :: Char -> SParser ()
separator Char
c
= do
Char
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
SParser ()
skipS0
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
)
SParser ()
skipS0
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
_ <- 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
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return ()
parseXmlDTDEntityValue :: XmlTree -> XmlTrees
parseXmlDTDEntityValue :: XmlTree -> XmlTrees
parseXmlDTDEntityValue XmlTree
t
| XmlTree -> Bool
isDTDPEref XmlTree
t
= ( forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
( (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> XmlTree
mkError' Int
c_err forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [Char]
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show )
( \XmlTrees
cl' -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null XmlTrees
cl'
then [[Char] -> XmlTree
mkText' [Char]
""]
else XmlTrees
cl'
)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser forall s. XParser s XmlTrees
parser (forall a. a -> XPState a
withoutNormNewline ()) [Char]
source
) [Char]
input
| Bool
otherwise
= []
where
al :: Attributes
al = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl forall a b. (a -> b) -> a -> b
$ XmlTree
t
cl :: XmlTrees
cl = forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t
parser :: XParser s XmlTrees
parser = forall s. [Char] -> XParser s XmlTrees
XT.entityTokensT [Char]
"%&"
source :: [Char]
source = [Char]
"value of parameter entity " forall a. [a] -> [a] -> [a]
++ 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 :: XmlTree -> XmlTrees
parseXmlDTDdeclPart :: XmlTree -> XmlTrees
parseXmlDTDdeclPart XmlTree
t
| XmlTree -> Bool
isDTDPEref XmlTree
t
= ( (forall a. a -> [a] -> [a]
:[])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
( Int -> [Char] -> XmlTree
mkError' Int
c_err forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [Char]
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show )
( forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. Tree t => [t a] -> t a -> t a
setChildren forall a b. (a -> b) -> a -> b
$ XmlTree
t )
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser forall s. XParser s XmlTrees
parser (forall a. a -> XPState a
withoutNormNewline ()) [Char]
source
) [Char]
input
| Bool
otherwise
= []
where
al :: Attributes
al = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl forall a b. (a -> b) -> a -> b
$ XmlTree
t
cl :: XmlTrees
cl = forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t
parser :: ParsecT [Char] (XPState s) Identity XmlTrees
parser = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s. XParser s XmlTree
XD.dtdToken
source :: [Char]
source = [Char]
"value of parameter entity " forall a. [a] -> [a] -> [a]
++ 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
parseXmlDTDdecl :: XmlTree -> XmlTrees
parseXmlDTDdecl :: XmlTree -> XmlTrees
parseXmlDTDdecl XmlTree
t
| forall a. XmlNode a => a -> Bool
isDTD XmlTree
t
= ( forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> XmlTree
mkError' Int
c_err forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [Char]
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a. a -> a
id
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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 = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe DTDElem
getDTDPart forall a b. (a -> b) -> a -> b
$ XmlTree
t
al :: Attributes
al = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl forall a b. (a -> b) -> a -> b
$ XmlTree
t
cl :: XmlTrees
cl = 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 = forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"DTD declaration" [Char]
a_source Attributes
al
line :: [Char]
line = forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"1" [Char]
a_line Attributes
al
column :: [Char]
column = 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 (forall a. Read a => [Char] -> a
read [Char]
line) (forall a. Read a => [Char] -> a
read [Char]
column)
parser :: SParser XmlTrees
parser = do
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
XmlTrees
res <- forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DTDElem
dtdElem forall a b. (a -> b) -> a -> b
$ [(DTDElem, SParser XmlTrees)]
dtdParsers
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
res
input :: [Char]
input = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap XmlTree -> [Char]
collectText XmlTrees
cl
collectText :: XmlTree -> String
collectText :: XmlTree -> [Char]
collectText XmlTree
t
| forall a. XmlNode a => a -> Bool
isText XmlTree
t
= forall a. a -> Maybe a -> a
fromMaybe [Char]
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe [Char]
getText forall a b. (a -> b) -> a -> b
$ XmlTree
t
| XmlTree -> Bool
isDTDPEref XmlTree
t
= [Char]
prefixPe forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap XmlTree -> [Char]
collectText (forall (t :: * -> *) a. Tree t => t a -> [t a]
getChildren XmlTree
t) forall a. [a] -> [a] -> [a]
++ [Char]
suffixPe
| Bool
otherwise
= [Char]
""
where
al :: Attributes
al = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl forall a b. (a -> b) -> a -> b
$ XmlTree
t
delPe :: [Char]
delPe = [Char]
"\0"
prefixPe :: [Char]
prefixPe = [Char]
delPe forall a. [a] -> [a] -> [a]
++ forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef [Char]
"???" [Char]
a_peref Attributes
al forall a. [a] -> [a] -> [a]
++ [Char]
delPe
suffixPe :: [Char]
suffixPe = [Char]
delPe forall a. [a] -> [a] -> [a]
++ [Char]
delPe
isDTDPEref :: XmlTree -> Bool
isDTDPEref :: XmlTree -> Bool
isDTDPEref
= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Eq a => a -> a -> Bool
== DTDElem
PEREF) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe DTDElem
getDTDPart