{-# LANGUAGE OverloadedStrings #-}

{-|
Description:    Token processing rules within a @\<table\>@ markup section.

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

Stability:      stable
Portability:    portable
-}
module Web.Mangrove.Parse.Tree.InTable
    ( treeInTable
    , anythingElse
    ) where


import qualified Control.Monad.Trans.State as N.S

import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import qualified Data.Maybe as Y

import Web.Mangrove.Parse.Common.Error
import Web.Mangrove.Parse.Tree.Common
import Web.Mangrove.Parse.Tree.InBody
import Web.Mangrove.Parse.Tree.InHead
import Web.Mangrove.Parse.Tree.Patch
import Web.Willow.Common.Parser
import Web.Willow.Common.Parser.Switch


-- | __HTML:__
--      @[the "in table" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intable)@
-- 
-- The parsing instructions corresponding to the 'InTable' section of the state
-- machine.
treeInTable :: TreeBuilder TreeOutput
treeInTable :: TreeBuilder TreeOutput
treeInTable = 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 TreeInput -> Bool
isCharacter ((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
        Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
        let toTableText :: TreeBuilder TreeOutput
toTableText = do
                (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState)
 -> StateT TreeParserState (Parser [TreeInput]) ())
-> (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state -> TreeParserState
state
                    { insertionMode :: InsertionMode
insertionMode = InsertionMode
InTableText
                    , originalInsertionMode :: Maybe InsertionMode
originalInsertionMode = InsertionMode -> Maybe InsertionMode
forall a. a -> Maybe a
Just (InsertionMode -> Maybe InsertionMode)
-> InsertionMode -> Maybe InsertionMode
forall a b. (a -> b) -> a -> b
$ TreeParserState -> InsertionMode
insertionMode TreeParserState
state
                    }
                TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
                InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InTableText
                [Patch] -> TreeBuilder TreeOutput
packTree_ []
        case (ElementParams -> ElementName)
-> Maybe ElementParams -> Maybe ElementName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElementParams -> ElementName
elementName Maybe ElementParams
current of
            Just ElementName
"table" -> TreeBuilder TreeOutput
toTableText
            Just ElementName
"tbody" -> TreeBuilder TreeOutput
toTableText
            Just ElementName
"tfoot" -> TreeBuilder TreeOutput
toTableText
            Just ElementName
"thead" -> TreeBuilder TreeOutput
toTableText
            Just ElementName
"tr" -> TreeBuilder TreeOutput
toTableText
            Maybe ElementName
_ -> TreeInput -> TreeBuilder TreeOutput
anythingElse 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 TreeInput -> Bool
isComment TreeInput -> TreeBuilder TreeOutput
insertComment
    , (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 TreeInput -> Bool
isDoctype ((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 [DocumentTypeParams -> ParseError
UnexpectedDoctype (DocumentTypeParams -> ParseError)
-> DocumentTypeParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> DocumentTypeParams
tokenDocumentType 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"]) ((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 -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InCaption
        [Patch]
clear <- [ElementName] -> TreeBuilder [Patch]
clearToContext [ElementName]
tableContext
        StateT TreeParserState (Parser [TreeInput]) ()
insertFormattingMarker
        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
"colgroup"]) ((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 -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InColumnGroup
        [Patch]
clear <- [ElementName] -> TreeBuilder [Patch]
clearToContext [ElementName]
tableContext
        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
"col"]) ((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 -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InColumnGroup
        [Patch]
clear <- [ElementName] -> TreeBuilder [Patch]
clearToContext [ElementName]
tableContext
        [Patch]
insert <- TagParams -> TreeBuilder [Patch]
insertElement_ (TagParams -> TreeBuilder [Patch])
-> TagParams -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TagParams
emptyTagParams
            { tagName :: ElementName
tagName = ElementName
"colgroup"
            }
        [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
isStartTag [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
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InTableBody
        [Patch]
clear <- [ElementName] -> TreeBuilder [Patch]
clearToContext [ElementName]
tableContext
        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
"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' -> do
        TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InTableBody
        [Patch]
clear <- [ElementName] -> TreeBuilder [Patch]
clearToContext [ElementName]
tableContext
        [Patch]
insert <- TagParams -> TreeBuilder [Patch]
insertElement_ (TagParams -> TreeBuilder [Patch])
-> TagParams -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TagParams
emptyTagParams
            { tagName :: ElementName
tagName = ElementName
"tbody"
            }
        [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
isStartTag [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
hasTable <- [ElementName] -> TreeBuilder Bool
hasInTableScope [ElementName
"table"]
        if Bool
hasTable
            then do
                TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
                [Patch]
close <- TreeBuilder [Patch]
closeTable
                [Patch] -> TreeBuilder TreeOutput
packTree_ [Patch]
close
            else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
NestedNonRecursiveElement] 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
hasTable <- [ElementName] -> TreeBuilder Bool
hasInTableScope [ElementName
"table"]
        if Bool
hasTable
            then (TreeOutput -> [Patch] -> TreeOutput)
-> TreeBuilder TreeOutput
-> StateT
     TreeParserState (Parser [TreeInput]) ([Patch] -> TreeOutput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeOutput -> [Patch] -> TreeOutput
(|++) ([ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t') StateT TreeParserState (Parser [TreeInput]) ([Patch] -> TreeOutput)
-> TreeBuilder [Patch] -> TreeBuilder TreeOutput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TreeBuilder [Patch]
closeTable
            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
isEndTag
        [ String
"body"
        , String
"caption"
        , String
"col"
        , String
"colgroup"
        , String
"html"
        , 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' ->
            [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
isStartTag [String
"style", String
"script", String
"template"]) ((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 -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        TreeBuilder TreeOutput
treeInHead
    , (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
"template"]) ((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 -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        TreeBuilder TreeOutput
treeInHead
    , (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
"input"]) ((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' ->
        case (ElementName -> Bool) -> [ElementName] -> Maybe ElementName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (ElementName -> ElementName -> Bool
forall a. Eq a => a -> a -> Bool
== ElementName
"type") ([ElementName] -> Maybe ElementName)
-> (TagParams -> [ElementName]) -> TagParams -> Maybe ElementName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ElementName, ElementName) -> ElementName)
-> [(ElementName, ElementName)] -> [ElementName]
forall a b. (a -> b) -> [a] -> [b]
map (ElementName, ElementName) -> ElementName
forall a b. (a, b) -> a
fst ([(ElementName, ElementName)] -> [ElementName])
-> (TagParams -> [(ElementName, ElementName)])
-> TagParams
-> [ElementName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap ElementName ElementName -> [(ElementName, ElementName)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap ElementName ElementName -> [(ElementName, ElementName)])
-> (TagParams -> HashMap ElementName ElementName)
-> TagParams
-> [(ElementName, ElementName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagParams -> HashMap ElementName ElementName
tagAttributes (TagParams -> Maybe ElementName) -> TagParams -> Maybe ElementName
forall a b. (a -> b) -> a -> b
$ TreeInput -> TagParams
tokenTag TreeInput
t' of
            Just ElementName
"hidden" -> ParseError -> TreeOutput -> TreeOutput
consTreeError ParseError
UnexpectedElementInTableStructure (TreeOutput -> TreeOutput)
-> TreeBuilder TreeOutput -> TreeBuilder TreeOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeInput -> TreeBuilder TreeOutput
insertNullElement TreeInput
t'
            Maybe ElementName
_ -> TreeInput -> TreeBuilder TreeOutput
anythingElse 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
"form"]) ((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
        TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
        let hasTemplate :: Bool
hasTemplate = ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ElementName -> ElementParams -> Bool
nodeIsElement ElementName
"template" (ElementParams -> Bool)
-> ((NodeIndex, ElementParams) -> ElementParams)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd) ([(NodeIndex, ElementParams)] -> Bool)
-> [(NodeIndex, ElementParams)] -> Bool
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
        if Bool
hasTemplate Bool -> Bool -> Bool
|| Maybe NodeIndex -> Bool
forall a. Maybe a -> Bool
Y.isJust (TreeParserState -> Maybe NodeIndex
formElementPointer TreeParserState
state)
            then [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
UnexpectedElementInTableStructure] TreeInput
t'
            else do
                (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState)
 -> StateT TreeParserState (Parser [TreeInput]) ())
-> (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state' -> TreeParserState
state'
                    { formElementPointer :: Maybe NodeIndex
formElementPointer = NodeIndex -> Maybe NodeIndex
forall a. a -> Maybe a
Just (NodeIndex -> Maybe NodeIndex) -> NodeIndex -> Maybe NodeIndex
forall a b. (a -> b) -> a -> b
$ TreeParserState -> NodeIndex
elementIndex TreeParserState
state'
                    }
                TreeInput -> TreeBuilder TreeOutput
insertNullElement 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 TreeInput -> Bool
isEOF ((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 -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        TreeBuilder TreeOutput
treeInBody
    , (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
anythingElse
    ]
  where closeTable :: TreeBuilder [Patch]
closeTable = ElementName -> TreeBuilder [Patch]
closeElement ElementName
"table" TreeBuilder [Patch]
-> StateT TreeParserState (Parser [TreeInput]) ()
-> TreeBuilder [Patch]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT TreeParserState (Parser [TreeInput]) ()
resetInsertionMode


-- | __HTML:__
--      the "anything else" entry in @[the "in table" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intable)@
-- 
-- Delegate a token to to the 'InTable' section of the state machine, but skip
-- the token-dependent behaviour and instead simply treat it according to the
-- fallback case.
anythingElse :: TreeInput -> TreeBuilder TreeOutput
anythingElse :: TreeInput -> TreeBuilder TreeOutput
anythingElse TreeInput
t' = do
    Any
_ <- String -> StateT TreeParserState (Parser [TreeInput]) Any
forall a. HasCallStack => String -> a
error String
"Foster parenting not yet implemented"
    (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState)
 -> StateT TreeParserState (Parser [TreeInput]) ())
-> (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state -> TreeParserState
state
        { fosteringEnabled :: Bool
fosteringEnabled = Bool
True
        }
    TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
    TreeOutput
out <- TreeBuilder TreeOutput
treeInBody
    (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState)
 -> StateT TreeParserState (Parser [TreeInput]) ())
-> (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state -> TreeParserState
state
        { fosteringEnabled :: Bool
fosteringEnabled = Bool
False
        }
    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
$ ParseError -> TreeOutput -> TreeOutput
consTreeError ParseError
UnexpectedNodeInTableStructure TreeOutput
out