{-# LANGUAGE OverloadedStrings #-}
module Commonmark.Tag
  ( htmlTag
  , htmlOpenTag
  , htmlClosingTag
  , htmlAttributeName
  , htmlAttributeValue
  , htmlDoubleQuotedAttributeValue
  , Enders
  , defaultEnders )
where
import           Commonmark.Tokens
import           Commonmark.TokParsers
import           Control.Monad     (liftM2, guard)
import           Control.Monad.Trans.State.Strict
import           Control.Monad.Trans.Class (lift)
import           Unicode.Char (isAscii, isAlpha)
import qualified Data.Text         as T
import           Text.Parsec       hiding (State)

data Enders =
  Enders
  { Enders -> Maybe SourcePos
scannedForCDATA                 :: !(Maybe SourcePos)
  , Enders -> Maybe SourcePos
scannedForProcessingInstruction :: !(Maybe SourcePos)
  , Enders -> Maybe SourcePos
scannedForDeclaration           :: !(Maybe SourcePos)
  } deriving Int -> Enders -> ShowS
[Enders] -> ShowS
Enders -> String
(Int -> Enders -> ShowS)
-> (Enders -> String) -> ([Enders] -> ShowS) -> Show Enders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Enders -> ShowS
showsPrec :: Int -> Enders -> ShowS
$cshow :: Enders -> String
show :: Enders -> String
$cshowList :: [Enders] -> ShowS
showList :: [Enders] -> ShowS
Show

defaultEnders :: Enders
defaultEnders :: Enders
defaultEnders = Enders { scannedForCDATA :: Maybe SourcePos
scannedForCDATA = Maybe SourcePos
forall a. Maybe a
Nothing
                       , scannedForProcessingInstruction :: Maybe SourcePos
scannedForProcessingInstruction = Maybe SourcePos
forall a. Maybe a
Nothing
                       , scannedForDeclaration :: Maybe SourcePos
scannedForDeclaration = Maybe SourcePos
forall a. Maybe a
Nothing }

(.&&.) :: (a -> Bool) -> (a -> Bool) -> (a -> Bool)
.&&. :: forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
(.&&.) = (Bool -> Bool -> Bool) -> (a -> Bool) -> (a -> Bool) -> a -> Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&)

-- A tag name consists of an ASCII letter followed by zero or more ASCII
-- letters, digits, or hyphens (-).
htmlTagName :: Monad m => ParsecT [Tok] s m [Tok]
htmlTagName :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlTagName = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  let isTagText :: Text -> Bool
isTagText = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii
  let startsWithLetter :: Text -> Bool
