{-# LANGUAGE OverloadedStrings #-}

{-|
Description:    Token processing rules for the primary content of a @\<table\>@.

Copyright:      (c) 2020 Sam May
License:        MPL-2.0
Maintainer:     ag.eitilt@gmail.com

Stability:      stable
Portability:    portable
-}
module Web.Mangrove.Parse.Tree.InTableBody
    ( treeInTableBody
    ) where


import Web.Mangrove.Parse.Common.Error
import Web.Mangrove.Parse.Tokenize.Common
import Web.Mangrove.Parse.Tree.Common
import Web.Mangrove.Parse.Tree.InTable
import Web.Mangrove.Parse.Tree.Patch
import Web.Willow.Common.Parser
import Web.Willow.Common.Parser.Switch


-- | __HTML:__
--      @[the "in table body" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intbody)@
-- 
-- The parsing instructions corresponding to the 'InTableBody' section of the
-- state machine.
treeInTableBody :: TreeBuilder TreeOutput
treeInTableBody :: TreeBuilder TreeOutput
treeInTableBody = 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
isStartTag [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
        InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InRow
        [Patch]
clear <- [ElementName] -> TreeBuilder [Patch]
clearToContext [ElementName]
tableBodyContext
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement TreeInput
t'
        TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeOutput -> TreeBuilder TreeOutput)
-> TreeOutput -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
clear [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"th", String
"td"]) ((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
        TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InRow
        [Patch]
clear <- [ElementName] -> TreeBuilder [Patch]
clearToContext [ElementName]
tableBodyContext
        [Patch]
insert <- ([Patch] -> [Patch]) -> TreeBuilder [Patch] -> TreeBuilder [Patch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedTableCellOutsideOfRow) (TreeBuilder [Patch] -> TreeBuilder [Patch])
-> (TagParams -> TreeBuilder [Patch])
-> TagParams
-> TreeBuilder [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagParams -> TreeBuilder [Patch]
insertElement_ (TagParams -> TreeBuilder [Patch])
-> TagParams -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TagParams
emptyTagParams
            { tagName :: ElementName
tagName = ElementName
"tr"
            }
        [Patch] -> TreeBuilder TreeOutput
packTree_ ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
clear [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
insert
    , (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
"tbody", String
"tfoot", String
"thead"]) ((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
hasTable <- [ElementName] -> TreeBuilder Bool
hasInTableScope [TagParams -> ElementName
tagName (TagParams -> ElementName) -> TagParams -> ElementName
forall a b. (a -> b) -> a -> b
$ TreeInput -> TagParams
tokenTag TreeInput
t']
        if Bool
hasTable
            then do
                InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InTable
                [Patch]
close <- TreeBuilder [Patch]
closeTableBody
                TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' [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
"tfoot"
        , String
"thead"
        ]) ((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 <- [ElementName] -> TreeBuilder Bool
hasInTableScope [ElementName
"tbody", ElementName
"thead", ElementName
"tfoot"]
            if Bool
hasMatch
                then do
                    TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
                    InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InTable
                    [Patch]
close <- TreeBuilder [Patch]
closeTableBody
                    [Patch] -> TreeBuilder TreeOutput
packTree_ [Patch]
close
                else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ElementParams -> ParseError
UnexpectedDescendantElement (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"]) ((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 <- [ElementName] -> TreeBuilder Bool
hasInTableScope [ElementName
"tbody", ElementName
"thead", ElementName
"tfoot"]
        if Bool
hasMatch
            then do
                TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
                InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InTable
                [Patch]
close <- TreeBuilder [Patch]
closeTableBody
                [Patch] -> TreeBuilder TreeOutput
packTree_ [Patch]
close
            else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ElementParams -> ParseError
UnexpectedDescendantElement (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"
        , String
"td"
        , String
"th"
        , 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' ->
            [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 -> 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' -> do
        TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        TreeBuilder TreeOutput
treeInTable
    ]
  where closeTableBody :: TreeBuilder [Patch]
closeTableBody = do
            [Patch]
clear <- [ElementName] -> TreeBuilder [Patch]
clearToContext [ElementName]
tableBodyContext
            [Patch]
close <- TreeBuilder [Patch]
closeCurrentNode_
            [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]
clear [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
close