{-# LANGUAGE OverloadedStrings #-}
module Web.Mangrove.Parse.Tree.InCell
( treeInCell
) where
import Web.Mangrove.Parse.Common.Error
import Web.Mangrove.Parse.Tokenize.Common
import Web.Mangrove.Parse.Tree.Common
import Web.Mangrove.Parse.Tree.InBody
import Web.Mangrove.Parse.Tree.Patch
import Web.Willow.Common.Parser
import Web.Willow.Common.Parser.Switch
treeInCell :: TreeBuilder TreeOutput
treeInCell :: TreeBuilder TreeOutput
treeInCell = StateT TreeParserState (Parser [TreeInput]) TreeInput
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT TreeParserState (Parser [TreeInput]) TreeInput
-> (TreeInput -> TreeBuilder TreeOutput) -> TreeBuilder TreeOutput
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput]
-> TreeInput -> TreeBuilder TreeOutput
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
[ (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isEndTag [String
"td", String
"th"]) ((TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
let d :: TagParams
d = TreeInput -> TagParams
tokenTag TreeInput
t'
Bool
hasMatch <- [Text] -> TreeBuilder Bool
hasInTableScope [TagParams -> Text
tagName TagParams
d]
if Bool
hasMatch
then do
[Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags [Text]
impliedEndTags
Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
let unexpected :: [Patch] -> [Patch]
unexpected = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement (Text -> ElementParams -> Bool) -> Text -> ElementParams -> Bool
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d) Maybe ElementParams
current
then [Patch] -> [Patch]
forall a. a -> a
id
else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
[Patch]
close <- Text -> TreeBuilder [Patch]
closeElement (Text -> TreeBuilder [Patch]) -> Text -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d
TreeBuilder ()
clearFormattingElements
InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InRow
TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
unexpected [Patch]
close
else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ElementParams -> ParseError
UnmatchedEndTag (ElementParams -> ParseError) -> ElementParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement TreeInput
t'] TreeInput
t'
, (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isStartTag
[ String
"caption"
, String
"col"
, String
"colgroup"
, String
"tbody"
, String
"td"
, String
"tfoot"
, String
"th"
, String
"thead"
, String
"tr"]) ((TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
Bool
hasMatch <- [Text] -> TreeBuilder Bool
hasInTableScope [Text
"td", Text
"th"]
if Bool
hasMatch
then do
TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
[Patch]
close <- TreeBuilder [Patch]
closeCell
[Patch] -> TreeBuilder TreeOutput
packTree_ [Patch]
close
else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ElementParams -> ParseError
MalformedTableStructure (ElementParams -> ParseError) -> ElementParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement TreeInput
t'] TreeInput
t'
, (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isEndTag
[ String
"body"
, String
"caption"
, String
"col"
, String
"colgroup"
, String
"html"
]) ((TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' ->
[ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ElementParams -> ParseError
UnexpectedEndTag (ElementParams -> ParseError) -> ElementParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement TreeInput
t'] TreeInput
t'
, (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isEndTag
[ String
"table"
, String
"tbody"
, String
"tfoot"
, String
"thead"
, String
"tr"
]) ((TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
Bool
hasMatch <- [Text] -> TreeBuilder Bool
hasInTableScope [TagParams -> Text
tagName (TagParams -> Text) -> TagParams -> Text
forall a b. (a -> b) -> a -> b
$ TreeInput -> TagParams
tokenTag TreeInput
t']
if Bool
hasMatch
then do
TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
[Patch]
close <- TreeBuilder [Patch]
closeCell
[Patch] -> TreeBuilder TreeOutput
packTree_ [Patch]
close
else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ElementParams -> ParseError
UnmatchedEndTag (ElementParams -> ParseError) -> ElementParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement TreeInput
t'] TreeInput
t'
, (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else ((TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t' TreeBuilder () -> TreeBuilder TreeOutput -> TreeBuilder TreeOutput
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TreeBuilder TreeOutput
treeInBody
]
where closeCell :: TreeBuilder [Patch]
closeCell = do
[Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags [Text]
impliedEndTags
Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
let errF :: [Patch] -> [Patch]
errF = if Maybe Text -> [Maybe Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ((ElementParams -> Text) -> Maybe ElementParams -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElementParams -> Text
elementName Maybe ElementParams
current) [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"td", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"th"]
then ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
else [Patch] -> [Patch]
forall a. a -> a
id
[Patch]
close <- [Text] -> TreeBuilder [Patch]
closeElements [Text
"td", Text
"th"]
TreeBuilder ()
clearFormattingElements
InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InRow
[Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Patch] -> TreeBuilder [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
close