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

{-|
Description:    Token processing rules before the root element is opened.

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

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


import qualified Data.Text as T

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


-- | __HTML:__
--      @[the "before html" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#the-before-html-insertion-mode)@
-- 
-- The parsing instructions corresponding to the 'BeforeHtml' section of the
-- state machine.
treeBeforeHtml :: TreeBuilder TreeOutput
treeBeforeHtml = next >>= switch
    [ If isDoctype $ \t' ->
        packTreeErrors [UnexpectedDoctype $ tokenDocumentType t'] t'
    , If isComment $ insertComment' InDocument
    , If isWhitespace $ packTreeErrors []
    , If (isStartTag ["html"]) $ \t' -> do
        switchMode BeforeHead
        insertElement t'
    , If (isEndTag ["head", "body", "html", "br"]) anythingElse
    , If isAnyEndTag $ \t' ->
        packTreeErrors [UnmatchedEndTag $ tokenElement t'] t'
    , Else anythingElse
    ]
  where anythingElse t' = do
            push t'
            switchMode BeforeHead
            insert <- insertElement_ emptyTagParams
                { tagName = T.pack "html"
                }
            packTree_ insert