InFrameset.hs

{-# LANGUAGE OverloadedStrings #-}

{-|
Description:    Token processing rules within a @\<frameset\>@ section.

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

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


import qualified Control.Monad as N
import qualified Control.Monad.Trans.State as N.S

import qualified Data.Maybe as Y

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 frameset" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inframeset)@
-- 
-- The parsing instructions corresponding to the 'InFrameset' section of the
-- state machine.
treeInFrameset :: TreeBuilder TreeOutput
treeInFrameset = next >>= switch
    [ If isWhitespace insertCharacter
    , If isComment insertComment
    , If isDoctype $ \t' ->
        packTreeErrors [UnexpectedDoctype $ tokenDocumentType t'] t'
    , If (isStartTag ["html"]) $ \t' -> do
        push t'
        treeInBody
    , If (isStartTag ["frameset"]) insertElement
    , If (isEndTag ["frameset"]) $ \t' -> do
        state <- N.S.get
        current <- currentNode
        close <- if length (openElements state) <= 1 && maybe True (nodeIsElement "html") current
            then packTreeErrors [UnmatchedEndTag $ tokenElement t'] t'
            else closeCurrentNode t'
        current' <- currentNode
        let notFragment = Y.isNothing $ fragmentContext state
            currentFrameset = maybe False (nodeIsElement "frameset") current'
        N.when (notFragment && not currentFrameset) $ switchMode AfterFrameset
        return close
    , If (isStartTag ["frame"]) insertNullElement
    , If (isStartTag ["noframes"]) $ \t' -> do
        push t'
        treeInHead
    , If isEOF $ \t' -> do
        elements <- openElements <$> N.S.get
        let errF = if length elements > 1
                then consTreeError UnexpectedElementWithImpliedEndTag
                else id
        eof <- stopParsing t'
        return $ errF eof
    , Else $ packTreeErrors [UnexpectedNodeInFrameset]
    ]