{-# 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


------------------------------------------------------------------------------
-- | HTML version of document fragment parsing rule  It differs only in that
-- it parses the HTML version of 'content' and returns an 'HtmlDocument'.
docFragment :: Encoding -> Parser Document
docFragment :: Encoding -> Parser Document
docFragment e :: Encoding
e = do
    (dt :: Maybe DocType
dt, nodes1 :: [Node]
nodes1)      <- Parser (Maybe DocType, [Node])
prolog
    (nodes2 :: [Node]
nodes2, Matched) <- Maybe Text -> Parser ([Node], ElemResult)
content Maybe Text
forall a. Maybe a
Nothing
    Document -> Parser Document
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)


------------------------------------------------------------------------------
-- Parsing code                                                             --
------------------------------------------------------------------------------

{-
    The following are the differences between this code and the straight XML
    parsing code.

    1. HTML void tags (area, base, etc.) are always treated as empty tags,
       regardless of whether they have the empty-tag slash.

    2. HTML raw text tags (script and style) are parsed as straight text
       with neither markup nor references, except that they end at the first
       syntactically valid matching end tag.

    3. End tags need only match their corresponding start tags in a case
       insensitive comparison.  In case they are different, the start tag is
       used for the element tag name.

    4. Hexadecimal char references may use &#X...; (capital X)  -- DONE

    5. Attribute names are allowed to consist of any text except for control
       characters, space, '\"', '\'', '>', '/', or '='.

    6. Empty attribute syntax is allowed (an attribute not followed by an eq).
       In this case, the attribute value is considered to be the empty string.

    7. Quoted attribute syntax is relaxed to allow any character except for
       the matching quote.  References are allowed.

    8. Attribute values may be unquoted.  In this case, the attribute value
       may not contain space, single or double quotes, '=', '<', '>', or '`',
       and may not be the empty string.  It can still contain references.

    9. There are many more character references available.

    10. Only "ambiguous" ampersands are prohibited in character data.  This
        means ampersands that parse like character or entity references.

    11. Omittable end tags are inserted automatically.

    12. DOCTYPE tags matched with case insensitive keywords.
-}


------------------------------------------------------------------------------
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (DocType
dt, [Maybe Node]
nodes2)
    case Maybe (DocType, [Maybe Node])
rest of
        Nothing           -> (Maybe DocType, [Node]) -> Parser (Maybe DocType, [Node])
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 (dt :: DocType
dt, nodes2 :: [Maybe Node]
nodes2) -> (Maybe DocType, [Node]) -> Parser (Maybe DocType, [Node])
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))


------------------------------------------------------------------------------
-- | Internal subset is parsed, but ignored since we don't have data types to
-- store it.
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
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
/= "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 (m :: * -> *) a. MonadFail m => String -> m a
fail "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 '>'
    DocType -> Parser DocType
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 "system" -> Parser ExternalID
systemID
        Just "public" -> Parser ExternalID
publicID
        Just _        -> String -> Parser ExternalID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected SYSTEM or PUBLIC"
        Nothing       -> ExternalID -> Parser ExternalID
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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> ExternalID
Public Text
pid Text
sid)


------------------------------------------------------------------------------
-- | When parsing an element, three things can happen (besides failure):
--
-- (1) The end tag matches the start tag.  This is a Matched.
--
-- (2) The end tag does not match, but the element has an end tag that can be
-- omitted when there is no more content in its parent.  This is an
-- ImplicitLast.  In this case, we need to remember the tag name of the
-- end tag that we did find, so as to match it later.
--
-- (3) A start tag is found such that it implicitly ends the current element.
-- This is an ImplicitNext.  In this case, we parse and remember the
-- entire element that comes next, so that it can be inserted after the
-- element being parsed.
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 t :: Text
t tbase :: Text
tbase a :: [(Text, Text)]
a b :: Bool
b = do
    if Bool
