{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Text.XmlHtml.HTML.Parse where
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Text.XmlHtml.Common
import Text.XmlHtml.HTML.Meta
import Text.XmlHtml.TextParser
import qualified Text.XmlHtml.XML.Parse as XML
import qualified Text.Parsec as P
import qualified Data.HashSet as S
import qualified Data.HashMap.Strict as M
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as T
docFragment :: Encoding -> Parser Document
docFragment :: Encoding -> Parser Document
docFragment Encoding
e = do
(Maybe DocType
dt, [Node]
nodes1) <- Parser (Maybe DocType, [Node])
prolog
([Node]
nodes2, ElemResult
Matched) <- Maybe Text -> Parser ([Node], ElemResult)
content Maybe Text
forall a. Maybe a
Nothing
Document -> Parser Document
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Document -> Parser Document) -> Document -> Parser Document
forall a b. (a -> b) -> a -> b
$ Encoding -> Maybe DocType -> [Node] -> Document
HtmlDocument Encoding
e Maybe DocType
dt ([Node]
nodes1 [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node]
nodes2)
prolog :: Parser (Maybe DocType, [Node])
prolog :: Parser (Maybe DocType, [Node])
prolog = do
Maybe (Maybe Text)
_ <- ParsecT Text () Identity (Maybe Text)
-> ParsecT Text () Identity (Maybe (Maybe Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text () Identity (Maybe Text)
XML.xmlDecl
[Maybe Node]
nodes1 <- ParsecT Text () Identity (Maybe Node)
-> ParsecT Text () Identity [Maybe Node]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Text () Identity (Maybe Node)
XML.misc
Maybe (DocType, [Maybe Node])
rest <- ParsecT Text () Identity (DocType, [Maybe Node])
-> ParsecT Text () Identity (Maybe (DocType, [Maybe Node]))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Text () Identity (DocType, [Maybe Node])
-> ParsecT Text () Identity (Maybe (DocType, [Maybe Node])))
-> ParsecT Text () Identity (DocType, [Maybe Node])
-> ParsecT Text () Identity (Maybe (DocType, [Maybe Node]))
forall a b. (a -> b) -> a -> b
$ do
DocType
dt <- Parser DocType
docTypeDecl
[Maybe Node]
nodes2 <- ParsecT Text () Identity (Maybe Node)
-> ParsecT Text () Identity [Maybe Node]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Text () Identity (Maybe Node)
XML.misc
(DocType, [Maybe Node])
-> ParsecT Text () Identity (DocType, [Maybe Node])
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (DocType
dt, [Maybe Node]
nodes2)
case Maybe (DocType, [Maybe Node])
rest of
Maybe (DocType, [Maybe Node])
Nothing -> (Maybe DocType, [Node]) -> Parser (Maybe DocType, [Node])
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DocType
forall a. Maybe a
Nothing, [Maybe Node] -> [Node]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Node]
nodes1)
Just (DocType
dt, [Maybe Node]
nodes2) -> (Maybe DocType, [Node]) -> Parser (Maybe DocType, [Node])
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (DocType -> Maybe DocType
forall a. a -> Maybe a
Just DocType
dt, [Maybe Node] -> [Node]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Node]
nodes1 [Maybe Node] -> [Maybe Node] -> [Maybe Node]
forall a. [a] -> [a] -> [a]
++ [Maybe Node]
nodes2))
docTypeDecl :: Parser DocType
docTypeDecl :: Parser DocType
docTypeDecl = do
ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text () Identity () -> ParsecT Text () Identity ())
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$ do
Text
_ <- Text -> Parser Text
text Text
"<!"
Text
decl <- Parser Text
XML.name
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Text
T.toLower Text
decl Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"doctype") (ParsecT Text () Identity () -> ParsecT Text () Identity ())
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity ()
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected DOCTYPE"
ParsecT Text () Identity ()
XML.whiteSpace
Text
tag <- Parser Text
XML.name
Maybe ()
_ <- ParsecT Text () Identity () -> ParsecT Text () Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text () Identity ()
XML.whiteSpace
ExternalID
extid <- Parser ExternalID
externalID
Maybe ()
_ <- ParsecT Text () Identity () -> ParsecT Text () Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text () Identity ()
XML.whiteSpace
InternalSubset
intsub <- Parser InternalSubset
XML.internalDoctype
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'>'
DocType -> Parser DocType
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExternalID -> InternalSubset -> DocType
DocType Text
tag ExternalID
extid InternalSubset
intsub)
externalID :: Parser ExternalID
externalID :: Parser ExternalID
externalID = do
Maybe Text
tok <- Parser Text -> ParsecT Text () Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> ParsecT Text () Identity (Maybe Text))
-> Parser Text -> ParsecT Text () Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
XML.name
case Maybe Text
tok of
Just Text
"system" -> Parser ExternalID
systemID
Just Text
"public" -> Parser ExternalID
publicID
Just Text
_ -> String -> Parser ExternalID
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected SYSTEM or PUBLIC"
Maybe Text
Nothing -> ExternalID -> Parser ExternalID
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ExternalID
NoExternalID
where
systemID :: Parser ExternalID
systemID = do
ParsecT Text () Identity ()
XML.whiteSpace
Text -> ExternalID
System (Text -> ExternalID) -> Parser Text -> Parser ExternalID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
XML.systemLiteral
publicID :: Parser ExternalID
publicID = do
ParsecT Text () Identity ()
XML.whiteSpace
Text
pid <- Parser Text
XML.pubIdLiteral
ParsecT Text () Identity ()
XML.whiteSpace
Text
sid <- Parser Text
XML.systemLiteral
ExternalID -> Parser ExternalID
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> ExternalID
Public Text
pid Text
sid)
data ElemResult = Matched
| ImplicitLast Text
| ImplicitNext Text Text [(Text, Text)] Bool
finishElement :: Text -> Text -> [(Text, Text)] -> Bool
-> Parser (Node, ElemResult)
finishElement :: Text -> Text -> [(Text, Text)] -> Bool -> Parser (Node, ElemResult)
finishElement Text
t Text
tbase [(Text, Text)]
a Bool
b = do
if Bool
b then (Node, ElemResult) -> Parser (Node, ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [], ElemResult
Matched)
else Parser (Node, ElemResult)
nonEmptyElem
where
nonEmptyElem :: Parser (Node, ElemResult)
nonEmptyElem
| Text -> [(Text, Text)] -> Bool
isRawText Text
tbase [(Text, Text)]
a = do
Node
c <- String -> Parser ElemResult -> Parser Node
forall a. String -> Parser a -> Parser Node
XML.cdata String
"<" (Parser ElemResult -> Parser Node)
-> Parser ElemResult -> Parser Node
forall a b. (a -> b) -> a -> b
$ Parser ElemResult -> Parser ElemResult
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Text -> Parser ElemResult
endTag Text
t)
(Node, ElemResult) -> Parser (Node, ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [Node
c], ElemResult
Matched)
| Text
tbase Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet Text
endOmittableLast = (Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult))
-> Parser (Node, ElemResult)
tagContents Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
| Bool
otherwise = (Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult))
-> Parser (Node, ElemResult)
tagContents ((ElemResult -> Maybe ElemResult)
-> Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult)
forall a b.
(a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElemResult -> Maybe ElemResult
forall a. a -> Maybe a
Just)
tagContents :: (Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult))
-> Parser (Node, ElemResult)
tagContents Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult)
modifier = do
([Node]
c,ElemResult
r1) <- Maybe Text -> Parser ([Node], ElemResult)
content (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
tbase)
case ElemResult
r1 of
ElemResult
Matched -> do
Maybe ElemResult
r2 <- Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult)
modifier (Text -> Parser ElemResult
endTag Text
t)
case Maybe ElemResult
r2 of
Maybe ElemResult
Nothing -> (Node, ElemResult) -> Parser (Node, ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [Node]
c, ElemResult
Matched)
Just ElemResult
rr -> (Node, ElemResult) -> Parser (Node, ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [Node]
c, ElemResult
rr)
ImplicitLast Text
tag | Text -> Text
T.toCaseFold Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold Text
t -> do
(Node, ElemResult) -> Parser (Node, ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [Node]
c, ElemResult
Matched)
ElemResult
end -> do
(Node, ElemResult) -> Parser (Node, ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [Node]
c, ElemResult
end)
emptyOrStartTag :: Parser (Text, Text, [(Text, Text)], Bool)
emptyOrStartTag :: Parser (Text, Text, [(Text, Text)], Bool)
emptyOrStartTag = do
Text
t <- Parser Text -> Parser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'<' ParsecT Text () Identity Char -> Parser Text -> Parser Text
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
XML.name
let tbase :: Text
tbase = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
":" Text
t
[(Text, Text)]
a <- ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity [(Text, Text)]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity [(Text, Text)])
-> ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity (Text, Text))
-> ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
ParsecT Text () Identity ()
XML.whiteSpace
ParsecT Text () Identity (Text, Text)
attribute
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Text, Text)] -> Bool
forall {a} {b}. Eq a => [(a, b)] -> Bool
hasDups [(Text, Text)]
a) (ParsecT Text () Identity () -> ParsecT Text () Identity ())
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity ()
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Duplicate attribute names in element"
Maybe ()
_ <- ParsecT Text () Identity () -> ParsecT Text () Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text () Identity ()
XML.whiteSpace
Bool
e <- (Maybe Char -> Bool)
-> ParsecT Text () Identity (Maybe Char)
-> ParsecT Text () Identity Bool
forall a b.
(a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (ParsecT Text () Identity (Maybe Char)
-> ParsecT Text () Identity Bool)
-> ParsecT Text () Identity (Maybe Char)
-> ParsecT Text () Identity Bool
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity Char
-> ParsecT Text () Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'/')
let e' :: Bool
e' = Bool
e Bool -> Bool -> Bool
|| (Text
tbase Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet Text
voidTags)
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'>'
(Text, Text, [(Text, Text)], Bool)
-> Parser (Text, Text, [(Text, Text)], Bool)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t, Text
tbase, [(Text, Text)]
a, Bool
e')
where
hasDups :: [(a, b)] -> Bool
hasDups [(a, b)]
a = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub (((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
a)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [(a, b)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
a
attrName :: Parser Text
attrName :: Parser Text
attrName = (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isAttrName
where isAttrName :: Char -> Bool
isAttrName Char
c | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\0',Char
' ',Char
'"',Char
'\'',Char
'>',Char
'/',Char
'='] = Bool
False
| Char -> Bool
isControlChar Char
c = Bool
False
| Bool
otherwise = Bool
True
isControlChar :: Char -> Bool
isControlChar :: Char -> Bool
isControlChar Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x007F' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x009F' = Bool
True
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFDD0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFDEF' = Bool
True
| Bool
otherwise = Bool
False
quotedAttrValue :: Parser Text
quotedAttrValue :: Parser Text
quotedAttrValue = Parser Text
singleQuoted Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
doubleQuoted
where
singleQuoted :: Parser Text
singleQuoted = Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\'' ParsecT Text () Identity Char -> Parser Text -> Parser Text
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Text
forall {t :: * -> *}. Foldable t => t Char -> Parser Text
refTill [Char
'&',Char
'\''] Parser Text -> ParsecT Text () Identity Char -> Parser Text
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\''
doubleQuoted :: Parser Text
doubleQuoted = Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'"' ParsecT Text () Identity Char -> Parser Text -> Parser Text
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Text
forall {t :: * -> *}. Foldable t => t Char -> Parser Text
refTill [Char
'&',Char
'"'] Parser Text -> ParsecT Text () Identity Char -> Parser Text
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'"'
refTill :: t Char -> Parser Text
refTill t Char
end = [Text] -> Text
T.concat ([Text] -> Text) -> ParsecT Text () Identity [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> ParsecT Text () Identity [Text]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
((Char -> Bool) -> Parser Text
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> t Char -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
end)) Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
reference)
unquotedAttrValue :: Parser Text
unquotedAttrValue :: Parser Text
unquotedAttrValue = String -> Parser Text
forall {t :: * -> *}. Foldable t => t Char -> Parser Text
refTill [Char
' ',Char
'"',Char
'\'',Char
'=',Char
'<',Char
'>',Char
'&',Char
'`']
where
refTill :: t Char -> Parser Text
refTill t Char
end = [Text] -> Text
T.concat ([Text] -> Text) -> ParsecT Text () Identity [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> ParsecT Text () Identity [Text]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
((Char -> Bool) -> Parser Text
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> t Char -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
end)) Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
reference)
attrValue :: Parser Text
attrValue :: Parser Text
attrValue = Parser Text
quotedAttrValue Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
unquotedAttrValue
attribute :: Parser (Text, Text)
attribute :: ParsecT Text () Identity (Text, Text)
attribute = do
Text
n <- Parser Text
attrName
Maybe Text
v <- Parser Text -> ParsecT Text () Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> ParsecT Text () Identity (Maybe Text))
-> Parser Text -> ParsecT Text () Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
Char
_ <- ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text () Identity Char -> ParsecT Text () Identity Char)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a b. (a -> b) -> a -> b
$ do
Maybe ()
_ <- ParsecT Text () Identity () -> ParsecT Text () Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text () Identity ()
XML.whiteSpace
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'='
Maybe ()
_ <- ParsecT Text () Identity () -> ParsecT Text () Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text () Identity ()
XML.whiteSpace
Parser Text
attrValue
(Text, Text) -> ParsecT Text () Identity (Text, Text)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Text) -> ParsecT Text () Identity (Text, Text))
-> (Text, Text) -> ParsecT Text () Identity (Text, Text)
forall a b. (a -> b) -> a -> b
$ (Text, Text)
-> (Text -> (Text, Text)) -> Maybe Text -> (Text, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
n,Text
"") (Text
n,) Maybe Text
v
endTag :: Text -> Parser ElemResult
endTag :: Text -> Parser ElemResult
endTag Text
s = do
Text
_ <- Text -> Parser Text
text Text
"</"
Text
t <- Parser Text
XML.name
let sbase :: Text
sbase = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
":" Text
s
ElemResult
r <- if (Text -> Text
T.toCaseFold Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold Text
t)
then ElemResult -> Parser ElemResult
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ElemResult
Matched
else if Text
sbase Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet Text
endOmittableLast
then ElemResult -> Parser ElemResult
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ElemResult
ImplicitLast Text
t)
else String -> Parser ElemResult
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ElemResult) -> String -> Parser ElemResult
forall a b. (a -> b) -> a -> b
$ String
"mismatched tags: </" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"> found inside <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"> tag"
Maybe ()
_ <- ParsecT Text () Identity () -> ParsecT Text () Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text () Identity ()
XML.whiteSpace
Text
_ <- Text -> Parser Text
text Text
">"
ElemResult -> Parser ElemResult
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ElemResult
r
content :: Maybe Text -> Parser ([Node], ElemResult)
content :: Maybe Text -> Parser ([Node], ElemResult)
content Maybe Text
parent = do
([Maybe Node]
ns, ElemResult
end) <- ParsecT Text () Identity ([Maybe Node], ElemResult)
readText
([Node], ElemResult) -> Parser ([Node], ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node] -> [Node]
coalesceText ([Maybe Node] -> [Node]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Node]
ns), ElemResult
end)
where
readText :: ParsecT Text () Identity ([Maybe Node], ElemResult)
readText = do
Maybe Node
s <- Parser Node -> ParsecT Text () Identity (Maybe Node)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Node
XML.charData
Maybe ([Maybe Node], ElemResult)
t <- ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity (Maybe ([Maybe Node], ElemResult))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text () Identity ([Maybe Node], ElemResult)
whileMatched
case Maybe ([Maybe Node], ElemResult)
t of
Maybe ([Maybe Node], ElemResult)
Nothing -> ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Node
s], ElemResult
Matched)
Just ([Maybe Node]
tt, ElemResult
m) -> ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Node
sMaybe Node -> [Maybe Node] -> [Maybe Node]
forall a. a -> [a] -> [a]
:[Maybe Node]
tt, ElemResult
m)
whileMatched :: ParsecT Text () Identity ([Maybe Node], ElemResult)
whileMatched = do
([Maybe Node]
n,ElemResult
end) <- (,ElemResult
Matched) ([Maybe Node] -> ([Maybe Node], ElemResult))
-> (Maybe Node -> [Maybe Node])
-> Maybe Node
-> ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Node -> [Maybe Node] -> [Maybe Node]
forall a. a -> [a] -> [a]
:[]) (Maybe Node -> ([Maybe Node], ElemResult))
-> (Node -> Maybe Node) -> Node -> ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> ([Maybe Node], ElemResult))
-> (Text -> Node) -> Text -> ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Node
TextNode (Text -> ([Maybe Node], ElemResult))
-> Parser Text
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
reference
ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,ElemResult
Matched) ([Maybe Node] -> ([Maybe Node], ElemResult))
-> (Maybe Node -> [Maybe Node])
-> Maybe Node
-> ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Node -> [Maybe Node] -> [Maybe Node]
forall a. a -> [a] -> [a]
:[]) (Maybe Node -> ([Maybe Node], ElemResult))
-> ParsecT Text () Identity (Maybe Node)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Maybe Node)
XML.cdSect
ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,ElemResult
Matched) ([Maybe Node] -> ([Maybe Node], ElemResult))
-> (Maybe Node -> [Maybe Node])
-> Maybe Node
-> ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Node -> [Maybe Node] -> [Maybe Node]
forall a. a -> [a] -> [a]
:[]) (Maybe Node -> ([Maybe Node], ElemResult))
-> ParsecT Text () Identity (Maybe Node)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Maybe Node)
XML.processingInstruction
ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,ElemResult
Matched) ([Maybe Node] -> ([Maybe Node], ElemResult))
-> (Maybe Node -> [Maybe Node])
-> Maybe Node
-> ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Node -> [Maybe Node] -> [Maybe Node]
forall a. a -> [a] -> [a]
:[]) (Maybe Node -> ([Maybe Node], ElemResult))
-> ParsecT Text () Identity (Maybe Node)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Maybe Node)
XML.comment
ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text () Identity ([Maybe Node], ElemResult)
doElement
case ElemResult
end of
ElemResult
Matched -> do
([Maybe Node]
ns, ElemResult
end') <- ParsecT Text () Identity ([Maybe Node], ElemResult)
readText
([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Node]
n [Maybe Node] -> [Maybe Node] -> [Maybe Node]
forall a. [a] -> [a] -> [a]
++ [Maybe Node]
ns, ElemResult
end')
ElemResult
_ -> do
([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Node]
n, ElemResult
end)
doElement :: ParsecT Text () Identity ([Maybe Node], ElemResult)
doElement = do
(Text
t,Text
tb, [(Text, Text)]
a,Bool
b) <- Parser (Text, Text, [(Text, Text)], Bool)
emptyOrStartTag
Text
-> Text
-> [(Text, Text)]
-> Bool
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
handle Text
t Text
tb [(Text, Text)]
a Bool
b
handle :: Text
-> Text
-> [(Text, Text)]
-> Bool
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
handle Text
t Text
tb [(Text, Text)]
a Bool
b = do
if Text -> Maybe Text -> Bool
breaksTag Text
tb Maybe Text
parent
then ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Node
forall a. Maybe a
Nothing], Text -> Text -> [(Text, Text)] -> Bool -> ElemResult
ImplicitNext Text
t Text
tb [(Text, Text)]
a Bool
b)
else do
(Node
n,ElemResult
end) <- Text -> Text -> [(Text, Text)] -> Bool -> Parser (Node, ElemResult)
finishElement Text
t Text
tb [(Text, Text)]
a Bool
b
case ElemResult
end of
ImplicitNext Text
t' Text
tb' [(Text, Text)]
a' Bool
b' -> do
([Maybe Node]
ns,ElemResult
end') <- Text
-> Text
-> [(Text, Text)]
-> Bool
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
handle Text
t' Text
tb' [(Text, Text)]
a' Bool
b'
([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
n Maybe Node -> [Maybe Node] -> [Maybe Node]
forall a. a -> [a] -> [a]
: [Maybe Node]
ns, ElemResult
end')
ElemResult
_ -> ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node -> Maybe Node
forall a. a -> Maybe a
Just Node
n], ElemResult
end)
breaksTag :: Text -> Maybe Text -> Bool
breaksTag Text
_ Maybe Text
Nothing = Bool
False
breaksTag Text
child (Just Text
tag) = case Text -> HashMap Text (HashSet Text) -> Maybe (HashSet Text)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
tag HashMap Text (HashSet Text)
endOmittableNext of
Maybe (HashSet Text)
Nothing -> Bool
False
Just HashSet Text
s -> Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member Text
child HashSet Text
s
coalesceText :: [Node] -> [Node]
coalesceText (TextNode Text
s : TextNode Text
t : [Node]
ns)
= [Node] -> [Node]
coalesceText (Text -> Node
TextNode (Text -> Text -> Text
T.append Text
s Text
t) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
ns)
coalesceText (Node
n:[Node]
ns)
= Node
n Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node] -> [Node]
coalesceText [Node]
ns
coalesceText []
= []
reference :: Parser Text
reference :: Parser Text
reference = do
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'&'
Either Char Text
r <- (Char -> Either Char Text
forall a b. a -> Either a b
Left (Char -> Either Char Text)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (Either Char Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try ParsecT Text () Identity Char
finishCharRef)
ParsecT Text () Identity (Either Char Text)
-> ParsecT Text () Identity (Either Char Text)
-> ParsecT Text () Identity (Either Char Text)
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Either Char Text
forall a b. b -> Either a b
Right (Text -> Either Char Text)
-> Parser Text -> ParsecT Text () Identity (Either Char Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser Text
finishEntityRef)
ParsecT Text () Identity (Either Char Text)
-> ParsecT Text () Identity (Either Char Text)
-> ParsecT Text () Identity (Either Char Text)
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Either Char Text
forall a b. a -> Either a b
Left (Char -> Either Char Text)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (Either Char Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text () Identity Char
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'&')
case Either Char Text
r of
Left Char
c -> do
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Char -> Bool
isValidChar Char
c)) (ParsecT Text () Identity () -> ParsecT Text () Identity ())
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity ()
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Text () Identity ())
-> String -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$
String
"Reference is not a valid character"
Text -> Parser Text
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Text
T.singleton Char
c)
Right Text
nm -> case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
nm Map Text Text
predefinedRefs of
Maybe Text
Nothing -> String -> Parser Text
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ String
"Unknown entity reference: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
nm
Just Text
t -> Text -> Parser Text
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
finishCharRef :: Parser Char
finishCharRef :: ParsecT Text () Identity Char
finishCharRef = Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'#' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Text () Identity Char
hexCharRef ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text () Identity Char
decCharRef)
where
decCharRef :: ParsecT Text () Identity Char
decCharRef = do
[Int]
ds <- ParsecT Text () Identity Int -> ParsecT Text () Identity [Int]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text () Identity Int
forall {u}. ParsecT Text u Identity Int
digit
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
';'
Int -> ParsecT Text () Identity Char
safeChr (Int -> ParsecT Text () Identity Char)
-> Int -> ParsecT Text () Identity Char
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a Int
b -> Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b) Int
0 [Int]
ds
where
digit :: ParsecT Text u Identity Int
digit = do
Char
d <- (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
Int -> ParsecT Text u Identity Int
forall a. a -> ParsecT Text u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
hexCharRef :: ParsecT Text () Identity Char
hexCharRef = do
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'x' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a.
ParsecT Text () Identity a
-> ParsecT Text () Identity a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'X'
[Int]
ds <- ParsecT Text () Identity Int -> ParsecT Text () Identity [Int]
forall a.
ParsecT Text () Identity a -> ParsecT Text () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text () Identity Int
forall {u}. ParsecT Text u Identity Int
digit
Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
';'
Int -> ParsecT Text () Identity Char
safeChr (Int -> ParsecT Text () Identity Char)
-> Int -> ParsecT Text () Identity Char
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a Int
b -> Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b) Int
0 [Int]
ds
where
digit :: ParsecT Text u Identity Int
digit = ParsecT Text u Identity Int
forall {u}. ParsecT Text u Identity Int
num ParsecT Text u Identity Int
-> ParsecT Text u Identity Int -> ParsecT Text u Identity Int
forall a.
ParsecT Text u Identity a
-> ParsecT Text u Identity a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text u Identity Int
forall {u}. ParsecT Text u Identity Int
upper ParsecT Text u Identity Int
-> ParsecT Text u Identity Int -> ParsecT Text u Identity Int
forall a.
ParsecT Text u Identity a
-> ParsecT Text u Identity a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text u Identity Int
forall {u}. ParsecT Text u Identity Int
lower
num :: ParsecT Text u Identity Int
num = do
Char
d <- (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
Int -> ParsecT Text u Identity Int
forall a. a -> ParsecT Text u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
upper :: ParsecT Text u Identity Int
upper = do
Char
d <- (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.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
'F')
Int -> ParsecT Text u Identity Int
forall a. a -> ParsecT Text u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A')
lower :: ParsecT Text u Identity Int
lower = do
Char
d <- (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.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
'f')
Int -> ParsecT Text u Identity Int
forall a. a -> ParsecT Text u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a')
finishEntityRef :: Parser Text
finishEntityRef :: Parser Text
finishEntityRef = Parser Text
XML.name Parser Text -> ParsecT Text () Identity Char -> Parser Text
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
';'