{-# LANGUAGE OverloadedStrings #-}

{-|
Description:    Token processing rules within a @\<template\>@ section providing a fragment for script processing.

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

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


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

import {-# SOURCE #-} Web.Mangrove.Parse.Tree.InBody


-- | __HTML:__
--      @[the "in template" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intemplate)@
-- 
-- The parsing instructions corresponding to the 'InTemplate' section of the
-- state machine.
treeInTemplate :: TreeBuilder TreeOutput
treeInTemplate :: TreeBuilder TreeOutput
treeInTemplate = 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
        TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        TreeBuilder TreeOutput
treeInBody
    , (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)
 -> 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 -> 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' -> do
        TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        TreeBuilder TreeOutput
treeInBody
    , (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
"base"
        , String
"basefont"
        , String
"bgsound"
        , String
"link"
        , String
"meta"
        , String
"noframes"
        , String
"script"
        , String
"style"
        , String
"template"
        , String
"title"
        ]) ((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
"caption"
        , 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
            TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
            ()
_ <- StateT TreeParserState (Parser [TreeInput]) ()
popTemplateMode
            InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
pushTemplateMode InsertionMode
InTable
            InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InTable
            [Patch] -> TreeBuilder TreeOutput
packTree_ []
    , (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'
        StateT TreeParserState (Parser [TreeInput]) ()
popTemplateMode
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
pushTemplateMode InsertionMode
InColumnGroup
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InColumnGroup
        [Patch] -> TreeBuilder TreeOutput
packTree_ []
    , (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
        TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        StateT TreeParserState (Parser [TreeInput]) ()
popTemplateMode
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
pushTemplateMode InsertionMode
InTableBody
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InTableBody
        [Patch] -> TreeBuilder TreeOutput
packTree_ []
    , (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"]) ((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'
        StateT TreeParserState (Parser [TreeInput]) ()
popTemplateMode
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
pushTemplateMode InsertionMode
InRow
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InRow
        [Patch] -> TreeBuilder TreeOutput
packTree_ []
    , (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
isAnyStartTag ((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'
        StateT TreeParserState (Parser [TreeInput]) ()
popTemplateMode
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
pushTemplateMode InsertionMode
InBody
        InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
InBody
        [Patch] -> TreeBuilder TreeOutput
packTree_ []
    , (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
isAnyEndTag ((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
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 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
        Bool
hasTemplate <- [ElementName] -> TreeBuilder Bool
hasOpenElement [ElementName
"template"]
        if Bool
hasTemplate
            then do
                TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
                [Patch]
close <- ElementName -> TreeBuilder [Patch]
closeElement ElementName
"template"
                StateT TreeParserState (Parser [TreeInput]) ()
clearFormattingElements
                StateT TreeParserState (Parser [TreeInput]) ()
popTemplateMode
                StateT TreeParserState (Parser [TreeInput]) ()
resetInsertionMode
                [Patch] -> TreeBuilder TreeOutput
packTree_ [Patch]
close
            else TreeInput -> TreeBuilder TreeOutput
stopParsing TreeInput
t'
    ]