{-|
Description:    Token processing rules for content misnested within a @\<table\>@.
Copyright:      (c) 2020-2021 Sam May
License:        MPL-2.0
Maintainer:     ag.eitilt@gmail.com

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


import qualified Data.Foldable as D
import qualified Data.List as L
import qualified Data.Tuple.HT as U.HT

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

import {-# SOURCE #-} Web.Mangrove.Parse.Tree.Dispatcher


-- | __HTML:__
--      @[the "in table text" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intabletext)@
-- 
-- The parsing instructions corresponding to the 'InTableText' section of the
-- state machine.
treeInTableText :: TreeBuilder TreeOutput
treeInTableText :: TreeBuilder TreeOutput
treeInTableText = do
    TreeBuilder ()
resetMode
    [([ParseError], Maybe Char, TokenizerOutputState)]
pending <- TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
treeInTableText'
    let processF :: TreeInput -> TreeBuilder TreeOutput
processF = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (([ParseError], Maybe Char, TokenizerOutputState) -> Bool)
-> [([ParseError], Maybe Char, TokenizerOutputState)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Char -> Bool
isAsciiWhitespace (Maybe Char -> Bool)
-> (([ParseError], Maybe Char, TokenizerOutputState) -> Maybe Char)
-> ([ParseError], Maybe Char, TokenizerOutputState)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ParseError], Maybe Char, TokenizerOutputState) -> Maybe Char
forall a b c. (a, b, c) -> b
U.HT.snd3) [([ParseError], Maybe Char, TokenizerOutputState)]
pending
            then TreeInput -> TreeBuilder TreeOutput
anythingElse
            else TreeInput -> TreeBuilder TreeOutput
insertCharacter
    [TreeOutput]
ps <- (([ParseError], Maybe Char, TokenizerOutputState)
 -> [TreeOutput]
 -> StateT TreeParserState (Parser [TreeInput]) [TreeOutput])
-> [TreeOutput]
-> [([ParseError], Maybe Char, TokenizerOutputState)]
-> StateT TreeParserState (Parser [TreeInput]) [TreeOutput]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
D.foldrM ((TreeInput -> TreeBuilder TreeOutput)
-> ([ParseError], Maybe Char, TokenizerOutputState)
-> [TreeOutput]
-> StateT TreeParserState (Parser [TreeInput]) [TreeOutput]
repack TreeInput -> TreeBuilder TreeOutput
processF) [] [([ParseError], Maybe Char, TokenizerOutputState)]
pending
    TreeOutput
start <- [Patch] -> TreeBuilder TreeOutput
packTree_ []
    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 -> TreeOutput)
-> TreeOutput -> [TreeOutput] -> TreeOutput
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr TreeOutput -> TreeOutput -> TreeOutput
foldOut TreeOutput
start [TreeOutput]
ps
  where repack :: (TreeInput -> TreeBuilder TreeOutput)
-> ([ParseError], Maybe Char, TokenizerOutputState)
-> [TreeOutput]
-> StateT TreeParserState (Parser [TreeInput]) [TreeOutput]
repack TreeInput -> TreeBuilder TreeOutput
_ ([], Maybe Char
Nothing, TokenizerOutputState
_) [] = [TreeOutput]
-> StateT TreeParserState (Parser [TreeInput]) [TreeOutput]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        repack TreeInput -> TreeBuilder TreeOutput
_ ([ParseError]
errs, Maybe Char
Nothing, TokenizerOutputState
_) [] = TreeOutput -> [TreeOutput]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeOutput -> [TreeOutput])
-> (TreeOutput -> TreeOutput) -> TreeOutput -> [TreeOutput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParseError] -> TreeOutput -> TreeOutput
consTreeErrors [ParseError]
errs (TreeOutput -> [TreeOutput])
-> TreeBuilder TreeOutput
-> StateT TreeParserState (Parser [TreeInput]) [TreeOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeBuilder TreeOutput
dispatchHtml
        repack TreeInput -> TreeBuilder TreeOutput
_ ([ParseError]
errs, Maybe Char
Nothing, TokenizerOutputState
_) (TreeOutput
t:[TreeOutput]
ts) = [TreeOutput]
-> StateT TreeParserState (Parser [TreeInput]) [TreeOutput]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TreeOutput]
 -> StateT TreeParserState (Parser [TreeInput]) [TreeOutput])
