InHeadNoscript.hs

{-|
Description:    Token processing rules within a @\<noscript\>@ section of the @\<head\>@.

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

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


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


-- | __HTML:__
--      @[the "in head noscript" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inheadnoscript)@
-- 
-- The parsing instructions corresponding to the 'InHeadNoscript' section of
-- the state machine.
treeInHeadNoscript :: TreeBuilder TreeOutput
treeInHeadNoscript = next >>= switch
    [ If isDoctype $ \t' ->
        packTreeErrors [UnexpectedDoctype $ tokenDocumentType t'] t'
    , If (isStartTag ["html"]) $ \t' -> do
        push t'
        treeInBody
    , If (isEndTag ["noscript"]) $ \t' -> do
        switchMode InHead
        closeCurrentNode t'
    , If isWhitespace $ \t' -> do
        push t'
        treeInHead
    , If isComment $ \t' -> do
        push t'
        treeInHead
    , If (isStartTag
        [ "basefont"
        , "bgsound"
        , "link"
        , "meta"
        , "noframes"
        , "style"
        ]) $ \t' -> do
            push t'
            treeInHead
    , If (isEndTag ["br"]) anythingElse
    , If (isStartTag ["head", "noscript"]) $ packTreeErrors [NestedSingletonElement]
    , If isAnyEndTag $ \t' ->
        packTreeErrors [UnmatchedEndTag $ tokenElement t'] t'
    , Else anythingElse
    ]
  where anythingElse t' = do
            push t'
            switchMode InHead
            close <- closeCurrentNode_
            packTree_ $ consTreeError_ UnexpectedNodeInHeadNoscript close