InCaption.hs

{-# LANGUAGE OverloadedStrings #-}

{-|
Description:    Token processing rules within a @\<caption\>@ section describing 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.InCaption
    ( treeInCaption
    ) where


import Web.Mangrove.Parse.Common.Error
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


-- | __HTML:__
--      @[the "in caption" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-incaption)@
-- 
-- The parsing instructions corresponding to the 'InCaption' section of the
-- state machine.
treeInCaption :: TreeBuilder TreeOutput
treeInCaption = next >>= switch
    [ If (isEndTag ["caption"]) $ \t' -> do
        hasCaption <- hasInTableScope ["caption"]
        if hasCaption
            then do
                generate <- generateEndTags impliedEndTags
                current <- currentNode
                unexpected <- if maybe True (nodeIsElement "caption") current
                        then packTree t' []
                        else packTreeErrors [UnexpectedElementWithImpliedEndTag] t'
                close <- closeElement "caption"
                clearFormattingElements
                switchMode InTable
                return $ generate ++| unexpected |++ close
            else packTreeErrors [UnmatchedEndTag $ tokenElement t'] t'
    , If (isStartTag
        [ "caption"
        , "col"
        , "colgroup"
        , "tbody"
        , "td"
        , "tfoot"
        , "th"
        , "thead"
        , "tr"
        ]) $ \t' -> do
            hasCaption <- hasInTableScope ["caption"]
            if hasCaption
                then do
                    push t'
                    generate <- generateEndTags impliedEndTags
                    current <- currentNode
                    let unexpected = if maybe True (nodeIsElement "caption") current
                            then id
                            else consTreeError_ UnexpectedElementWithImpliedEndTag
                    close <- closeElement "caption"
                    clearFormattingElements
                    switchMode InTable
                    packTree_ $ generate ++ unexpected close
                else packTreeErrors [UnexpectedDescendantElement $ tokenElement t'] t'
    , If (isEndTag ["table"]) $ \t' -> do
        hasCaption <- hasInTableScope ["caption"]
        if hasCaption
            then do
                push t'
                generate <- generateEndTags impliedEndTags
                current <- currentNode
                let unexpected = if maybe True (nodeIsElement "caption") current
                        then id
                        else consTreeError_ UnexpectedElementWithImpliedEndTag
                close <- closeElement "caption"
                clearFormattingElements
                switchMode InTable
                packTree_ $ generate ++ unexpected close
            else packTreeErrors [UnexpectedDescendantElement $ tokenElement t'] t'
    , If (isEndTag
        [ "body"
        , "col"
        , "colgroup"
        , "html"
        , "tbody"
        , "td"
        , "tfoot"
        , "th"
        , "thead"
        , "tr"
        ]) $ \t' ->
            packTreeErrors [UnmatchedEndTag $ tokenElement t'] t'
    , Else $ \t' -> do
        push t'
        treeInBody
    ]