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

{-# 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 = next >>= switch
    [ If (isStartTag ["tr"]) $ \t' -> do
        switchMode InRow
        clear <- clearToContext tableBodyContext
        insert <- insertElement t'
        return $ clear ++| insert
    , If (isStartTag ["th", "td"]) $ \t' -> do
        push t'
        switchMode InRow
        clear <- clearToContext tableBodyContext
        insert <- fmap (consTreeError_ UnexpectedTableCellOutsideOfRow) . insertElement_ $ emptyTagParams
            { tagName = "tr"
            }
        packTree_ $ clear ++ insert
    , If (isEndTag ["tbody", "tfoot", "thead"]) $ \t' -> do
        hasTable <- hasInTableScope [tagName $ tokenTag t']
        if hasTable
            then do
                switchMode InTable
                close <- closeTableBody
                packTree t' close
            else packTreeErrors [UnmatchedEndTag $ tokenElement t'] t'
    , If (isStartTag
        [ "caption"
        , "col"
        , "colgroup"
        , "tbody"
        , "tfoot"
        , "thead"
        ]) $ \t' -> do
            hasMatch <- hasInTableScope ["tbody", "thead", "tfoot"]
            if hasMatch
                then do
                    push t'
                    switchMode InTable
                    close <- closeTableBody
                    packTree_ close
                else packTreeErrors [UnexpectedDescendantElement $ tokenElement t'] t'
    , If (isEndTag ["table"]) $ \t' -> do
        hasMatch <- hasInTableScope ["tbody", "thead", "tfoot"]
        if hasMatch
            then do
                push t'
                switchMode InTable
                close <- closeTableBody
                packTree_ close
            else packTreeErrors [UnexpectedDescendantElement $ tokenElement t'] t'
    , If (isEndTag
        [ "body"
        , "caption"
        , "col"
        , "colgroup"
        , "html"
        , "td"
        , "th"
        , "tr"
        ]) $ \t' ->
            packTreeErrors [UnexpectedEndTag $ tokenElement t'] t'
    , Else $ \t' -> do
        push t'
        treeInTable
    ]
  where closeTableBody = do
            clear <- clearToContext tableBodyContext
            close <- closeCurrentNode_
            return $ clear ++ close