{-# 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 -> Bool
scannedForCDATA :: !Bool
, Enders -> Bool
scannedForProcessingInstruction :: !Bool
, Enders -> Bool
scannedForDeclaration :: !Bool
} deriving Int -> Enders -> ShowS
[Enders] -> ShowS
Enders -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Enders] -> ShowS
$cshowList :: [Enders] -> ShowS
show :: Enders -> String
$cshow :: Enders -> String
showsPrec :: Int -> Enders -> ShowS
$cshowsPrec :: Int -> Enders -> ShowS
Show
defaultEnders :: Enders
defaultEnders :: Enders
defaultEnders = Enders { scannedForCDATA :: Bool
scannedForCDATA = Bool
False
, scannedForProcessingInstruction :: Bool
scannedForProcessingInstruction = Bool
False
, scannedForDeclaration :: Bool
scannedForDeclaration = Bool
False }
(.&&.) :: (a -> Bool) -> (a -> Bool) -> (a -> Bool)
.&&. :: forall a. (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
(&&)
htmlTagName :: Monad m => ParsecT [Tok] s m [Tok]
htmlTagName :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlTagName = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try 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 (Text -> Char
T.head Text
t')
Tok
t <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Bool
isTagText forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
.&&. Text -> Bool
startsWithLetter)
[Tok]
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord Text -> Bool
isTagText)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tok
tforall a. a -> [a] -> [a]
:[Tok]
rest)
htmlAttributeName :: Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeName :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeName = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try 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 (Text -> Char
T.head Text
t')
Tok
t <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Bool
startsWithLetter forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
.&&. Text -> Bool
isTagText) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'_' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':'
[Tok]
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord Text -> Bool
isTagText
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'_'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':'
forall (m :: * -> *) a. Monad m => a -> m a
return (Tok
tforall a. a -> [a] -> [a]
:[Tok]
rest)
htmlAttributeValueSpec :: Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValueSpec :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValueSpec = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
[Tok]
sps1 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
Tok
eq <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'='
[Tok]
sps2 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
[Tok]
val <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValue
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tok]
sps1 forall a. [a] -> [a] -> [a]
++ [Tok
eq] forall a. [a] -> [a] -> [a]
++ [Tok]
sps2 forall a. [a] -> [a] -> [a]
++ [Tok]
val
htmlAttributeValue :: Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValue :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValue =
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlUnquotedAttributeValue forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlSingleQuotedAttributeValue forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlDoubleQuotedAttributeValue
htmlAttribute :: Monad m => ParsecT [Tok] s m [Tok]
htmlAttribute :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttribute = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
[Tok]
sps <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
[Tok]
n <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeName
[Tok]
val <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeValueSpec
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tok]
sps forall a. [a] -> [a] -> [a]
++ [Tok]
n forall a. [a] -> [a] -> [a]
++ [Tok]
val
htmlUnquotedAttributeValue :: Monad m => ParsecT [Tok] s m [Tok]
htmlUnquotedAttributeValue :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlUnquotedAttributeValue =
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ 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
'"']
htmlSingleQuotedAttributeValue :: Monad m => ParsecT [Tok] s m [Tok]
htmlSingleQuotedAttributeValue :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlSingleQuotedAttributeValue = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
Tok
op <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\''
[Tok]
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'\'')))
Tok
cl <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\''
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tok
op forall a. a -> [a] -> [a]
: [Tok]
contents forall a. [a] -> [a] -> [a]
++ [Tok
cl]
htmlDoubleQuotedAttributeValue :: Monad m => ParsecT [Tok] s m [Tok]
htmlDoubleQuotedAttributeValue :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlDoubleQuotedAttributeValue = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
Tok
op <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'"'
[Tok]
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'"')))
Tok
cl <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'"'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tok
op forall a. a -> [a] -> [a]
: [Tok]
contents forall a. [a] -> [a] -> [a]
++ [Tok
cl]
htmlOpenTag :: Monad m => ParsecT [Tok] s m [Tok]
htmlOpenTag :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlOpenTag = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
[Tok]
n <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlTagName
[Tok]
attrs <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttribute
[Tok]
sps <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
[Tok]
sl <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
Tok
cl <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tok]
n forall a. [a] -> [a] -> [a]
++ [Tok]
attrs forall a. [a] -> [a] -> [a]
++ [Tok]
sps forall a. [a] -> [a] -> [a]
++ [Tok]
sl forall a. [a] -> [a] -> [a]
++ [Tok
cl]
htmlClosingTag :: Monad m => ParsecT [Tok] s m [Tok]
htmlClosingTag :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlClosingTag = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
Tok
op <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
[Tok]
n <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlTagName
[Tok]
sps <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
Tok
cl <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tok
op forall a. a -> [a] -> [a]
: [Tok]
n forall a. [a] -> [a] -> [a]
++ [Tok]
sps forall a. [a] -> [a] -> [a]
++ [Tok
cl]
htmlComment :: Monad m => ParsecT [Tok] s m [Tok]
= forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
[Tok]
op <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' ]
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
[Tok]
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'-'))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'))
[Tok]
cl <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>' ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tok]
op forall a. [a] -> [a] -> [a]
++ [Tok]
contents forall a. [a] -> [a] -> [a]
++ [Tok]
cl
htmlProcessingInstruction :: Monad m
=> ParsecT [Tok] s (StateT Enders m) [Tok]
htmlProcessingInstruction :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlProcessingInstruction = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
let questionmark :: ParsecT [Tok] s (StateT Enders m) Tok
questionmark = forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'?'
Tok
op <- forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
questionmark
Bool
alreadyScanned <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Enders -> Bool
scannedForProcessingInstruction
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
alreadyScanned
[Tok]
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'?'))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
questionmark forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \Enders
st -> Enders
st{ scannedForProcessingInstruction :: Bool
scannedForProcessingInstruction = Bool
True }
[Tok]
cl <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
questionmark
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>' ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tok
op forall a. a -> [a] -> [a]
: [Tok]
contents forall a. [a] -> [a] -> [a]
++ [Tok]
cl
htmlDeclaration :: Monad m => ParsecT [Tok] s (StateT Enders m) [Tok]
htmlDeclaration :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlDeclaration = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
Tok
op <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
Bool
alreadyScanned <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Enders -> Bool
scannedForDeclaration
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
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 forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
.&&. Char -> Bool
isAlpha) Text
t
Tok
name <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord Text -> Bool
isDeclName
[Tok]
ws <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
[Tok]
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'>')))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \Enders
st -> Enders
st{ scannedForDeclaration :: Bool
scannedForDeclaration = Bool
True }
Tok
cl <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tok
op forall a. a -> [a] -> [a]
: Tok
name forall a. a -> [a] -> [a]
: [Tok]
ws forall a. [a] -> [a] -> [a]
++ [Tok]
contents forall a. [a] -> [a] -> [a]
++ [Tok
cl]
htmlCDATASection :: Monad m => ParsecT [Tok] s (StateT Enders m) [Tok]
htmlCDATASection :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlCDATASection = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
[Tok]
op <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
, forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (forall a. Eq a => a -> a -> Bool
== Text
"CDATA")
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'[' ]
Bool
alreadyScanned <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Enders -> Bool
scannedForCDATA
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
alreadyScanned
let ender :: ParsecT [Tok] u (StateT Enders m) [Tok]
ender = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']'
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']'
, forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>' ]
[Tok]
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall {u}. ParsecT [Tok] u (StateT Enders m) [Tok]
ender
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \Enders
st -> Enders
st{ scannedForCDATA :: Bool
scannedForCDATA = Bool
True }
[Tok]
cl <- forall {u}. ParsecT [Tok] u (StateT Enders m) [Tok]
ender
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tok]
op forall a. [a] -> [a] -> [a]
++ [Tok]
contents forall a. [a] -> [a] -> [a]
++ [Tok]
cl
htmlTag :: Monad m => ParsecT [Tok] s (StateT Enders m) [Tok]
htmlTag :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlTag = forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlOpenTag forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlClosingTag forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlComment forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlProcessingInstruction forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlDeclaration forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlCDATASection