{-# LANGUAGE RecordWildCards, PatternGuards #-}

module Text.HTML.TagSoup.Specification(parse) where

import Text.HTML.TagSoup.Implementation
import Data.Char (isAlpha, isAlphaNum, isDigit, toLower)

-- We make some generalisations:
-- <!name is a valid tag start closed by >
-- <?name is a valid tag start closed by ?>
-- </!name> is a valid closing tag
-- </?name> is a valid closing tag
-- <a "foo"> is a valid tag attibute in ! and ?, i.e missing an attribute name
-- We also don't do lowercase conversion
-- Entities are handled without a list of known entity names
-- We don't have RCData, CData or Escape modes (only effects dat and tagOpen)


data TypeTag = TypeNormal -- <foo
             | TypeXml    -- <?foo
             | TypeDecl   -- <!foo
             | TypeScript -- <script
               deriving TypeTag -> TypeTag -> Bool
(TypeTag -> TypeTag -> Bool)
-> (TypeTag -> TypeTag -> Bool) -> Eq TypeTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeTag -> TypeTag -> Bool
== :: TypeTag -> TypeTag -> Bool
$c/= :: TypeTag -> TypeTag -> Bool
/= :: TypeTag -> TypeTag -> Bool
Eq


-- 2.4.1 Common parser idioms
white :: Char -> Bool
white Char
x = Char
x Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
" \t\n\f\r"


-- 8.2.4 Tokenization

type Parser = S -> [Out]

parse :: String -> [Out]
parse :: [Char] -> [Out]
parse = Parser
dat Parser -> ([Char] -> S) -> [Char] -> [Out]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> S
state

-- 8.2.4.1 Data state
dat :: Parser
dat :: Parser
dat S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'&' -> Parser
charReference S
tl
    Char
'<' -> Parser
tagOpen S
tl
    Char
_ | Bool
eof -> []
    Char
_ -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl


-- 8.2.4.2 Character reference data state
charReference :: Parser
charReference S
s = Parser -> Bool -> Maybe Char -> Parser
charRef Parser
dat Bool
False Maybe Char
forall a. Maybe a
Nothing S
s


-- 8.2.4.3 Tag open state
tagOpen :: Parser
tagOpen S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
'!' -> Parser
markupDeclOpen S
tl
    Char
'/' -> Parser
closeTagOpen S
tl
    Char
_ | Char -> Bool
isAlpha Char
hd -> Out
Tag Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
tagName (if S -> Bool
isScript S
s then TypeTag
TypeScript else TypeTag
TypeNormal) S
tl
    Char
'>' -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"<>" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'<' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'>' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
'?' -> Parser
neilXmlTagOpen S
tl -- NEIL
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen  [Char]
"<" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'<' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s

isScript :: S -> Bool
isScript = [Char] -> S -> Bool
f [Char]
"script"
    where
        f :: [Char] -> S -> Bool
f (Char
c:[Char]
cs) S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = Char -> Char
toLower Char
hd Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
&& [Char] -> S -> Bool
f [Char]
cs S
tl
        f [] S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = Char -> Bool
white Char
hd Bool -> Bool -> Bool
|| Char
hd Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
hd Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>' Bool -> Bool -> Bool
|| Char
hd Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?' Bool -> Bool -> Bool
|| Bool
eof


-- seen "<?", emitted []
neilXmlTagOpen :: Parser
neilXmlTagOpen S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Char -> Bool
isAlpha Char
hd -> Out
Tag Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'?' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
tagName TypeTag
TypeXml S
tl
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"<?" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'<' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'?' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s

-- seen "?", expecting ">"
neilXmlTagClose :: Parser
neilXmlTagClose S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'>' -> Out
TagEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"?" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
beforeAttName TypeTag
TypeXml S
s


-- just seen ">" at the end, am given tl
neilTagEnd :: TypeTag -> Parser
neilTagEnd TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..}
    | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"?>" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
TagEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeScript = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ Out
TagEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
neilScriptBody S
s
    | Bool
