{-# LANGUAGE CPP                #-}

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

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

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

   Parsec parser for XML tokens

-}

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

module Text.XML.HXT.Parser.XmlTokenParser
    ( allBut
    , allBut1
    , amp
    , asciiLetter
    , attrChar
    , attrValue
    , bar
    , charRef
    , checkString
    , comma
    , dq
    , encName
    , entityRef
    , entityValue
    , eq
    , gt
    , keyword
    , keywords
    , lpar
    , lt
    , name
    , names
    , ncName
    , nmtoken
    , nmtokens
    , peReference
    , pubidLiteral
    , qName
    , quoted
    , reference
    , rpar
    , semi
    , separator
    , singleChar
    , singleChars
    , skipS
    , skipS0
    , sPace
    , sPace0
    , sq
    , systemLiteral
    , versionNum

    , concRes
    , mkList

    , nameT
    , nmtokenT

    , entityValueT
    , entityTokensT
    , entityCharT

    , attrValueT
    , attrValueT'

    , referenceT
    , charRefT
    , entityRefT
    , peReferenceT

    , singleCharsT

    , mergeTextNodes
    )
where

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


import Data.Char.Properties.XMLCharProps        ( isXmlChar
                                                , isXmlCharCR
                                                )
import Data.String.Unicode                      ( intToCharRef
                                                , intToCharRefHex
                                                )

import Text.ParserCombinators.Parsec

import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.DOM.XmlNode                 ( mkDTDElem'
                                                , mkText'
                                                , mkCharRef'
                                                , mkEntityRef'
                                                , mergeText
                                                )
import Text.XML.HXT.Parser.XmlCharParser        ( xmlNameChar
                                                , xmlNameStartChar
                                                , xmlNCNameChar
                                                , xmlNCNameStartChar
                                                , xmlSpaceChar
                                                , xmlCRLFChar
                                                , XParser
                                                )

-- ------------------------------------------------------------
--
-- Character (2.2) and White Space (2.3)
--
-- Unicode parsers in module XmlCharParser

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

sPace           :: XParser s String
sPace :: XParser s String
sPace
    = ParsecT String (XPState s) Identity Char -> XParser s String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String (XPState s) Identity Char
forall s. XParser s Char
xmlSpaceChar

sPace0          :: XParser s String
sPace0 :: XParser s String
sPace0
    = ParsecT String (XPState s) Identity Char -> XParser s String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String (XPState s) Identity Char
forall s. XParser s Char
xmlSpaceChar

skipS           :: XParser s ()
skipS :: XParser s ()
skipS
    = ParsecT String (XPState s) Identity Char -> XParser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT String (XPState s) Identity Char
forall s. XParser s Char
xmlSpaceChar

skipS0          :: XParser s ()
skipS0 :: XParser s ()
skipS0
    = ParsecT String (XPState s) Identity Char -> XParser s ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String (XPState s) Identity Char
forall s. XParser s Char
xmlSpaceChar

-- ------------------------------------------------------------
--
-- Names and Tokens (2.3)

asciiLetter             :: XParser s Char
asciiLetter :: XParser s Char
asciiLetter
    = (Char -> Bool) -> XParser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\ Char
c -> ( Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' Bool -> Bool -> Bool
||
                        Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' )
              )
      XParser s Char -> String -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"ASCII letter"

name            :: XParser s String
name :: XParser s String
name
    = do
      Char
s1 <- XParser s Char
forall s. XParser s Char
xmlNameStartChar
      String
sl <- XParser s Char -> XParser s String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many XParser s Char
forall s. XParser s Char
xmlNameChar
      String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
s1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
sl)
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Name"

-- Namespaces in XML: Rules [4-5] NCName:

ncName          :: XParser s String
ncName :: XParser s String
ncName
    = do
      Char
s1 <- XParser s Char
forall s. XParser s Char
xmlNCNameStartChar
      String
sl <- XParser s Char -> XParser s String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many XParser s Char
forall s. XParser s Char
xmlNCNameChar
      String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