startsWithLetter Text
t' = Bool -> Bool
not (Text -> Bool
T.null Text
t') Bool -> Bool -> Bool
&& Char -> Bool
isAlpha (HasCallStack => Text -> Char
Text -> Char
T.head Text
t')
  Tok
t <- (Text -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Bool
isTagText (Text -> Bool) -> (Text -> Bool) -> Text -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
.&&. Text -> Bool
startsWithLetter)
  [Tok]
rest <- ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord Text -> Bool
isTagText)
  [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
rest)

-- An attribute name consists of an ASCII letter, _, or :, followed by
-- zero or more ASCII letters, digits, _, ., :, or -. (Note: This is
-- the XML specification restricted to ASCII. HTML5 is laxer.)
htmlAttributeName :: Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeName :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeName = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  let isTagText :: Text -> Bool
isTagText Text
t' = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
t'
  let startsWithLetter :: Text -> Bool
startsWithLetter Text
t' = Bool -> Bool
not (Text -> Bool
T.null Text
t') Bool -> Bool -> Bool
&& Char -> Bool
isAlpha (HasCallStack => Text -> Char
Text -> Char
T.head Text
t')
  Tok
t <- (Text -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Bool
startsWithLetter (Text -> Bool) -> (Text -> Bool) -> Text -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
.&&. Text -> Bool
isTagText) ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'_' ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':'
  [Tok]
rest <- ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord Text -> Bool
isTagText
             ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'_'
             ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
             ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.'
             ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':'
  [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
rest)

-- An attribute value specification consists of optional whitespace,
-- a = character, optional whitespace, and an attribute value.
htmlAttributeValueSpec :: Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValueSpec :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValueSpec = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  [Tok]
sps1 <- [Tok] -> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Tok
eq <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'='
  [Tok]
sps2 <- [Tok] -> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  [Tok]
val <- ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValue
  [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s m [Tok])
-> [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok]
sps1 [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok
eq] [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
sps2 [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
val

-- An attribute value consists of an unquoted attribute value,
-- a single-quoted attribute value, or a double-quoted attribute value.
htmlAttributeValue :: Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValue :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValue =
  ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlUnquotedAttributeValue ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlSingleQuotedAttributeValue ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlDoubleQuotedAttributeValue

-- An attribute consists of whitespace, an attribute name, and an optional
-- attribute value specification.
htmlAttribute :: Monad m => ParsecT [Tok] s m [Tok]
htmlAttribute :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttribute = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  [Tok]
sps <- ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  [Tok]
n <- ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeName
  [Tok]
val <- [Tok] -> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValueSpec
  [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s m [Tok])
-> [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok]
sps [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
n [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
val

-- An unquoted attribute value is a nonempty string of characters not
-- including spaces, ", ', =, <, >, or `.
htmlUnquotedAttributeValue :: Monad m => ParsecT [Tok] s m [Tok]
htmlUnquotedAttributeValue :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlUnquotedAttributeValue =
  ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ [TokType] -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [TokType
Spaces, TokType
LineEnd, Char -> TokType
Symbol Char
'<', Char -> TokType
Symbol Char
'>',
                      Char -> TokType
Symbol Char
'=', Char -> TokType
Symbol Char
'`', Char -> TokType
Symbol Char
'\'', Char -> TokType
Symbol Char
'"']

-- A single-quoted attribute value consists of ', zero or more characters
-- not including ', and a final '.
htmlSingleQuotedAttributeValue :: Monad m => ParsecT [Tok] s m [Tok]
htmlSingleQuotedAttributeValue :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlSingleQuotedAttributeValue = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  Tok
op <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\''
  [Tok]
contents <- ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'\'')))
  Tok
cl <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\''
  [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s m [Tok])
-> [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ Tok
op Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [Tok]
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok
cl]

-- A double-quoted attribute value consists of ", zero or more characters
-- not including ", and a final ".
htmlDoubleQuotedAttributeValue :: Monad m => ParsecT [Tok] s m [Tok]
htmlDoubleQuotedAttributeValue :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlDoubleQuotedAttributeValue = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  Tok
op <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'"'
  [Tok]
contents <- ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'"')))
  Tok
cl <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'"'
  [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s m [Tok])
-> [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ Tok
op Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [Tok]
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok
cl]

-- | An open tag consists of a @<@ character, a tag name, zero or more
-- attributes, optional whitespace, an optional @/@ character, and a
-- @>@ character.  This parses assumes that the opening @<@ has already
-- been parsed.
htmlOpenTag :: Monad m => ParsecT [Tok] s m [Tok]
htmlOpenTag :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlOpenTag = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  -- assume < has already been parsed
  [Tok]
n <- ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlTagName
  [Tok]
attrs <- [[Tok]] -> [Tok]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Tok]] -> [Tok])
-> ParsecT [Tok] s m [[Tok]] -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [[Tok]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttribute
  [Tok]
sps <- [Tok] -> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  [Tok]
sl <- [Tok] -> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[]) (Tok -> [Tok]) -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
  Tok
cl <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
  [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s m [Tok])
