{-# 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 :: TreeBuilder TreeOutput
treeInFrameset = StateT TreeParserState (Parser [TreeInput]) TreeInput
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT TreeParserState (Parser [TreeInput]) TreeInput
-> (TreeInput -> TreeBuilder TreeOutput) -> TreeBuilder TreeOutput
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
   TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput]
-> TreeInput -> TreeBuilder TreeOutput
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If TreeInput -> Bool
isWhitespace TreeInput -> TreeBuilder TreeOutput
insertCharacter
    , (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If TreeInput -> Bool
isComment TreeInput -> TreeBuilder TreeOutput
insertComment
    , (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If TreeInput -> Bool
isDoctype ((TreeInput -> TreeBuilder TreeOutput)
 -> SwitchCase
      TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' ->
        [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [DocumentTypeParams -> ParseError
UnexpectedDoctype (DocumentTypeParams -> ParseError)
-> DocumentTypeParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> DocumentTypeParams
tokenDocumentType TreeInput
t'] TreeInput
t'
    , (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isStartTag [String
"html"]) ((TreeInput -> TreeBuilder TreeOutput)
 -> SwitchCase
      TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
        TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        TreeBuilder TreeOutput
treeInBody
    , (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isStartTag [String
"frameset"]) TreeInput -> TreeBuilder TreeOutput
insertElement
    , (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isEndTag [String
"frameset"]) ((TreeInput -> TreeBuilder TreeOutput)
 -> SwitchCase
      TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
        TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
        Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
        TreeOutput
close <- if [(NodeIndex, ElementParams)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
&& Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement Text
"html") Maybe ElementParams
current
            then [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ElementParams -> ParseError
UnmatchedEndTag (ElementParams -> ParseError) -> ElementParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement TreeInput
t'] TreeInput
t'
            else TreeInput -> TreeBuilder TreeOutput
closeCurrentNode TreeInput
t'
        Maybe ElementParams
current' <- TreeBuilder (Maybe ElementParams)
currentNode
        let notFragment :: Bool
notFragment = Maybe (ElementParams, [(NodeIndex, ElementParams)]) -> Bool
forall a. Maybe a -> Bool
Y.isNothing (Maybe (ElementParams, [(NodeIndex, ElementParams)]) -> Bool)
-> Maybe (ElementParams, [(NodeIndex, ElementParams)]) -> Bool
forall a b. (a -> b) -> a -> b
$ TreeParserState
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
fragmentContext TreeParserState
state
            currentFrameset :: Bool
currentFrameset = Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> ElementParams -> Bool
nodeIsElement Text
"frameset") Maybe ElementParams
current'
        Bool
-> StateT TreeParserState (Parser [TreeInput]) ()
-> StateT TreeParserState (Parser [TreeInput]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
N.when (Bool
notFragment Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
currentFrameset) (StateT TreeParserState (Parser [TreeInput]) ()
 -> StateT TreeParserState (Parser [TreeInput]) ())
-> StateT TreeParserState (Parser [TreeInput]) ()
-> StateT TreeParserState (Parser [TreeInput]) ()
forall a b. (a -> b) -> a -> b
$ InsertionMode -> StateT TreeParserState (Parser [TreeInput]) ()
switchMode InsertionMode
AfterFrameset
        TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
close
    , (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isStartTag [String
"frame"]) TreeInput -> TreeBuilder TreeOutput
insertNullElement
    , (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If ([String] -> TreeInput -> Bool
isStartTag [String
"noframes"]) ((TreeInput -> TreeBuilder TreeOutput)
 -> SwitchCase
      TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
        TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        TreeBuilder TreeOutput
treeInHead
    , (TreeInput -> Bool)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If TreeInput -> Bool
isEOF ((TreeInput -> TreeBuilder TreeOutput)
 -> SwitchCase
      TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
        [(NodeIndex, ElementParams)]
elements <- TreeParserState -> [(NodeIndex, ElementParams)]
openElements (TreeParserState -> [(NodeIndex, ElementParams)])
-> StateT TreeParserState (Parser [TreeInput]) TreeParserState
-> StateT
     TreeParserState (Parser [TreeInput]) [(NodeIndex, ElementParams)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
        let errF :: TreeOutput -> TreeOutput
errF = if [(NodeIndex, ElementParams)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(NodeIndex, ElementParams)]
elements Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                then ParseError -> TreeOutput -> TreeOutput
consTreeError ParseError
UnexpectedElementWithImpliedEndTag
                else TreeOutput -> TreeOutput
forall a. a -> a
id
        TreeOutput
eof <- TreeInput -> TreeBuilder TreeOutput
stopParsing TreeInput
t'
        TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeOutput -> TreeBuilder TreeOutput)
-> TreeOutput -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ TreeOutput -> TreeOutput
errF TreeOutput
eof
    , (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else ((TreeInput -> TreeBuilder TreeOutput)
 -> SwitchCase
      TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput)
-> (TreeInput -> TreeBuilder TreeOutput)
-> SwitchCase
     TreeInput (StateT TreeParserState (Parser [TreeInput])) TreeOutput
forall a b. (a -> b) -> a -> b
$ [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
UnexpectedNodeInFrameset]
    ]