s1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
sl)
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"NCName"

-- Namespaces in XML: Rules [6-8] QName:

qName           :: XParser s (String, String)
qName :: XParser s (String, String)
qName
    = do
      String
s1 <- XParser s String
forall s. XParser s String
ncName
      String
s2 <- String -> XParser s String -> XParser s String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT String (XPState s) Identity Char
-> XParser s String -> XParser s String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XParser s String
forall s. XParser s String
ncName)
      (String, String) -> XParser s (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ( if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s2
               then (String
s2, String
s1)
               else (String
s1, String
s2)
             )

nmtoken         :: XParser s String
nmtoken :: XParser s String
nmtoken
    = XParser s String -> XParser s String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String (XPState s) Identity Char -> XParser s String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String (XPState s) Identity Char
forall s. XParser s Char
xmlNameChar)
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Nmtoken"

names           :: XParser s [String]
names :: XParser s [String]
names
    = ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity String -> XParser s [String]
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 ParsecT String (XPState s) Identity String
forall s. XParser s String
name ParsecT String (XPState s) Identity String
forall s. XParser s String
sPace

nmtokens        :: XParser s [String]
nmtokens :: XParser s [String]
nmtokens
    = ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity String -> XParser s [String]
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 ParsecT String (XPState s) Identity String
forall s. XParser s String
nmtoken ParsecT String (XPState s) Identity String
forall s. XParser s String
sPace

-- ------------------------------------------------------------
--
-- Literals (2.3)

singleChar              :: String -> XParser s Char
singleChar :: String -> XParser s Char
singleChar String
notAllowed
    = (Char -> Bool) -> XParser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\ Char
c -> Char -> Bool
isXmlCharCR Char
c Bool -> Bool -> Bool
&& Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
notAllowed)
      XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s Char
forall s. XParser s Char
xmlCRLFChar

singleChars             :: String -> XParser s String
singleChars :: String -> XParser s String
singleChars String
notAllowed
    = ParsecT String (XPState s) Identity Char -> XParser s String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String (XPState s) Identity Char
forall s. String -> XParser s Char
singleChar String
notAllowed)

entityValue     :: XParser s String
entityValue :: XParser s String
entityValue
    = ( do
        String
v <- XParser s String
forall s. XParser s String
entityValueDQ
        String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")
      )
      XParser s String -> XParser s String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        String
v <- XParser s String
forall s. XParser s String
entityValueSQ
        String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'")
      )
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"entity value (in quotes)"

entityValueDQ   :: XParser s String
entityValueDQ :: XParser s String
entityValueDQ
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s String
-> XParser s String
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 String (XPState s) Identity ()
forall s. XParser s ()
dq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq (XParser s [String] -> XParser s String
forall s a. XParser s [[a]] -> XParser s [a]
concRes (XParser s [String] -> XParser s String)
-> XParser s [String] -> XParser s String
forall a b. (a -> b) -> a -> b
$ XParser s String -> XParser s [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (XParser s String -> XParser s [String])
-> XParser s String -> XParser s [String]
forall a b. (a -> b) -> a -> b
$ String -> XParser s String
forall s. String -> XParser s String
attrChar String
"&\"")

entityValueSQ   :: XParser s String
entityValueSQ :: XParser s String
entityValueSQ
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s String
-> XParser s String
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 String (XPState s) Identity ()
forall s. XParser s ()
sq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq (XParser s [String] -> XParser s String
forall s a. XParser s [[a]] -> XParser s [a]
concRes (XParser s [String] -> XParser s String)
-> XParser s [String] -> XParser s String
forall a b. (a -> b) -> a -> b
$ XParser s String -> XParser s [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (XParser s String -> XParser s [String])
-> XParser s String -> XParser s [String]
forall a b. (a -> b) -> a -> b
$ String -> XParser s String
forall s. String -> XParser s String
attrChar String
"&\'")

attrValue       :: XParser s String
attrValue :: XParser s String
attrValue
    = ( do
        String
v <- XParser s String
forall s. XParser s String
attrValueDQ
        String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")
      )
      XParser s String -> XParser s String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        String
v <- XParser s String
forall s. XParser s String
attrValueSQ
        String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'")
      )
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"attribute value (in quotes)"

attrValueDQ     :: XParser s String
attrValueDQ :: XParser s String
attrValueDQ
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s String
-> XParser s String
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 String (XPState s) Identity ()
forall s. XParser s ()
dq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq (XParser s [String] -> XParser s String
forall s a. XParser s [[a]] -> XParser s [a]
concRes (XParser s [String] -> XParser s String)
-> XParser s [String] -> XParser s String
forall a b. (a -> b) -> a -> b
$ XParser s String -> XParser s [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (XParser s String -> XParser s [String])
-> XParser s String -> XParser s [String]
forall a b. (a -> b) -> a -> b
$ String -> XParser s String
forall s. String -> XParser s String
attrChar String
"<&\"")

attrValueSQ     :: XParser s String
attrValueSQ :: XParser s String
attrValueSQ
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s String
-> XParser s String
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 String (XPState s) Identity ()
forall s. XParser s ()
sq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq (XParser s [String] -> XParser s String
forall s a. XParser s [[a]] -> XParser s [a]
concRes (XParser s [String] -> XParser s String)
-> XParser s [String] -> XParser s String
forall a b. (a -> b) -> a -> b
$ XParser s String -> XParser s [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (XParser s String -> XParser s [String])
-> XParser s String -> XParser s [String]
forall a b. (a -> b) -> a -> b
$ String -> XParser s String
forall s. String -> XParser s String
attrChar String
"<&\'")

attrChar        :: String -> XParser s String
attrChar :: String -> XParser s String
attrChar String
notAllowed
    = XParser s String
forall s. XParser s String
reference
      XParser s String -> XParser s String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s Char -> XParser s String
forall s a. XParser s a -> XParser s [a]
mkList (String -> XParser s Char
forall s. String -> XParser s Char
singleChar String
notAllowed)
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
"legal attribute or entity character or reference (not allowed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
notAllowed String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" )")

systemLiteral           :: XParser s String
systemLiteral :: XParser s String
systemLiteral
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s String
-> XParser s String
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 String (XPState s) Identity ()
forall s. XParser s ()
dq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq (ParsecT String (XPState s) Identity Char -> XParser s String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity Char -> XParser s String)
-> ParsecT String (XPState s) Identity Char -> XParser s String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"")
      XParser s String -> XParser s String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s String
-> XParser s String
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 String (XPState s) Identity ()
forall s. XParser s ()
sq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq (ParsecT String (XPState s) Identity Char -> XParser s String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity Char -> XParser s String)
-> ParsecT String (XPState s) Identity Char -> XParser s String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\'")
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"system literal (in quotes)"

pubidLiteral            :: XParser s String
pubidLiteral :: XParser s String
pubidLiteral
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s String
-> XParser s String
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 String (XPState s) Identity ()
forall s. XParser s ()
dq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq (ParsecT String (XPState s) Identity Char -> XParser s String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity Char -> XParser s String)
-> ParsecT String (XPState s) Identity Char -> XParser s String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String (XPState s) Identity Char
forall s. String -> XParser s Char
pubidChar String
"\'")
      XParser s String -> XParser s String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s String
-> XParser s String
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 String (XPState s) Identity ()
forall s. XParser s ()
sq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq (ParsecT String (XPState s) Identity Char -> XParser s String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity Char -> XParser s String)
-> ParsecT String (XPState s) Identity Char -> XParser s String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String (XPState s) Identity Char
forall s. String -> XParser s Char
pubidChar String
"")
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"pubid literal (in quotes)"
      where
      pubidChar         :: String -> XParser s Char
      pubidChar :: String -> XParser s Char
pubidChar String
quoteChars
          = XParser s Char
forall s. XParser s Char
asciiLetter
            XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            XParser s Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
            XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            String -> XParser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \r\n"               -- no "\t" allowed, so xmlSpaceChar parser not used
            XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            String -> XParser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"-()+,./:=?;!*#@$_%"
            XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            String -> XParser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
