{-# 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 :: forall s. XParser s String
sPace
    = ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. 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 :: forall s. XParser s String
sPace0
    = ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity 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 :: forall s. XParser s ()
skipS
    = ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity ()
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 :: forall s. XParser s ()
skipS0
    = ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity ()
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 :: forall s. XParser s Char
asciiLetter
    = (Char -> Bool) -> ParsecT String (XPState s) Identity 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' )
              )
      ParsecT String (XPState s) Identity Char
-> String -> ParsecT String (XPState s) Identity 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 :: forall s. XParser s String
name
    = do
      s1 <- XParser s Char
forall s. XParser s Char
xmlNameStartChar
      sl <- many xmlNameChar
      return (s1 : sl)
      ParsecT String (XPState s) Identity String
-> String -> ParsecT String (XPState s) Identity 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 :: forall s. XParser s String
ncName
    = do
      s1 <- XParser s Char
forall s. XParser s Char
xmlNCNameStartChar
      sl <- many xmlNCNameChar
      return (s1 : sl)
      ParsecT String (XPState s) Identity String
-> String -> ParsecT String (XPState s) Identity 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 :: forall s. XParser s (String, String)
qName
    = do
      s1 <- XParser s String
forall s. XParser s String
ncName
      s2 <- option "" (char ':' >> ncName)
      return ( if null s2
               then (s2, s1)
               else (s1, s2)
             )

nmtoken         :: XParser s String
nmtoken :: forall s. XParser s String
nmtoken
    = GenParser Char (XPState s) String
-> GenParser Char (XPState s) String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String (XPState s) Identity Char
-> GenParser Char (XPState s) String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String (XPState s) Identity Char
forall s. XParser s Char
xmlNameChar)
      GenParser Char (XPState s) String
-> String -> GenParser Char (XPState 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 :: forall s. XParser s [String]
names
    = ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity [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 :: forall s. XParser s [String]
nmtokens
    = ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity [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 :: forall s. String -> XParser s Char
singleChar String
notAllowed
    = (Char -> Bool) -> ParsecT String (XPState s) Identity 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)
      ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity Char
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 Char
forall s. XParser s Char
xmlCRLFChar

singleChars             :: String -> XParser s String
singleChars :: forall s. String -> XParser s String
singleChars String
notAllowed
    = ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. 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 :: forall s. XParser s String
entityValue
    = ( do
        v <- XParser s String
forall s. XParser s String
entityValueDQ
        return ("\"" ++ v ++ "\"")
      )
      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
        v <- XParser s String
forall s. XParser s String
entityValueSQ
        return ("'" ++ v ++ "'")
      )
      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 :: forall s. XParser s String
entityValueDQ
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity 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] -> ParsecT String (XPState s) Identity String
forall s a. XParser s [[a]] -> XParser s [a]
concRes (XParser s [String] -> ParsecT String (XPState s) Identity String)
-> XParser s [String] -> ParsecT String (XPState s) Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String (XPState s) Identity String -> XParser s [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity String -> XParser s [String])
-> ParsecT String (XPState s) Identity String -> XParser s [String]
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String (XPState s) Identity String
forall s. String -> XParser s String
attrChar String
"&\"")

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

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

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

attrChar        :: String -> XParser s String
attrChar :: forall s. 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 :: forall s. XParser s String
systemLiteral
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity 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
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity Char
 -> ParsecT String (XPState s) Identity String)
-> ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity 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
"\"")
      ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity 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 ()
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity 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
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity Char
 -> ParsecT String (XPState s) Identity String)
-> ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity 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
"\'")
      ParsecT String (XPState s) Identity String
-> String -> ParsecT String (XPState s) Identity 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 :: forall s. XParser s String
pubidLiteral
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity 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
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity Char
 -> ParsecT String (XPState s) Identity String)
-> ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String (XPState s) Identity Char
forall s. String -> XParser s Char
pubidChar String
"\'")
      ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity 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 ()
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity 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
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String (XPState s) Identity Char
 -> ParsecT String (XPState s) Identity String)
-> ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String (XPState s) Identity Char
forall s. String -> XParser s Char
pubidChar String
"")
      ParsecT String (XPState s) Identity String
-> String -> ParsecT String (XPState s) Identity 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 :: forall s. 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 :: forall s. XParser s String
reference
    = ( do
        i <- XParser s Int
forall s. XParser s Int
charRef
        return ("&#" ++ show i ++ ";")
      )
      ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity String
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        n <- ParsecT String (XPState s) Identity String
forall s. XParser s String
entityRef
        return ("&" ++ n ++ ";")
      )