otherwise = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ Out
TagEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s

-- Inside a <script> tag, only break on </script
neilScriptBody :: Parser
neilScriptBody o :: S
o@S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..}
    | Char
hd Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<', S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} <- S
tl
    , Char
hd Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/', S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} <- S
tl
    , S -> Bool
isScript S
s
    = Parser
dat S
o
    | Bool
eof = []
    | Bool
otherwise =  [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
neilScriptBody S
tl


-- 8.2.4.4 Close tag open state
-- Deviation: We ignore the if CDATA/RCDATA bits and tag matching
-- Deviation: On </> we output </> to the text
-- Deviation: </!name> is a closing tag, not a bogus comment
closeTagOpen :: Parser
closeTagOpen S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Char -> Bool
isAlpha Char
hd Bool -> Bool -> Bool
|| Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"?!" -> Out
TagShut Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
tagName TypeTag
TypeNormal S
tl
    Char
'>' -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"</>" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'<' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'/' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'>' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
_ | Bool
eof -> Char
'<' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'/' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"tag name" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
bogusComment S
s


-- 8.2.4.5 Tag name state
tagName :: TypeTag -> Parser
tagName TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | Char -> Bool
white Char
hd -> TypeTag -> Parser
beforeAttName TypeTag
typ S
tl
    Char
'/' -> TypeTag -> Parser
selfClosingStartTag TypeTag
typ S
tl
    Char
'>' -> TypeTag -> Parser
neilTagEnd TypeTag
typ S
tl
    Char
'?' | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml -> Parser
neilXmlTagClose S
tl
    Char
_ | Char -> Bool
isAlpha Char
hd -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
tagName TypeTag
typ S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant (if TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml then [Char]
"?>" else [Char]
">") Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
tagName TypeTag
typ S
tl


-- 8.2.4.6 Before attribute name state
beforeAttName :: TypeTag -> Parser
beforeAttName TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | Char -> Bool
white Char
hd -> TypeTag -> Parser
beforeAttName TypeTag
typ S
tl
    Char
'/' -> TypeTag -> Parser
selfClosingStartTag TypeTag
typ S
tl
    Char
'>' -> TypeTag -> Parser
neilTagEnd TypeTag
typ S
tl
    Char
'?' | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml -> Parser
neilXmlTagClose S
tl
    Char
_ | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
/= TypeTag
TypeNormal Bool -> Bool -> Bool
&& Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\'\"" -> TypeTag -> Parser
beforeAttValue TypeTag
typ S
s -- NEIL
    Char
_ | Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\"'<=" -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char
hd] Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
AttName Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attName TypeTag
typ S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant (if TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml then [Char]
"?>" else [Char]
">") Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Out
AttName Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attName TypeTag
typ S
tl


-- 8.2.4.7 Attribute name state
attName :: TypeTag -> Parser
attName TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | Char -> Bool
white Char
hd -> TypeTag -> Parser
afterAttName TypeTag
typ S
tl
    Char
'/' -> TypeTag -> Parser
selfClosingStartTag TypeTag
typ S
tl
    Char
'=' -> TypeTag -> Parser
beforeAttValue TypeTag
typ S
tl
    Char
'>' -> TypeTag -> Parser
neilTagEnd TypeTag
typ S
tl
    Char
'?' | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml -> Parser
neilXmlTagClose S
tl
    Char
_ | Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\"'<" -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char
hd] Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& [Out]
def
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant (if TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml then [Char]
"?>" else [Char]
">") Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> [Out]
def
    where def :: [Out]
def = Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attName TypeTag
typ S
tl


-- 8.2.4.8 After attribute name state
afterAttName :: TypeTag -> Parser
afterAttName TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | Char -> Bool
white Char
hd -> TypeTag -> Parser
afterAttName TypeTag
typ S
tl
    Char
'/' -> TypeTag -> Parser
selfClosingStartTag TypeTag
typ S
tl
    Char
'=' -> TypeTag -> Parser
beforeAttValue TypeTag
typ S
tl
    Char