quoteChars

-- ------------------------------------------------------------
--
-- Character and Entity References (4.1)

reference       :: XParser s String
reference :: XParser s String
reference
    = ( do
        Int
i <- XParser s Int
forall s. XParser s Int
charRef
        String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"&#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";")
      )
      XParser s String -> XParser s String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        String
n <- XParser s String
forall s. XParser s String
entityRef
        String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";")
      )

checkCharRef    :: Int -> XParser s Int
checkCharRef :: Int -> XParser s Int
checkCharRef Int
i
    = if ( Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char
forall a. Bounded a => a
maxBound::Char)
           Bool -> Bool -> Bool
&& Char -> Bool
isXmlChar (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
i)
         )
        then Int -> XParser s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
        else String -> XParser s Int
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String
"illegal value in character reference: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
intToCharRef Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" , in hex: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
intToCharRefHex Int
i)

charRef         :: XParser s Int
charRef :: XParser s Int
charRef
    = do
      String -> XParser s ()
forall s. String -> XParser s ()
checkString String
"&#x"
      String
d <- ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
      XParser s ()
forall s. XParser s ()
semi
      Int -> XParser s Int
forall s. Int -> XParser s Int
checkCharRef (String -> Int
hexStringToInt String
d)
      XParser s Int -> XParser s Int -> XParser s Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      String -> XParser s ()
forall s. String -> XParser s ()
checkString String
"&#"
      String
d <- ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      XParser s ()
forall s. XParser s ()
semi
      Int -> XParser s Int
forall s. Int -> XParser s Int
checkCharRef (String -> Int
decimalStringToInt String
d)
      XParser s Int -> String -> XParser s Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"character reference"

entityRef       :: XParser s String
entityRef :: XParser s String
entityRef
    = do
      XParser s ()
forall s. XParser s ()
amp
      String
n <- XParser s String
forall s. XParser s String
name
      XParser s ()
forall s. XParser s ()
semi
      String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"entity reference"

peReference     :: XParser s String
peReference :: XParser s String
peReference
    = XParser s String -> XParser s String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
            Char
_ <- Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
            String
n <- XParser s String
forall s. XParser s String
name
            XParser s ()
forall s. XParser s ()
semi
            String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
          )
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"parameter-entity reference"

-- ------------------------------------------------------------
--
-- 4.3

encName         :: XParser s String
encName :: XParser s String
encName
    = do
      Char
c <- XParser s Char
forall s. XParser s Char
asciiLetter
      String
r <- XParser s Char -> XParser s String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (XParser s Char
forall s. XParser s Char
asciiLetter XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> XParser s Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> XParser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"._-")
      String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
r)

versionNum      :: XParser s String
versionNum :: XParser s String
versionNum
    = ParsecT String (XPState s) Identity Char -> XParser s String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String (XPState s) Identity Char
forall s. XParser s Char
xmlNameChar


-- ------------------------------------------------------------
--
-- keywords

keyword         :: String -> XParser s String
keyword :: String -> XParser s String
keyword String
kw
    = XParser s String -> XParser s String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
            String
n <- XParser s String
forall s. XParser s String
name
            if String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
kw
              then String -> XParser s String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
              else String -> XParser s String
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
n
          )
      XParser s String -> String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
kw

keywords        :: [String] -> XParser s String
keywords :: [String] -> XParser s String
keywords
    = (XParser s String -> XParser s String -> XParser s String)
-> [XParser s String] -> XParser s String
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 XParser s String -> XParser s String -> XParser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) ([XParser s String] -> XParser s String)
-> ([String] -> [XParser s String]) -> [String] -> XParser s String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> XParser s String) -> [String] -> [XParser s String]
forall a b. (a -> b) -> [a] -> [b]
map String -> XParser s String
forall s. String -> XParser s String
keyword

-- ------------------------------------------------------------
--
-- parser for quoted attribute values

