{-# 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
(&&)
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')
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)
rest <- many (symbol '-' <|> satisfyWord isTagText)
return (t:rest)
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')
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
':'
rest <- many $ satisfyWord isTagText
<|> symbol '_'
<|> symbol '-'
<|> symbol '.'
<|> symbol ':'
return (t:rest)
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
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
eq <- symbol '='
sps2 <- option [] whitespace
val <- htmlAttributeValue
return $ sps1 ++ [eq] ++ sps2 ++ val
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
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
sps <- ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
n <- htmlAttributeName
val <- option [] htmlAttributeValueSpec
return $ sps ++ n ++ val
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 u (m :: * -> *) a. 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
'"']
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
op <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\''
contents <- many (satisfyTok (not . hasType (Symbol '\'')))
cl <- symbol '\''
return $ op : contents ++ [cl]
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
op <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'"'
contents <- many (satisfyTok (not . hasType (Symbol '"')))
cl <- symbol '"'
return $ op : contents ++ [cl]
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
n <- ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlTagName
attrs <- concat <$> many htmlAttribute
sps <- option [] whitespace
sl <- option [] $ (:[]) <$> symbol '/'
cl <- symbol '>'
return $ n ++ attrs ++ sps ++ sl ++ [cl]
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
op <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
n <- htmlTagName
sps <- option [] whitespace
cl <- symbol '>'
return $ op : n ++ sps ++ [cl]
htmlComment :: Monad m => 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
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
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] -> 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 u (m :: * -> *) a. 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)
(op ++) <$>
( ((:[]) <$> symbol '>')
<|> try (sequence [ symbol '-', symbol '>' ])
<|> getContent
)
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
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
'?'
op <- ParsecT [Tok] s (StateT Enders m) Tok
forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
questionmark
pos <- getPosition
alreadyScanned <- lift $ gets scannedForProcessingInstruction
guard $ maybe True (< pos) alreadyScanned
contents <- many $ satisfyTok (not . hasType (Symbol '?'))
<|> try (questionmark <*
notFollowedBy (symbol '>'))
pos' <- getPosition
lift $ modify $ \Enders
st -> Enders
st{ scannedForProcessingInstruction = Just pos' }
cl <- sequence [ questionmark
, symbol '>' ]
return $ op : contents ++ 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 = 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
op <- Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
pos <- getPosition
alreadyScanned <- lift $ gets scannedForDeclaration
guard $ maybe True (< pos) alreadyScanned
let 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
name <- satisfyWord isDeclName
ws <- whitespace
contents <- many (satisfyTok (not . hasType (Symbol '>')))
pos' <- getPosition
lift $ modify $ \Enders
st -> Enders
st{ scannedForDeclaration = Just pos' }
cl <- symbol '>'
return $ op : name : ws ++ contents ++ [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 = 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
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
'[' ]
pos <- getPosition
alreadyScanned <- lift $ gets scannedForCDATA
guard $ maybe True (< pos) alreadyScanned
let 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
'>' ]
contents <- many $ do
notFollowedBy ender
anyTok
pos' <- getPosition
lift $ modify $ \Enders
st -> Enders
st{ scannedForCDATA = Just pos' }
cl <- ender
return $ op ++ contents ++ 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 = 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