'>' -> TypeTag -> Parser
neilTagEnd TypeTag
typ S
tl
    Char
'?' | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml -> Parser
neilXmlTagClose S
tl
    Char
_ | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
/= TypeTag
TypeNormal Bool -> Bool -> Bool
&& Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\"'" -> Out
AttVal Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
beforeAttValue TypeTag
typ S
s -- NEIL
    Char
_ | Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\"'<" -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char
hd] Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& [Out]
def
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant (if TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml then [Char]
"?>" else [Char]
">") Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> [Out]
def
    where def :: [Out]
def = Out
AttName Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attName TypeTag
typ S
tl

-- 8.2.4.9 Before attribute value state
beforeAttValue :: TypeTag -> Parser
beforeAttValue TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | Char -> Bool
white Char
hd -> TypeTag -> Parser
beforeAttValue TypeTag
typ S
tl
    Char
'\"' -> Out
AttVal Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attValueDQuoted TypeTag
typ S
tl
    Char
'&' -> Out
AttVal Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attValueUnquoted TypeTag
typ S
s
    Char
'\'' -> Out
AttVal Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attValueSQuoted TypeTag
typ S
tl
    Char
'>' -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"=" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
neilTagEnd TypeTag
typ S
tl
    Char
'?' | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml -> Parser
neilXmlTagClose S
tl
    Char
_ | Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"<=" -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char
hd] Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& [Out]
def
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant (if TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml then [Char]
"?>" else [Char]
">") Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> [Out]
def
    where def :: [Out]
def = Out
AttVal Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attValueUnquoted TypeTag
typ S
tl


-- 8.2.4.10 Attribute value (double-quoted) state
attValueDQuoted :: TypeTag -> Parser
attValueDQuoted TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'\"' -> TypeTag -> Parser
afterAttValueQuoted TypeTag
typ S
tl
    Char
'&' -> Parser -> Maybe Char -> Parser
charRefAttValue (TypeTag -> Parser
attValueDQuoted TypeTag
typ) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\"') S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"\"" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attValueDQuoted TypeTag
typ S
tl


-- 8.2.4.11 Attribute value (single-quoted) state
attValueSQuoted :: TypeTag -> Parser
attValueSQuoted TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'\'' -> TypeTag -> Parser
afterAttValueQuoted TypeTag
typ S
tl
    Char
'&' -> Parser -> Maybe Char -> Parser
charRefAttValue (TypeTag -> Parser
attValueSQuoted TypeTag
typ) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\'') S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"\'" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attValueSQuoted TypeTag
typ S
tl


-- 8.2.4.12 Attribute value (unquoted) state
attValueUnquoted :: TypeTag -> Parser
attValueUnquoted TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | Char -> Bool
white Char
hd -> TypeTag -> Parser
beforeAttName TypeTag
typ S
tl
    Char
'&' -> Parser -> Maybe Char -> Parser
charRefAttValue (TypeTag -> Parser
attValueUnquoted TypeTag
typ) Maybe Char
forall a. Maybe a
Nothing S
tl
    Char
'>' -> TypeTag -> Parser
neilTagEnd TypeTag
typ S
tl
    Char
'?' | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml -> Parser
neilXmlTagClose S
tl
    Char
_ | Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\"'<=" -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char
hd] Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& [Out]
def
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant (if TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml then [Char]
"?>" else [Char]
">") Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> [Out]
def
    where def :: [Out]
def = Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
attValueUnquoted TypeTag
typ S
tl


-- 8.2.4.13 Character reference in attribute value state
charRefAttValue :: Parser -> Maybe Char -> Parser
charRefAttValue :: Parser -> Maybe Char -> Parser
charRefAttValue Parser
resume Maybe Char
c S
s = Parser -> Bool -> Maybe Char -> Parser
charRef Parser
resume Bool
True Maybe Char
c S
s


-- 8.2.4.14 After attribute value (quoted) state
afterAttValueQuoted :: TypeTag -> Parser
afterAttValueQuoted TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | Char -> Bool
white Char
hd -> TypeTag -> Parser
beforeAttName TypeTag
typ S
tl
    Char
'/' -> TypeTag -> Parser
selfClosingStartTag TypeTag
typ S
tl
    Char
'>' -> TypeTag -> Parser
neilTagEnd TypeTag
typ S
tl
    Char
'?' | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml -> Parser
neilXmlTagClose S
tl
    Char
_ | Bool
eof -> Parser
dat S
s
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char
hd] Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
beforeAttName TypeTag
typ S
s


-- 8.2.4.15 Self-closing start tag state
selfClosingStartTag :: TypeTag -> Parser
selfClosingStartTag TypeTag
typ S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | TypeTag
typ TypeTag -> TypeTag -> Bool
forall a. Eq a => a -> a -> Bool
== TypeTag
TypeXml -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"/" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
beforeAttName TypeTag
typ S
s
    Char
'>' -> Out
TagEndClose Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
">" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"/" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
beforeAttName TypeTag
typ S
s


-- 8.2.4.16 Bogus comment state
bogusComment :: Parser
bogusComment S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = Out
Comment Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
bogusComment1 S
s
bogusComment1 :: Parser
bogusComment1 S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'>' -> Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
_ | Bool
eof -> Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
bogusComment1 S
tl


-- 8.2.4.17 Markup declaration open state
markupDeclOpen :: Parser
markupDeclOpen S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Just S
s <- [Char] -> Maybe S
next [Char]
"--" -> Out
Comment Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
commentStart S
s
    Char
_ | Char -> Bool
isAlpha Char
hd -> Out
Tag Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'!' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& TypeTag -> Parser
tagName TypeTag
TypeDecl S
tl -- NEIL
    Char
_ | Just S
s <- [Char] -> Maybe S
next [Char]
"[CDATA[" -> Parser
cdataSection S
s
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"tag name" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
bogusComment S
s


-- 8.2.4.18 Comment start state
commentStart :: Parser
commentStart S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'-' -> Parser
commentStartDash S
tl
    Char
'>' -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"<!-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
comment S
tl


-- 8.2.4.19 Comment start dash state
commentStartDash :: Parser
commentStartDash S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'-' -> Parser
commentEnd S
tl
    Char
'>' -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"<!--->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
comment S
tl


-- 8.2.4.20 Comment state
comment :: Parser
comment S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'-' -> Parser
commentEndDash S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
comment S
tl


-- 8.2.4.21 Comment end dash state
commentEndDash :: Parser
commentEndDash S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'-' -> Parser
commentEnd S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
comment S
tl


-- 8.2.4.22 Comment end state
commentEnd :: Parser
commentEnd S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'>' -> Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
'-' -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
commentEnd S
tl
    Char
_ | Char -> Bool
white Char
hd -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"--" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
commentEndSpace S
tl
    Char
'!' -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"!" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
commentEndBang S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"--" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
comment S
tl


-- 8.2.4.23 Comment end bang state
commentEndBang :: Parser
commentEndBang S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'>' -> Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
'-' -> Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'!' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
commentEndDash S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'-' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'!' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
comment S
tl


-- 8.2.4.24 Comment end space state
commentEndSpace :: Parser
commentEndSpace S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
'>' -> Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
tl
    Char
'-' -> Parser
commentEndDash S
tl
    Char
_ | Char -> Bool
white Char
hd -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
commentEndSpace S
tl
    Char