quoted          :: XParser s a -> XParser s a
quoted :: XParser s a -> XParser s a
quoted XParser s a
p
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s a
-> XParser s a
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 String (XPState s) Identity ()
forall s. XParser s ()
dq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq XParser s a
p
      XParser s a -> XParser s a -> XParser s a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s a
-> XParser s a
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 String (XPState s) Identity ()
forall s. XParser s ()
sq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq XParser s a
p

-- ------------------------------------------------------------
--
-- simple char parsers

dq, sq, lt, gt, semi, amp    :: XParser s ()

dq :: XParser s ()
dq      = Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"' ParsecT String (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sq :: XParser s ()
sq      = Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT String (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lt :: XParser s ()
lt      = Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'  ParsecT String (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
gt :: XParser s ()
gt      = Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'  ParsecT String (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
semi :: XParser s ()
semi    = Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'  ParsecT String (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
amp :: XParser s ()
amp     = Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&'  ParsecT String (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE  dq #-}
{-# INLINE  sq #-}
{-# INLINE  lt #-}
{-# INLINE  gt #-}
{-# INLINE  semi #-}
{-# INLINE  amp #-}

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

bar, comma, eq, lpar, rpar      :: XParser s ()

bar :: XParser s ()
bar     = Char -> XParser s ()
forall s. Char -> XParser s ()
separator Char
'|'
comma :: XParser s ()
comma   = Char -> XParser s ()
forall s. Char -> XParser s ()
separator Char
','
eq :: XParser s ()
eq      = Char -> XParser s ()
forall s. Char -> XParser s ()
separator Char
'='

{-# INLINE bar #-}
{-# INLINE comma #-}
{-# INLINE eq #-}

lpar :: XParser s ()
lpar    = Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XParser s ()
forall s. XParser s ()
skipS0
{-# INLINE lpar #-}

rpar :: XParser s ()
rpar    = XParser s ()
forall s. XParser s ()
skipS0 XParser s ()
-> ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')' ParsecT String (XPState s) Identity Char
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE rpar #-}

checkString     :: String -> XParser s ()
checkString :: String -> XParser s ()
checkString String
s
    = XParser s () -> XParser s ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (XParser s () -> XParser s ()) -> XParser s () -> XParser s ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String (XPState s) Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s ParsecT String (XPState s) Identity String
-> XParser s () -> XParser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE checkString #-}

-- ------------------------------------------------------------
--
-- all chars but not a special substring

allBut          :: (XParser s Char -> XParser s String) -> String -> XParser s String
allBut :: (XParser s Char -> XParser s String) -> String -> XParser s String
allBut XParser s Char -> XParser s String
p String
str
    = (XParser s Char -> XParser s String)
-> (Char -> Bool) -> String -> XParser s String
forall s.
(XParser s Char -> XParser s String)
-> (Char -> Bool) -> String -> XParser s String
allBut1 XParser s Char -> XParser s String
p (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True) String
str

allBut1         :: (XParser s Char -> XParser s String) -> (Char -> Bool) -> String -> XParser s String
allBut1 :: (XParser s Char -> XParser s String)
-> (Char -> Bool) -> String -> XParser s String
allBut1 XParser s Char -> XParser s String
p Char -> Bool
prd (Char
c:String
rest)
    = XParser s Char -> XParser s String
p ( (Char -> Bool) -> XParser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\ Char
x -> Char -> Bool
isXmlCharCR Char
x Bool -> Bool -> Bool
&& Char -> Bool
prd Char
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) )
          XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          XParser s Char
forall s. XParser s Char
xmlCRLFChar
          XParser s Char -> XParser s Char -> XParser s Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          XParser s Char -> XParser s Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( Char -> XParser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
                XParser s Char
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                XParser s Char -> ParsecT String (XPState s) Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (XParser s String -> XParser s String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> XParser s String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
rest) XParser s String -> XParser s Char -> XParser s Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> XParser s Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c)
                ParsecT String (XPState s) Identity ()
-> XParser s Char -> XParser s Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                Char -> XParser s Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
              )
        )

allBut1 XParser s Char -> XParser s String
_p Char -> Bool
_prd String
str
    = String -> XParser s String
forall a. HasCallStack => String -> a
error (String
"allBut1 _ _ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is undefined")

-- ------------------------------------------------------------
--
-- concatenate parse results

concRes         :: XParser s [[a]] -> XParser s [a]
concRes :: XParser s [[a]] -> XParser s [a]
concRes XParser s [[a]]
p
    = do
      [[a]]
sl <- XParser s [[a]]
p
      [a] -> XParser s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
sl)

mkList          :: XParser s a -> XParser s [a]
mkList :: XParser s a -> XParser s [a]
mkList XParser s a
p
    = do
      a
r <- XParser s a
p
      [a] -> XParser s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
r]

-- ------------------------------------------------------------
--
-- token parsers returning XmlTrees
--
-- ------------------------------------------------------------
--
-- Literals (2.3)

nameT           :: XParser s XmlTree
nameT :: XParser s XmlTree
nameT
    = do
      String
n <- XParser s String
forall s. XParser s String
name
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
NAME [(String
a_name, String
n)] [])

nmtokenT        :: XParser s XmlTree
nmtokenT :: XParser s XmlTree
nmtokenT
    = do
      String
n <- XParser s String
forall s. XParser s String
nmtoken
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
NAME [(String
a_name, String
n)] [])


entityValueT    :: XParser s XmlTrees
entityValueT :: XParser s XmlTrees
entityValueT
    =  do
       XmlTrees
sl <- ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s XmlTrees
-> XParser s XmlTrees
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq (String -> XParser s XmlTrees
forall s. String -> XParser s XmlTrees
entityTokensT String
"%&\"")
       XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
sl
       XParser s XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
       do
       XmlTrees
sl <- ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s XmlTrees
-> XParser s XmlTrees
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq (String -> XParser s XmlTrees
forall s. String -> XParser s XmlTrees
entityTokensT String
"%&\'")
       XmlTrees -> XParser s XmlTrees
forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
sl
       XParser s XmlTrees -> String -> XParser s XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"entity value (in quotes)"

entityTokensT   :: String -> XParser s XmlTrees
entityTokensT :: String -> XParser s XmlTrees
entityTokensT String
notAllowed
    = ParsecT String (XPState s) Identity XmlTree -> XParser s XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String (XPState s) Identity XmlTree
forall s. String -> XParser s XmlTree
entityCharT String
notAllowed)

entityCharT     :: String -> XParser s XmlTree
entityCharT :: String -> XParser s XmlTree
entityCharT String
notAllowed
    = XParser s XmlTree
forall s. XParser s XmlTree
peReferenceT
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s XmlTree
forall s. XParser s XmlTree
charRefT
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s XmlTree
forall s. XParser s XmlTree
bypassedEntityRefT
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        String
cs <- ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String (XPState s) Identity Char
forall s. String -> XParser s Char
singleChar String
notAllowed)
        XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> XmlTree
mkText' String
cs)
      )