-> [TreeOutput]
-> StateT TreeParserState (Parser [TreeInput]) [TreeOutput]
forall a b. (a -> b) -> a -> b
$ [ParseError] -> TreeOutput -> TreeOutput
consTreeErrors [ParseError]
errs TreeOutput
t TreeOutput -> [TreeOutput] -> [TreeOutput]
forall a. a -> [a] -> [a]
: [TreeOutput]
ts
        repack TreeInput -> TreeBuilder TreeOutput
f ([ParseError]
errs, Just Char
c, TokenizerOutputState
state) [TreeOutput]
ts = (TreeOutput -> [TreeOutput] -> [TreeOutput]
forall a. a -> [a] -> [a]
: [TreeOutput]
ts) (TreeOutput -> [TreeOutput])
-> TreeBuilder TreeOutput
-> StateT TreeParserState (Parser [TreeInput]) [TreeOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeInput -> TreeBuilder TreeOutput
f ([ParseError] -> Token -> TokenizerOutputState -> TreeInput
dummyStateToken [ParseError]
errs (Char -> Token
Character Char
c) TokenizerOutputState
state)
        foldOut :: TreeOutput -> TreeOutput -> TreeOutput
foldOut TreeOutput
ps TreeOutput
ps' = TreeOutput
ps' { treePatches :: [Patch]
treePatches = TreeOutput -> [Patch]
treePatches TreeOutput
ps [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ TreeOutput -> [Patch]
treePatches TreeOutput
ps' }
        consTreeErrors :: [ParseError] -> TreeOutput -> TreeOutput
consTreeErrors = (TreeOutput -> [ParseError] -> TreeOutput)
-> [ParseError] -> TreeOutput -> TreeOutput
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((TreeOutput -> [ParseError] -> TreeOutput)
 -> [ParseError] -> TreeOutput -> TreeOutput)
-> (TreeOutput -> [ParseError] -> TreeOutput)
-> [ParseError]
-> TreeOutput
-> TreeOutput
forall a b. (a -> b) -> a -> b
$ (ParseError -> TreeOutput -> TreeOutput)
-> TreeOutput -> [ParseError] -> TreeOutput
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ParseError -> TreeOutput -> TreeOutput
consTreeError

-- | __HTML:__
--      @[the "in table" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intable)@
-- 
-- The parsing instructions corresponding to the 'InTableText' section of the
-- state machine.  Specifically, this consumes all following 'Character' tokens
-- to construct the list of [pending table character tokens]
-- (https://html.spec.whatwg.org/multipage/parsing.html#concept-pending-table-char-tokens),
-- while the surrounding 'treeInTableText' is what actually sends them to the
-- 'InTable' state for insertion.
treeInTableText' :: TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
treeInTableText' :: TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
treeInTableText' = StateT TreeParserState (Parser [TreeInput]) TreeInput
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT TreeParserState (Parser [TreeInput]) TreeInput
-> (TreeInput
    -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SwitchCase
   TreeInput
   (StateT TreeParserState (Parser [TreeInput]))
   [([ParseError], Maybe Char, TokenizerOutputState)]]
-> TreeInput
-> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
forall (m :: * -> *) test out.
Alternative m =>
[SwitchCase test m out] -> test -> m out
switch
    [ (TreeInput -> Bool)
-> (TreeInput
    -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> SwitchCase
     TreeInput
     (StateT TreeParserState (Parser [TreeInput]))
     [([ParseError], Maybe Char, TokenizerOutputState)]
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If TreeInput -> Bool
isNull ((TreeInput
  -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
 -> SwitchCase
      TreeInput
      (StateT TreeParserState (Parser [TreeInput]))
      [([ParseError], Maybe Char, TokenizerOutputState)])
-> (TreeInput
    -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> SwitchCase
     TreeInput
     (StateT TreeParserState (Parser [TreeInput]))
     [([ParseError], Maybe Char, TokenizerOutputState)]
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
        [([ParseError], Maybe Char, TokenizerOutputState)]
cs <- TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
treeInTableText'
        [([ParseError], Maybe Char, TokenizerOutputState)]
-> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([([ParseError], Maybe Char, TokenizerOutputState)]
 -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> [([ParseError], Maybe Char, TokenizerOutputState)]
-> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
forall a b. (a -> b) -> a -> b
$ (ParseError
UnexpectedNullCharacter ParseError -> [ParseError] -> [ParseError]
forall a. a -> [a] -> [a]
: TreeInput -> [ParseError]
tokenErrs TreeInput
t', Maybe Char
forall a. Maybe a
Nothing, TreeInput -> TokenizerOutputState
tokenState TreeInput
t') ([ParseError], Maybe Char, TokenizerOutputState)
-> [([ParseError], Maybe Char, TokenizerOutputState)]
-> [([ParseError], Maybe Char, TokenizerOutputState)]
forall a. a -> [a] -> [a]
: [([ParseError], Maybe Char, TokenizerOutputState)]
cs
    , (TreeInput -> Bool)
-> (TreeInput
    -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> SwitchCase
     TreeInput
     (StateT TreeParserState (Parser [TreeInput]))
     [([ParseError], Maybe Char, TokenizerOutputState)]
forall test (m :: * -> *) out.
(test -> Bool) -> (test -> m out) -> SwitchCase test m out
If TreeInput -> Bool
isCharacter ((TreeInput
  -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
 -> SwitchCase
      TreeInput
      (StateT TreeParserState (Parser [TreeInput]))
      [([ParseError], Maybe Char, TokenizerOutputState)])
-> (TreeInput
    -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> SwitchCase
     TreeInput
     (StateT TreeParserState (Parser [TreeInput]))
     [([ParseError], Maybe Char, TokenizerOutputState)]
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
        [([ParseError], Maybe Char, TokenizerOutputState)]
cs <- TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
treeInTableText'
        [([ParseError], Maybe Char, TokenizerOutputState)]
-> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([([ParseError], Maybe Char, TokenizerOutputState)]
 -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> [([ParseError], Maybe Char, TokenizerOutputState)]
-> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
forall a b. (a -> b) -> a -> b
$ (TreeInput -> [ParseError]
tokenErrs TreeInput
t', TreeInput -> Maybe Char
tokenCharacter TreeInput
t', TreeInput -> TokenizerOutputState
tokenState TreeInput
t') ([ParseError], Maybe Char, TokenizerOutputState)
-> [([ParseError], Maybe Char, TokenizerOutputState)]
-> [([ParseError], Maybe Char, TokenizerOutputState)]
forall a. a -> [a] -> [a]
: [([ParseError], Maybe Char, TokenizerOutputState)]
cs
    , (TreeInput
 -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> SwitchCase
     TreeInput
     (StateT TreeParserState (Parser [TreeInput]))
     [([ParseError], Maybe Char, TokenizerOutputState)]
forall test (m :: * -> *) out.
(test -> m out) -> SwitchCase test m out
Else ((TreeInput
  -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
 -> SwitchCase
      TreeInput
      (StateT TreeParserState (Parser [TreeInput]))
      [([ParseError], Maybe Char, TokenizerOutputState)])
-> (TreeInput
    -> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)])
-> SwitchCase
     TreeInput
     (StateT TreeParserState (Parser [TreeInput]))
     [([ParseError], Maybe Char, TokenizerOutputState)]
forall a b. (a -> b) -> a -> b
$ \TreeInput
t' -> do
        TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        [([ParseError], Maybe Char, TokenizerOutputState)]
-> TreeBuilder [([ParseError], Maybe Char, TokenizerOutputState)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    ]