mangrove-0.1.0.0: src/Web/Mangrove/Parse/Tree/InTemplate.hs

{-# 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 = next >>= switch
    [ If isCharacter $ \t' -> do
        push t'
        treeInBody
    , If isComment $ \t' -> do
        push t'
        treeInBody
    , If isDoctype $ \t' -> do
        push t'
        treeInBody
    , If (isStartTag
        [ "base"
        , "basefont"
        , "bgsound"
        , "link"
        , "meta"
        , "noframes"
        , "script"
        , "style"
        , "template"
        , "title"
        ]) $ \t' -> do
            push t'
            treeInHead
    , If (isEndTag ["template"]) $ \t' -> do
        push t'
        treeInHead
    , If (isStartTag
        [ "caption"
        , "colgroup"
        , "tbody"
        , "tfoot"
        , "thead"
        ]) $ \t' -> do
            push t'
            _ <- popTemplateMode
            pushTemplateMode InTable
            switchMode InTable
            packTree_ []
    , If (isStartTag ["col"]) $ \t' -> do
        push t'
        popTemplateMode
        pushTemplateMode InColumnGroup
        switchMode InColumnGroup
        packTree_ []
    , If (isStartTag ["tr"]) $ \t' -> do
        push t'
        popTemplateMode
        pushTemplateMode InTableBody
        switchMode InTableBody
        packTree_ []
    , If (isStartTag ["td", "th"]) $ \t' -> do
        push t'
        popTemplateMode
        pushTemplateMode InRow
        switchMode InRow
        packTree_ []
    , If isAnyStartTag $ \t' -> do
        push t'
        popTemplateMode
        pushTemplateMode InBody
        switchMode InBody
        packTree_ []
    , If isAnyEndTag $ \t' ->
        packTreeErrors [UnmatchedEndTag $ tokenElement t'] t'
    , If isEOF $ \t' -> do
        hasTemplate <- hasOpenElement ["template"]
        if hasTemplate
            then do
                push t'
                close <- closeElement "template"
                clearFormattingElements
                popTemplateMode
                resetInsertionMode
                packTree_ close
            else stopParsing t'
    ]