attrValueT      :: XParser s XmlTrees
attrValueT :: XParser s XmlTrees
attrValueT
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s XmlTrees
-> XParser s XmlTrees
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
dq (String -> XParser s XmlTrees
forall s. String -> XParser s XmlTrees
attrValueT' String
"<&\"")
      XParser s XmlTrees -> XParser s XmlTrees -> XParser s XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> XParser s XmlTrees
-> XParser s XmlTrees
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq ParsecT String (XPState s) Identity ()
forall s. XParser s ()
sq (String -> XParser s XmlTrees
forall s. String -> XParser s XmlTrees
attrValueT' String
"<&\'")
      XParser s XmlTrees -> String -> XParser s XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"attribute value (in quotes)"

attrValueT'     :: String -> XParser s XmlTrees
attrValueT' :: String -> XParser s XmlTrees
attrValueT' String
notAllowed
    = XmlTrees -> XmlTrees
mergeTextNodes (XmlTrees -> XmlTrees) -> XParser s XmlTrees -> XParser s XmlTrees
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String (XPState s) Identity XmlTree -> XParser s XmlTrees
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( ParsecT String (XPState s) Identity XmlTree
forall s. XParser s XmlTree
referenceT ParsecT String (XPState s) Identity XmlTree
-> ParsecT String (XPState s) Identity XmlTree
-> ParsecT String (XPState s) Identity XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String (XPState s) Identity XmlTree
forall s. String -> XParser s XmlTree
singleCharsT String
notAllowed)