checkCharRef    :: Int -> XParser s Int
checkCharRef :: forall s. 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 -> ParsecT String (XPState s) Identity Int
forall a. a -> ParsecT String (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
        else String -> ParsecT String (XPState s) Identity 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 :: forall s. XParser s Int
charRef
    = do
      String -> XParser s ()
forall s. String -> XParser s ()
checkString String
"&#x"
      d <- ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. 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
      semi
      checkCharRef (hexStringToInt 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
"&#"
      d <- ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. 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
      semi
      checkCharRef (decimalStringToInt 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 :: forall s. XParser s String
entityRef
    = do
      XParser s ()
forall s. XParser s ()
amp
      n <- XParser s String
forall s. XParser s String
name
      semi
      return 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 :: forall s. XParser s String
peReference
    = GenParser Char (XPState s) String
-> GenParser Char (XPState s) String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
            _ <- Char -> ParsecT String (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
            n <- name
            semi
            return n
          )
      GenParser Char (XPState s) String
-> String -> GenParser Char (XPState 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 :: forall s. XParser s String
encName
    = do
      c <- XParser s Char
forall s. XParser s Char
asciiLetter
      r <- many (asciiLetter <|> digit <|> oneOf "._-")
      return (c:r)

versionNum      :: XParser s String
versionNum :: forall s. XParser s String
versionNum
    = ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. 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 :: forall s. String -> XParser s String
keyword String
kw
    = GenParser Char (XPState s) String
-> GenParser Char (XPState s) String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
            n <- GenParser Char (XPState s) String
forall s. XParser s String
name
            if n == kw
              then return n
              else unexpected n
          )
      GenParser Char (XPState s) String
-> String -> GenParser Char (XPState 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 :: forall s. [String] -> XParser s String
keywords
    = (XParser s String -> XParser s String -> XParser s String)
-> [XParser s String] -> XParser s String
forall a. (a -> a -> a) -> [a] -> a
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 :: forall s a. 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 :: forall s. 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
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String (XPState s) Identity ()
forall a. a -> ParsecT String (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sq :: forall s. 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
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String (XPState s) Identity ()
forall a. a -> ParsecT String (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lt :: forall s. 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
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String (XPState s) Identity ()
forall a. a -> ParsecT String (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
gt :: forall s. 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
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String (XPState s) Identity ()
forall a. a -> ParsecT String (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
semi :: forall s. 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
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String (XPState s) Identity ()
forall a. a -> ParsecT String (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
amp :: forall s. 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
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String (XPState s) Identity ()
forall a. a -> ParsecT String (XPState s) Identity a
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 :: forall s. Char -> XParser s ()
separator Char
c
    = do
      _ <- 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
               )
      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 :: forall s. XParser s ()
bar     = Char -> XParser s ()
forall s. Char -> XParser s ()
separator Char
'|'
comma :: forall s. XParser s ()
comma   = Char -> XParser s ()
forall s. Char -> XParser s ()
separator Char
','
eq :: forall s. XParser s ()
eq      = Char -> XParser s ()
forall s. Char -> XParser s ()
separator Char
'='

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

lpar :: forall s. 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
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String (XPState s) Identity ()
forall s. XParser s ()
skipS0
{-# INLINE lpar #-}

rpar :: forall s. 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 a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
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 a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> XParser s ()
forall a. a -> ParsecT String (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE rpar #-}

checkString     :: String -> XParser s ()
checkString :: forall s. String -> XParser s ()
checkString String
s
    = GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char (XPState s) () -> GenParser Char (XPState s) ())
-> GenParser Char (XPState s) () -> GenParser Char (XPState 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
-> GenParser Char (XPState s) () -> GenParser Char (XPState s) ()
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> GenParser Char (XPState s) ()
forall a. a -> ParsecT String (XPState s) Identity a
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 :: forall s.
(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 :: forall s.
(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 a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
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 a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> XParser s Char
forall a. a -> ParsecT String (XPState s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c)
                ParsecT String (XPState s) Identity ()
-> XParser s Char -> XParser s Char
forall a b.
ParsecT String (XPState s) Identity a
-> ParsecT String (XPState s) Identity b
-> ParsecT String (XPState s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                Char -> XParser s Char
forall a. a -> ParsecT String (XPState s) Identity a
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 :: forall s a. XParser s [[a]] -> XParser s [a]
concRes XParser s [[a]]
p
    = do
      sl <- XParser s [[a]]
p
      return (concat sl)

mkList          :: XParser s a -> XParser s [a]
mkList :: forall s a. XParser s a -> XParser s [a]
mkList XParser s a
p
    = do
      r <- XParser s a
p
      return [r]

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

nameT           :: XParser s XmlTree
nameT :: forall s. XParser s XmlTree
nameT
    = do
      n <- XParser s String
forall s. XParser s String
name
      return (mkDTDElem' NAME [(a_name, n)] [])

nmtokenT        :: XParser s XmlTree
nmtokenT :: forall s. XParser s XmlTree
nmtokenT
    = do
      n <- XParser s String
forall s. XParser s String
nmtoken
      return (mkDTDElem' NAME [(a_name, n)] [])


entityValueT    :: XParser s XmlTrees
entityValueT :: forall s. XParser s XmlTrees
entityValueT
    =  do
       sl <- ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity 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 -> ParsecT String (XPState s) Identity XmlTrees
forall s. String -> XParser s XmlTrees
entityTokensT String
"%&\"")
       return sl
       ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity XmlTrees
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
       do
       sl <- ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity 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 -> ParsecT String (XPState s) Identity XmlTrees
forall s. String -> XParser s XmlTrees
entityTokensT String
"%&\'")
       return sl
       ParsecT String (XPState s) Identity XmlTrees
-> String -> ParsecT String (XPState s) Identity 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 :: forall s. String -> XParser s XmlTrees
entityTokensT String
notAllowed
    = ParsecT String (XPState s) Identity XmlTree
-> ParsecT String (XPState s) Identity 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 :: forall s. 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
        cs <- ParsecT String (XPState s) Identity Char
-> ParsecT String (XPState s) Identity String
forall s u (m :: * -> *) a. 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)
        return (mkText' cs)
      )

attrValueT      :: XParser s XmlTrees
attrValueT :: forall s. XParser s XmlTrees
attrValueT
    = ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity ()
-> ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity 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 -> ParsecT String (XPState s) Identity XmlTrees
forall s. String -> XParser s XmlTrees
attrValueT' String
"<&\"")
      ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity 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 ()
-> ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity 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 -> ParsecT String (XPState s) Identity XmlTrees
forall s. String -> XParser s XmlTrees
attrValueT' String
"<&\'")
      ParsecT String (XPState s) Identity XmlTrees
-> String -> ParsecT String (XPState s) Identity 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' :: forall s. String -> XParser s XmlTrees
attrValueT' String
notAllowed
    = XmlTrees -> XmlTrees
mergeTextNodes (XmlTrees -> XmlTrees)
-> ParsecT String (XPState s) Identity XmlTrees
-> ParsecT String (XPState s) Identity XmlTrees
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String (XPState s) Identity XmlTree
-> ParsecT String (XPState s) Identity 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 :: forall s. String -> XParser s XmlTree
singleCharsT String
notAllowed
    = do
      cs <- String -> XParser s String
forall s. String -> XParser s String
singleChars String
notAllowed
      return (mkText' cs)

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

referenceT      :: XParser s XmlTree
referenceT :: forall s. 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 :: forall s. XParser s XmlTree
charRefT
    = do
      i <- XParser s Int
forall s. XParser s Int
charRef
      return (mkCharRef' i)

entityRefT      :: XParser s XmlTree
entityRefT :: forall s. XParser s XmlTree
entityRefT
    = do
      n <- XParser s String
forall s. XParser s String
entityRef
      return $! (maybe (mkEntityRef' n) mkCharRef' . lookup n $ 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 :: forall s. XParser s XmlTree
bypassedEntityRefT
    = do
      n <- XParser s String
forall s. XParser s String
entityRef
      return $! (mkText' ("&" ++ n ++ ";"))

peReferenceT    :: XParser s XmlTree
peReferenceT :: forall s. XParser s XmlTree
peReferenceT
    = do
      r <- XParser s String
forall s. XParser s String
peReference
      return $! (mkDTDElem' PEREF [(a_peref, r)] [])

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

mergeTextNodes :: XmlTrees -> XmlTrees
mergeTextNodes :: XmlTrees -> XmlTrees
mergeTextNodes
    = (XmlTree -> XmlTrees -> XmlTrees)
-> XmlTrees -> XmlTrees -> XmlTrees
forall a b. (a -> b -> b) -> b -> [a] -> b
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

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