-> [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok]
n [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
attrs [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
sps [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
sl [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok
cl]

-- | A closing tag consists of the string @</@, a tag name, optional
-- whitespace, and the character @>@.  This parser assumes that the
-- opening @<@ has already been parsed.
htmlClosingTag :: Monad m => ParsecT [Tok] s m [Tok]
htmlClosingTag :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlClosingTag = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  -- assume < has already been parsed
  Tok
op <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
  [Tok]
n <- ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlTagName
  [Tok]
sps <- [Tok] -> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Tok
cl <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
  [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s m [Tok])
-> [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ Tok
op Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [Tok]
n [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
sps [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok
cl]

-- An HTML comment consists of `<!-->`, `<!--->`, or  `<!--`, a string of
-- characters not including the string `-->`, and `-->`.
-- (See the HTML5 spec.)
htmlComment :: Monad m => ParsecT [Tok] s m [Tok]
htmlComment :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlComment = ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ do
  -- assume < has already been parsed
  [Tok]
op <- [ParsecT [Tok] s m Tok] -> ParsecT [Tok] s m [Tok]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
                 , Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
                 , Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' ]
  let getContent :: ParsecT [Tok] u m [Tok]
getContent =
            ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([ParsecT [Tok] u m Tok] -> ParsecT [Tok] u m [Tok]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-', Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-', Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>' ])
        ParsecT [Tok] u m [Tok]
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
(++) ([Tok] -> [Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m ([Tok] -> [Tok])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Tok -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'-')))
                      ParsecT [Tok] u m ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall a b.
ParsecT [Tok] u m (a -> b)
-> ParsecT [Tok] u m a -> ParsecT [Tok] u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [Tok] u m [Tok]
getContent)
        ParsecT [Tok] u m [Tok]
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((:) (Tok -> [Tok] -> [Tok])
-> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m ([Tok] -> [Tok])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' ParsecT [Tok] u m ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall a b.
ParsecT [Tok] u m (a -> b)
-> ParsecT [Tok] u m a -> ParsecT [Tok] u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [Tok] u m [Tok]
getContent)
  ([Tok]
op [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++) ([Tok] -> [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (   ((Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[]) (Tok -> [Tok]) -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>')
    ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([ParsecT [Tok] s m Tok] -> ParsecT [Tok] s m [Tok]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-', Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>' ])
    ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m [Tok]
forall {u}. ParsecT [Tok] u m [Tok]
getContent
    )

-- A processing instruction consists of the string <?, a string of
-- characters not including the string ?>, and the string ?>.
htmlProcessingInstruction :: Monad m
                          => ParsecT [Tok] s (StateT Enders m) [Tok]
htmlProcessingInstruction :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlProcessingInstruction = ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s (StateT Enders m) [Tok]
 -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ do
  -- assume < has already been parsed
  let questionmark :: ParsecT [Tok] s (StateT Enders m) Tok
questionmark = Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'?'
  Tok
op <- ParsecT [Tok] s (StateT Enders m) Tok
forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
questionmark
  SourcePos
pos <- ParsecT [Tok] s (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Maybe SourcePos
alreadyScanned <- StateT Enders m (Maybe SourcePos)
-> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos)
forall (m :: * -> *) a. Monad m => m a -> ParsecT [Tok] s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Enders m (Maybe SourcePos)
 -> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos))
-> StateT Enders m (Maybe SourcePos)
-> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos)
forall a b. (a -> b) -> a -> b
$ (Enders -> Maybe SourcePos) -> StateT Enders m (Maybe SourcePos)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Enders -> Maybe SourcePos
scannedForProcessingInstruction
  Bool -> ParsecT [Tok] s (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] s (StateT Enders m) ())
-> Bool -> ParsecT [Tok] s (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> (SourcePos -> Bool) -> Maybe SourcePos -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
pos) Maybe SourcePos
alreadyScanned
  [Tok]
contents <- ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] s (StateT Enders m) Tok
 -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'?'))
                 ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s (StateT Enders m) Tok
forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
questionmark ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) Tok
forall a b.
ParsecT [Tok] s (StateT Enders m) a
-> ParsecT [Tok] s (StateT Enders m) b
-> ParsecT [Tok] s (StateT Enders m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                           ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'))
  SourcePos
pos' <- ParsecT [Tok] s (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ()
forall (m :: * -> *) a. Monad m => m a -> ParsecT [Tok] s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ())
-> StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ (Enders -> Enders) -> StateT Enders m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Enders -> Enders) -> StateT Enders m ())
-> (Enders -> Enders) -> StateT Enders m ()
forall a b. (a -> b) -> a -> b
$ \Enders
st -> Enders
st{ scannedForProcessingInstruction = Just pos' }
  [Tok]
cl <- [ParsecT [Tok] s (StateT Enders m) Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ ParsecT [Tok] s (StateT Enders m) Tok
forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
questionmark
                 , Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>' ]
  [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a. a -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ Tok
op Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [Tok]
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
cl

-- A declaration consists of the string <!, a name consisting of one or
-- more uppercase ASCII letters, whitespace, a string of characters not
-- including the character >, and the character >.
htmlDeclaration :: Monad m => ParsecT [Tok] s (StateT Enders m) [Tok]
htmlDeclaration :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlDeclaration = ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s (StateT Enders m) [Tok]
 -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ do
  -- assume < has already been parsed
  Tok
op <- Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
  SourcePos
pos <- ParsecT [Tok] s (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Maybe SourcePos
alreadyScanned <- StateT Enders m (Maybe SourcePos)
-> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos)
forall (m :: * -> *) a. Monad m => m a -> ParsecT [Tok] s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Enders m (Maybe SourcePos)
 -> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos))
-> StateT Enders m (Maybe SourcePos)
-> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos)
forall a b. (a -> b) -> a -> b
$ (Enders -> Maybe SourcePos) -> StateT Enders m (Maybe SourcePos)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Enders -> Maybe SourcePos
scannedForDeclaration
  Bool -> ParsecT [Tok] s (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] s (StateT Enders m) ())