b then (Node, ElemResult) -> Parser (Node, ElemResult)
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  "<"  (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 (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 (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 modifier :: Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult)
modifier = do
        (c :: [Node]
c,r1 :: ElemResult
r1) <- Maybe Text -> Parser ([Node], ElemResult)
content (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
tbase)
        case ElemResult
r1 of
            Matched -> do
                Maybe ElemResult
r2 <- Parser ElemResult -> ParsecT Text () Identity (Maybe ElemResult)
modifier (Text -> Parser ElemResult
endTag Text
t)
                case Maybe ElemResult
r2 of
                    Nothing -> (Node, ElemResult) -> Parser (Node, ElemResult)
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 rr :: ElemResult
rr -> (Node, ElemResult) -> Parser (Node, ElemResult)
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 tag :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> [Node] -> Node
Element Text
t [(Text, Text)]
a [Node]
c, ElemResult
Matched)
            end :: ElemResult
end -> do
                (Node, ElemResult) -> Parser (Node, ElemResult)
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 '<' ParsecT Text () Identity Char -> Parser Text -> Parser Text
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
$ Text -> Text -> (Text, Text)
T.breakOnEnd ":" Text
t
    [(Text, Text)]
a <- ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity [(Text, Text)]
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 (m :: * -> *) a. MonadFail m => String -> m a
fail "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 (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 '/')
    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 '>'
    (Text, Text, [(Text, Text)], Bool)
-> Parser (Text, Text, [(Text, Text)], Bool)
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 :: [(a, b)]
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 (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 c :: Char
c | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['\0',' ','"','\'','>','/','='] = Bool
False
                     | Char -> Bool
isControlChar Char
c       = Bool
False
                     | Bool
otherwise             = Bool
True


------------------------------------------------------------------------------
-- | From 8.2.2.3 of the HTML 5 spec, omitting the very high control
-- characters because they are unlikely to occur and I got tired of typing.
isControlChar :: Char -> Bool
isControlChar :: Char -> Bool
isControlChar c :: Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x007F' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x009F' = Bool
True
                | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFDD0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFDEF' = Bool
True
                | Bool
otherwise                      = Bool
False


------------------------------------------------------------------------------
quotedAttrValue :: Parser Text
quotedAttrValue :: Parser Text
quotedAttrValue = Parser Text
singleQuoted Parser Text -> Parser Text -> Parser Text
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 '\'' ParsecT Text () Identity Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Text
forall (t :: * -> *). Foldable t => t Char -> Parser Text
refTill ['&','\''] Parser Text -> ParsecT Text () Identity Char -> Parser Text
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 '\''
    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 '"'  ParsecT Text () Identity Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Text
forall (t :: * -> *). Foldable t => t Char -> Parser Text
refTill ['&','"']  Parser Text -> ParsecT Text () Identity Char -> Parser Text
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 '"'
    refTill :: t Char -> Parser Text
refTill end :: 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 (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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
end)) Parser Text -> Parser Text -> Parser Text
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 [' ','"','\'','=','<','>','&','`']
  where
    refTill :: t Char -> Parser Text
refTill end :: 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 (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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
end)) Parser Text -> Parser Text -> Parser Text
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 (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 '='
        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 (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
n,) Maybe Text
v


------------------------------------------------------------------------------
endTag :: Text -> Parser ElemResult
endTag :: Text -> Parser ElemResult
endTag s :: Text
s = do
    Text
_ <- Text -> Parser 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
$ Text -> Text -> (Text, Text)
T.breakOnEnd ":" 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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> ElemResult
ImplicitLast Text
t)
                else String -> Parser ElemResult
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ElemResult) -> String -> Parser ElemResult
forall a b. (a -> b) -> a -> b
$ "mismatched tags: </" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
                            "> found inside <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "> 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 ">"
    ElemResult -> Parser ElemResult
forall (m :: * -> *) a. Monad m => a -> m a
return ElemResult
r


