{-|
Description:    Token processing rules for spans of raw character strings.

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

Stability:      stable
Portability:    portable
-}
module Web.Mangrove.Parse.Tree.InText
    ( treeInText
    , genericRawTextElement
    , genericRCDataElement
    ) where


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.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 "text" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-incdata)@
-- 
-- The parsing instructions corresponding to the 'InText' section of the state
-- machine.
treeInText :: TreeBuilder TreeOutput
treeInText :: TreeBuilder TreeOutput
treeInText = 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
isCharacter 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
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
        TreeInput -> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState)
 -> StateT TreeParserState (Parser [TreeInput]) ())
-> (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state -> TreeParserState
state
            { insertionMode :: InsertionMode
insertionMode = InsertionMode -> Maybe InsertionMode -> InsertionMode
forall a. a -> Maybe a -> a
Y.fromMaybe InsertionMode
InText (Maybe InsertionMode -> InsertionMode)
-> Maybe InsertionMode -> InsertionMode
forall a b. (a -> b) -> a -> b
$ TreeParserState -> Maybe InsertionMode
originalInsertionMode TreeParserState
state
            , originalInsertionMode :: Maybe InsertionMode
originalInsertionMode = Maybe InsertionMode
forall a. Maybe a
Nothing
            }
        [Patch]
close <- ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
EOFInText ([Patch] -> [Patch])
-> StateT TreeParserState (Parser [TreeInput]) [Patch]
-> StateT TreeParserState (Parser [TreeInput]) [Patch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT TreeParserState (Parser [TreeInput]) [Patch]
closeCurrentNode_
        [Patch] -> TreeBuilder TreeOutput
packTree_ [Patch]
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
isEndTag [String
"script"]) ((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
        StateT TreeParserState (Parser [TreeInput]) ()
resetMode
        [Patch]
close <- StateT TreeParserState (Parser [TreeInput]) [Patch]
closeCurrentNode_
        TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' [Patch]
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 TreeInput -> Bool
isAnyEndTag ((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
        StateT TreeParserState (Parser [TreeInput]) ()
resetMode
        TreeInput -> TreeBuilder TreeOutput
closeCurrentNode TreeInput
t'
    ]


-- | __HTML:__
--      @[generic raw text element parsing algorithm]
--      (https://html.spec.whatwg.org/multipage/parsing.html#generic-raw-text-element-parsing-algorithm)@
-- 
-- Insert an element containing unescaped plain text.
genericRawTextElement :: TreeInput -> TreeBuilder TreeOutput
genericRawTextElement :: TreeInput -> TreeBuilder TreeOutput
genericRawTextElement = CurrentTokenizerState -> TreeInput -> TreeBuilder TreeOutput
genericParsingAlgorithm CurrentTokenizerState
RawTextState

-- | __HTML:__
--      @[generic RCDATA element parsing algorithm]
--      (https://html.spec.whatwg.org/multipage/parsing.html#generic-rcdata-element-parsing-algorithm)@
-- 
-- Insert an element containing plain text, potentially with character
-- references.
genericRCDataElement :: TreeInput -> TreeBuilder TreeOutput
genericRCDataElement :: TreeInput -> TreeBuilder TreeOutput
genericRCDataElement = CurrentTokenizerState -> TreeInput -> TreeBuilder TreeOutput
genericParsingAlgorithm CurrentTokenizerState
RCDataState

-- | __HTML:__
--      @[parsing elements that contain only text]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-elements-that-contain-only-text)@
-- 
-- The actual algorithm described for 'genericRawTextElement' and
-- 'genericRCDataElement', with all variables exported.
genericParsingAlgorithm :: CurrentTokenizerState -> TreeInput -> TreeBuilder TreeOutput
genericParsingAlgorithm :: CurrentTokenizerState -> TreeInput -> TreeBuilder TreeOutput
genericParsingAlgorithm CurrentTokenizerState
mode TreeInput
t' = do
    (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState)
 -> StateT TreeParserState (Parser [TreeInput]) ())
-> (TreeParserState -> TreeParserState)
-> StateT TreeParserState (Parser [TreeInput]) ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state -> TreeParserState
state
        { insertionMode :: InsertionMode
insertionMode = InsertionMode
InText
        , originalInsertionMode :: Maybe InsertionMode
originalInsertionMode = InsertionMode -> Maybe InsertionMode
forall a. a -> Maybe a
Just (InsertionMode -> Maybe InsertionMode)
-> InsertionMode -> Maybe InsertionMode
forall a b. (a -> b) -> a -> b
$ TreeParserState -> InsertionMode
insertionMode TreeParserState
state
        }
    TreeInput -> TreeBuilder TreeOutput
insertElement (TreeInput -> TreeBuilder TreeOutput)
-> ((TokenParserState -> TokenParserState) -> TreeInput)
-> (TokenParserState -> TokenParserState)
-> TreeBuilder TreeOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeInput -> (TokenParserState -> TokenParserState) -> TreeInput
mapTokenState TreeInput
t' ((TokenParserState -> TokenParserState) -> TreeBuilder TreeOutput)
-> (TokenParserState -> TokenParserState) -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ \TokenParserState
state -> TokenParserState
state
        { currentState :: CurrentTokenizerState
currentState = CurrentTokenizerState
mode
        }