{-# 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
    = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s. XParser s Char
xmlSpaceChar

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

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

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

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

asciiLetter             :: XParser s Char
asciiLetter :: forall s. XParser s Char
asciiLetter
    = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\ Char
c -> ( Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z' Bool -> Bool -> Bool
||
                        Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z' )
              )
      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
      Char
s1 <- forall s. XParser s Char
xmlNameStartChar
      String
sl <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s. XParser s Char
xmlNameChar
      forall (m :: * -> *) a. Monad m => a -> m a
return (Char
s1 forall a. a -> [a] -> [a]
: String
sl)
      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
      Char
s1 <- forall s. XParser s Char
xmlNCNameStartChar
      String
sl <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s. XParser s Char
xmlNCNameChar
      forall (m :: * -> *) a. Monad m => a -> m a
return (Char
s1 forall a. a -> [a] -> [a]
: String
sl)
      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
      String
s1 <- forall s. XParser s String
ncName
      String
s2 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. XParser s String
ncName)
      forall (m :: * -> *) a. Monad m => a -> m a
return ( if 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 :: forall s. XParser s String
nmtoken
    = forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s. XParser s Char
xmlNameChar)
      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
    = 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 forall s. XParser s String
name forall s. XParser s String
sPace

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

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

singleChar              :: String -> XParser s Char
singleChar :: forall s. String -> XParser s Char
singleChar String
notAllowed
    = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
notAllowed)
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      forall s. XParser s Char
xmlCRLFChar

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

entityValue     :: XParser s String
entityValue :: forall s. XParser s String
entityValue
    = ( do
        String
v <- forall s. XParser s String
entityValueDQ
        forall (m :: * -> *) a. Monad m => a -> m a
return (String
"\"" forall a. [a] -> [a] -> [a]
++ String
v forall a. [a] -> [a] -> [a]
++ String
"\"")
      )
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        String
v <- forall s. XParser s String
entityValueSQ
        forall (m :: * -> *) a. Monad m => a -> m a
return (String
"'" forall a. [a] -> [a] -> [a]
++ String
v forall a. [a] -> [a] -> [a]
++ 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
    = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
dq forall s. XParser s ()
dq (forall s a. XParser s [[a]] -> XParser s [a]
concRes forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s. String -> XParser s String
attrChar String
"&\"")

entityValueSQ   :: XParser s String
entityValueSQ :: forall s. XParser s String
entityValueSQ
    = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
sq forall s. XParser s ()
sq (forall s a. XParser s [[a]] -> XParser s [a]
concRes forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s. String -> XParser s String
attrChar String
"&\'")

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

attrValueSQ     :: XParser s String
attrValueSQ :: forall s. XParser s String
attrValueSQ
    = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
sq forall s. XParser s ()
sq (forall s a. XParser s [[a]] -> XParser s [a]
concRes forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s. String -> XParser s String
attrChar String
"<&\'")

attrChar        :: String -> XParser s String
attrChar :: forall s. String -> XParser s String
attrChar String
notAllowed
    = forall s. XParser s String
reference
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      forall s a. XParser s a -> XParser s [a]
mkList (forall s. String -> XParser s Char
singleChar String
notAllowed)
      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: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
notAllowed forall a. [a] -> [a] -> [a]
++ String
" )")

systemLiteral           :: XParser s String
systemLiteral :: forall s. XParser s String
systemLiteral
    = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
dq forall s. XParser s ()
dq (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"")
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 forall s. XParser s ()
sq forall s. XParser s ()
sq (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf 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
    = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
dq forall s. XParser s ()
dq (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s. String -> XParser s Char
pubidChar String
"\'")
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 forall s. XParser s ()
sq forall s. XParser s ()
sq (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s. String -> XParser s Char
pubidChar 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
          = forall s. XParser s Char
asciiLetter
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            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
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"-()+,./:=?;!*#@$_%"
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            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
        Int
i <- forall s. XParser s Int
charRef
        forall (m :: * -> *) a. Monad m => a -> m a
return (String
"&#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
";")
      )
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ( do
        String
n <- forall s. XParser s String
entityRef
        forall (m :: * -> *) a. Monad m => a -> m a
return (String
"&" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
";")
      )

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

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

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


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

keyword         :: String -> XParser s String
keyword :: forall s. String -> XParser s String
keyword String
kw
    = forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
            String
n <- forall s. XParser s String
name
            if String
n forall a. Eq a => a -> a -> Bool
== String
kw
              then forall (m :: * -> *) a. Monad m => a -> m a
return String
n
              else forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
n
          )
      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
    = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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
    = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
dq forall s. XParser s ()
dq XParser s a
p
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 forall s. XParser s ()
sq 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      = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
sq :: forall s. XParser s ()
sq      = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
lt :: forall s. XParser s ()
lt      = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
gt :: forall s. XParser s ()
gt      = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
semi :: forall s. XParser s ()
semi    = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
amp :: forall s. XParser s ()
amp     = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
      Char
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                 forall s. XParser s ()
skipS0
                 forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
               )
      forall s. XParser s ()
skipS0
      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     = forall s. Char -> XParser s ()
separator Char
'|'
comma :: forall s. XParser s ()
comma   = forall s. Char -> XParser s ()
separator Char
','
eq :: forall s. XParser s ()
eq      = forall s. Char -> XParser s ()
separator Char
'='

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

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

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

checkString     :: String -> XParser s ()
checkString :: forall s. String -> XParser s ()
checkString String
s
    = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
    = forall s.
(XParser s Char -> XParser s String)
-> (Char -> Bool) -> String -> XParser s String
allBut1 XParser s Char -> XParser s String
p (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 ( 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 forall a. Eq a => a -> a -> Bool
== Char
c) )
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          forall s. XParser s Char
xmlCRLFChar
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          forall tok st a. GenParser tok st a -> GenParser tok st a
try ( forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
                forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
rest) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c)
                forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
              )
        )

allBut1 XParser s Char -> XParser s String
_p Char -> Bool
_prd String
str
    = forall a. HasCallStack => String -> a
error (String
"allBut1 _ _ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
str 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
      [[a]]
sl <- XParser s [[a]]
p
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
sl)

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

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

nameT           :: XParser s XmlTree
nameT :: forall s. XParser s XmlTree
nameT
    = do
      String
n <- forall s. XParser s String
name
      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 :: forall s. XParser s XmlTree
nmtokenT
    = do
      String
n <- forall s. XParser s String
nmtoken
      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 :: forall s. XParser s XmlTrees
entityValueT
    =  do
       XmlTrees
sl <- forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
dq forall s. XParser s ()
dq (forall s. String -> XParser s XmlTrees
entityTokensT String
"%&\"")
       forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
sl
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
       do
       XmlTrees
sl <- forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
sq forall s. XParser s ()
sq (forall s. String -> XParser s XmlTrees
entityTokensT String
"%&\'")
       forall (m :: * -> *) a. Monad m => a -> m a
return XmlTrees
sl
       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
    = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s. String -> XParser s XmlTree
entityCharT String
notAllowed)

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

attrValueT      :: XParser s XmlTrees
attrValueT :: forall s. XParser s XmlTrees
attrValueT
    = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between forall s. XParser s ()
dq forall s. XParser s ()
dq (forall s. String -> XParser s XmlTrees
attrValueT' String
"<&\"")
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 forall s. XParser s ()
sq forall s. XParser s ()
sq (forall s. String -> XParser s XmlTrees
attrValueT' String
"<&\'")
      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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ( forall s. XParser s XmlTree
referenceT forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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
      String
cs <- forall s. String -> XParser s String
singleChars String
notAllowed
      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 :: forall s. XParser s XmlTree
referenceT
    = forall s. XParser s XmlTree
charRefT
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      forall s. XParser s XmlTree
entityRefT

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

entityRefT      :: XParser s XmlTree
entityRefT :: forall s. XParser s XmlTree
entityRefT
    = do
      String
n <- forall s. XParser s String
entityRef
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> XmlTree
mkEntityRef' String
n) Int -> XmlTree
mkCharRef' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n 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 :: forall s. XParser s XmlTree
bypassedEntityRefT
    = do
      String
n <- forall s. XParser s String
entityRef
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (String -> XmlTree
mkText' (String
"&" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
";"))

peReferenceT    :: XParser s XmlTree
peReferenceT :: forall s. XParser s XmlTree
peReferenceT
    = do
      String
r <- forall s. XParser s String
peReference
      forall (m :: * -> *) a. Monad m => a -> m a
return 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
    = 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 forall a. [a] -> [a] -> [a]
++ XmlTrees
ts

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