------------------------------------------------------------------------------
content :: Maybe Text -> Parser ([Node], ElemResult)
content :: Maybe Text -> Parser ([Node], ElemResult)
content parent :: Maybe Text
parent = do
    (ns :: [Maybe Node]
ns, end :: ElemResult
end) <- ParsecT Text () Identity ([Maybe Node], ElemResult)
readText
    ([Node], ElemResult) -> Parser ([Node], ElemResult)
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
            Nothing      -> ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Node
s], ElemResult
Matched)
            Just (tt :: [Maybe Node]
tt, m :: ElemResult
m) -> ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
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
        (n :: [Maybe Node]
n,end :: 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 (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 (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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text () Identity ([Maybe Node], ElemResult)
doElement
        case ElemResult
end of
            Matched -> do
                (ns :: [Maybe Node]
ns, end' :: ElemResult
end') <- ParsecT Text () Identity ([Maybe Node], ElemResult)
readText
                ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
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')
            _ -> do
                ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Node]
n, ElemResult
end)

    doElement :: ParsecT Text () Identity ([Maybe Node], ElemResult)
doElement = do
        (t :: Text
t,tb :: Text
tb, a :: [(Text, Text)]
a,b :: 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 t :: Text
t tb :: Text
tb a :: [(Text, Text)]
a b :: 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 (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
                (n :: Node
n,end :: 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 t' :: Text
t' tb' :: Text
tb' a' :: [(Text, Text)]
a' b' :: Bool
b' -> do
                        (ns :: [Maybe Node]
ns,end' :: 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 (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')
                    _ -> ([Maybe Node], ElemResult)
-> ParsecT Text () Identity ([Maybe Node], ElemResult)
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 _     Nothing       = Bool
False
    breaksTag child :: Text
child (Just tag :: 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
        Nothing -> Bool
False
        Just s :: 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 s :: Text
s : TextNode t :: Text
t : ns :: [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 (n :: Node
n:ns :: [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 '&'
    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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return '&')
    case Either Char Text
r of
        Left c :: 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 (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Text () Identity ())
-> String -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$
                "Reference is not a valid character"
            Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Text
T.singleton Char
c)
        Right nm :: 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
            Nothing -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ "Unknown entity reference: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
nm
            Just t :: Text
t  -> Text -> Parser Text
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 '#' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Text () Identity Char
forall u. ParsecT Text u Identity Char
hexCharRef ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text () Identity Char
forall u. ParsecT Text u Identity Char
decCharRef)
  where
    decCharRef :: ParsecT Text u Identity Char
decCharRef = do
        [Int]
ds <- ParsecT Text u Identity Int -> ParsecT Text u Identity [Int]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text u Identity Int
forall u. ParsecT Text u Identity Int
digit
        Char
_ <- Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char ';'
        let c :: Char
c = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a :: Int
a b :: Int
b -> 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) 0 [Int]
ds
        Char -> ParsecT Text u Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
      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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9')
            Int -> ParsecT Text u Identity Int
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 '0')
    hexCharRef :: ParsecT Text u Identity Char
hexCharRef = do
        Char
_ <- Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char 'x' ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char 'X'
        [Int]
ds <- ParsecT Text u Identity Int -> ParsecT Text u Identity [Int]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text u Identity Int
forall u. ParsecT Text u Identity Int
digit
        Char
_ <- Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char ';'
        let c :: Char
c = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a :: Int
a b :: Int
b -> 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) 0 [Int]
ds
        Char -> ParsecT Text u Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
      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 (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 (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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9')
            Int -> ParsecT Text u Identity Int
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 '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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'F')
            Int -> ParsecT Text u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (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 '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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'f')
            Int -> ParsecT Text u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (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 'a')


------------------------------------------------------------------------------
finishEntityRef :: Parser Text
finishEntityRef :: Parser Text
finishEntityRef = Parser Text
XML.name Parser Text -> ParsecT Text () Identity Char -> Parser Text
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 ';'