singleCharsT    :: String -> XParser s XmlTree
singleCharsT :: String -> XParser s XmlTree
singleCharsT String
notAllowed
    = do
      String
cs <- String -> XParser s String
forall s. String -> XParser s String
singleChars String
notAllowed
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> XmlTree
mkText' String
cs)

-- ------------------------------------------------------------
--
-- Character and Entity References (4.1)

referenceT      :: XParser s XmlTree
referenceT :: XParser s XmlTree
referenceT
    = XParser s XmlTree
forall s. XParser s XmlTree
charRefT
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s XmlTree
forall s. XParser s XmlTree
entityRefT

charRefT        :: XParser s XmlTree
charRefT :: XParser s XmlTree
charRefT
    = do
      Int
i <- XParser s Int
forall s. XParser s Int
charRef
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> XmlTree
mkCharRef' Int
i)

entityRefT      :: XParser s XmlTree
entityRefT :: XParser s XmlTree
entityRefT
    = do
      String
n <- XParser s String
forall s. XParser s String
entityRef
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$! (XmlTree -> (Int -> XmlTree) -> Maybe Int -> XmlTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> XmlTree
mkEntityRef' String
n) Int -> XmlTree
mkCharRef' (Maybe Int -> XmlTree)
-> ([(String, Int)] -> Maybe Int) -> [(String, Int)] -> XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n ([(String, Int)] -> XmlTree) -> [(String, Int)] -> XmlTree
forall a b. (a -> b) -> a -> b
$ [(String, Int)]
predefinedXmlEntities)

-- optimization: predefined XML entity refs are converted into equivalent char refs
-- so there is no need for an entitiy substitution phase, if there is no DTD
-- Attention: entityRefT must only be called from within XML/HTML content
-- in DTD parsing this optimization is not allowed because of different semantics
-- of charRefs and entityRefs during substitution of entites in ENTITY definitions

predefinedXmlEntities   :: [(String, Int)]
predefinedXmlEntities :: [(String, Int)]
predefinedXmlEntities
    = [ (String
"lt",   Int
60)
      , (String
"gt",   Int
62)
      , (String
"amp",  Int
38)
      , (String
"apos", Int
39)
      , (String
"quot", Int
34)
      ]

bypassedEntityRefT      :: XParser s XmlTree
bypassedEntityRefT :: XParser s XmlTree
bypassedEntityRefT
    = do
      String
n <- XParser s String
forall s. XParser s String
entityRef
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$! (String -> XmlTree
mkText' (String
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"))

peReferenceT    :: XParser s XmlTree
peReferenceT :: XParser s XmlTree
peReferenceT
    = do
      String
r <- XParser s String
forall s. XParser s String
peReference
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$! (DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem' DTDElem
PEREF [(String
a_peref, String
r)] [])

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

mergeTextNodes :: XmlTrees -> XmlTrees
mergeTextNodes :: XmlTrees -> XmlTrees
mergeTextNodes
    = (XmlTree -> XmlTrees -> XmlTrees)
-> XmlTrees -> XmlTrees -> XmlTrees
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XmlTree -> XmlTrees -> XmlTrees
addText []
    where
      addText :: XmlTree -> XmlTrees -> XmlTrees
      addText :: XmlTree -> XmlTrees -> XmlTrees
addText XmlTree
t []
          = [XmlTree
t]
      addText XmlTree
t (XmlTree
t1 : XmlTrees
ts)
          = XmlTree -> XmlTree -> XmlTrees
mergeText XmlTree
t XmlTree
t1 XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++ XmlTrees
ts

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