_ | Bool
eof -> [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
"-->" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Out
CommentEnd Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
dat S
s
    Char
_ -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
comment S
tl


-- 8.2.4.38 CDATA section state
cdataSection :: Parser
cdataSection S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = [Out] -> [Out]
pos ([Out] -> [Out]) -> [Out] -> [Out]
forall a b. (a -> b) -> a -> b
$ case Char
hd of
    Char
_ | Just S
s <- [Char] -> Maybe S
next [Char]
"]]>" -> Parser
dat S
s
    Char
_ | Bool
eof -> Parser
dat S
s
    Char
_ | Bool
otherwise -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
cdataSection S
tl


-- 8.2.4.39 Tokenizing character references
-- Change from spec: this is reponsible for writing '&' if nothing is to be written
charRef :: Parser -> Bool -> Maybe Char -> S -> [Out]
charRef :: Parser -> Bool -> Maybe Char -> Parser
charRef Parser
resume Bool
att Maybe Char
end S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Bool
eof Bool -> Bool -> Bool
|| Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\t\n\f <&" Bool -> Bool -> Bool
|| Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
hd) Maybe Char
end -> Char
'&' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
resume S
s
    Char
'#' -> Parser -> S -> Parser
charRefNum Parser
resume S
s S
tl
    Char
_ -> Parser -> Bool -> Parser
charRefAlpha Parser
resume Bool
att S
s

charRefNum :: Parser -> S -> Parser
charRefNum Parser
resume S
o S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Char
hd Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"xX" -> Parser -> S -> Bool -> Parser
charRefNum2 Parser
resume S
o Bool
True S
tl
    Char
_ -> Parser -> S -> Bool -> Parser
charRefNum2 Parser
resume S
o Bool
False S
s

charRefNum2 :: Parser -> S -> Bool -> Parser
charRefNum2 Parser
resume S
o Bool
hex S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Bool -> Char -> Bool
hexChar Bool
hex Char
hd -> (if Bool
hex then Out
EntityHex else Out
EntityNum) Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser -> Bool -> Parser
charRefNum3 Parser
resume Bool
hex S
tl
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"&" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'&' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
resume S
o

charRefNum3 :: Parser -> Bool -> Parser
charRefNum3 Parser
resume Bool
hex S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Bool -> Char -> Bool
hexChar Bool
hex Char
hd -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser -> Bool -> Parser
charRefNum3 Parser
resume Bool
hex S
tl
    Char
';' -> Bool -> Out
EntityEnd Bool
True Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
resume S
tl
    Char
_ -> Bool -> Out
EntityEnd Bool
False Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
";" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
resume S
s

charRefAlpha :: Parser -> Bool -> Parser
charRefAlpha Parser
resume Bool
att S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Char -> Bool
isAlpha Char
hd -> Out
EntityName Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser -> Bool -> Parser
charRefAlpha2 Parser
resume Bool
att S
tl
    Char
_ -> [Char] -> Out
forall {a}. Show a => a -> Out
errSeen [Char]
"&" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Char
'&' Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
resume S
s

charRefAlpha2 :: Parser -> Bool -> Parser
charRefAlpha2 Parser
resume Bool
att S{Bool
Char
S
[Char] -> Maybe S
[Out] -> [Out]
eof :: S -> Bool
hd :: S -> Char
next :: S -> [Char] -> Maybe S
pos :: S -> [Out] -> [Out]
s :: S -> S
tl :: S -> S
s :: S
tl :: S
hd :: Char
eof :: Bool
next :: [Char] -> Maybe S
pos :: [Out] -> [Out]
..} = case Char
hd of
    Char
_ | Char -> Bool
alphaChar Char
hd -> Char
hd Char -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser -> Bool -> Parser
charRefAlpha2 Parser
resume Bool
att S
tl
    Char
';' -> Bool -> Out
EntityEnd Bool
True Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
resume S
tl
    Char
_ | Bool
att -> Bool -> Out
EntityEnd Bool
False Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
resume S
s
    Char
_ -> Bool -> Out
EntityEnd Bool
False Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& [Char] -> Out
forall {a}. Show a => a -> Out
errWant [Char]
";" Out -> [Out] -> [Out]
forall a. Outable a => a -> [Out] -> [Out]
& Parser
resume S
s


alphaChar :: Char -> Bool
alphaChar Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
":-_"

hexChar :: Bool -> Char -> Bool
hexChar Bool
False Char
x = Char -> Bool
isDigit Char
x
hexChar Bool
True  Char
x = Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f') Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F')