-> Bool -> ParsecT [Tok] s (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> (SourcePos -> Bool) -> Maybe SourcePos -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
pos) Maybe SourcePos
alreadyScanned
  let isDeclName :: Text -> Bool
isDeclName Text
t = Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (Char -> Bool
isAscii (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
.&&. Char -> Bool
isAlpha) Text
t
  Tok
name <- (Text -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord Text -> Bool
isDeclName
  [Tok]
ws <- ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  [Tok]
contents <- ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Tok -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'>')))
  SourcePos
pos' <- ParsecT [Tok] s (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ()
forall (m :: * -> *) a. Monad m => m a -> ParsecT [Tok] s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ())
-> StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ (Enders -> Enders) -> StateT Enders m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Enders -> Enders) -> StateT Enders m ())
-> (Enders -> Enders) -> StateT Enders m ()
forall a b. (a -> b) -> a -> b
$ \Enders
st -> Enders
st{ scannedForDeclaration = Just pos' }
  Tok
cl <- Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
  [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a. a -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ Tok
op Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: Tok
name Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [Tok]
ws [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok
cl]

-- A CDATA section consists of the string <![CDATA[, a string of characters
-- not including the string ]]>, and the string ]]>.
htmlCDATASection :: Monad m => ParsecT [Tok] s (StateT Enders m) [Tok]
htmlCDATASection :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlCDATASection = ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s (StateT Enders m) [Tok]
 -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ do
  -- assume < has already been parsed
  [Tok]
op <- [ParsecT [Tok] s (StateT Enders m) Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
                 , Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
                 , (Text -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"CDATA")
                 , Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'[' ]
  SourcePos
pos <- ParsecT [Tok] s (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Maybe SourcePos
alreadyScanned <- StateT Enders m (Maybe SourcePos)
-> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos)
forall (m :: * -> *) a. Monad m => m a -> ParsecT [Tok] s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Enders m (Maybe SourcePos)
 -> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos))
-> StateT Enders m (Maybe SourcePos)
-> ParsecT [Tok] s (StateT Enders m) (Maybe SourcePos)
forall a b. (a -> b) -> a -> b
$ (Enders -> Maybe SourcePos) -> StateT Enders m (Maybe SourcePos)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Enders -> Maybe SourcePos
scannedForCDATA
  Bool -> ParsecT [Tok] s (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] s (StateT Enders m) ())
-> Bool -> ParsecT [Tok] s (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> (SourcePos -> Bool) -> Maybe SourcePos -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
pos) Maybe SourcePos
alreadyScanned
  let ender :: ParsecT [Tok] u (StateT Enders m) [Tok]
ender = ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] u (StateT Enders m) [Tok]
 -> ParsecT [Tok] u (StateT Enders m) [Tok])
-> ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ [ParsecT [Tok] u (StateT Enders m) Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ Char -> ParsecT [Tok] u (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']'
                             , Char -> ParsecT [Tok] u (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']'
                             , Char -> ParsecT [Tok] u (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>' ]
  [Tok]
contents <- ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] s (StateT Enders m) Tok
 -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ do
                ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] s (StateT Enders m) [Tok]
forall {u}. ParsecT [Tok] u (StateT Enders m) [Tok]
ender
                ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
  SourcePos
pos' <- ParsecT [Tok] s (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ()
forall (m :: * -> *) a. Monad m => m a -> ParsecT [Tok] s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ())
-> StateT Enders m () -> ParsecT [Tok] s (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ (Enders -> Enders) -> StateT Enders m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Enders -> Enders) -> StateT Enders m ())
-> (Enders -> Enders) -> StateT Enders m ()
forall a b. (a -> b) -> a -> b
$ \Enders
st -> Enders
st{ scannedForCDATA = Just pos' }
  [Tok]
cl <- ParsecT [Tok] s (StateT Enders m) [Tok]
forall {u}. ParsecT [Tok] u (StateT Enders m) [Tok]
ender
  [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a. a -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok]
op [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
cl

-- An HTML tag consists of an open tag, a closing tag, an HTML comment,
-- a processing instruction, a declaration, or a CDATA section.
-- Assumes @<@ has already been parsed.
htmlTag :: Monad m => ParsecT [Tok] s (StateT Enders m) [Tok]
htmlTag :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlTag = ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlOpenTag ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlClosingTag ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlComment ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlProcessingInstruction ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlDeclaration ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlCDATASection