{-# LANGUAGE CPP #-}
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
)
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
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"
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"
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
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"
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
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"
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
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
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
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 #-}
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")
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]
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)
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)
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