{-# LANGUAGE OverloadedStrings #-}

{-|
Description:    Token processing rules within the @\<body\>@ section.

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

Stability:      provisional
Portability:    portable
-}
module Web.Mangrove.Parse.Tree.InBody
    ( treeInBody
    ) where


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

import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import qualified Data.Maybe as Y
import qualified Data.Text as T

import Web.Willow.DOM

import Web.Mangrove.Parse.Common.Error
import Web.Mangrove.Parse.Tokenize.Common
import Web.Mangrove.Parse.Tree.Common
import Web.Mangrove.Parse.Tree.InHead
import Web.Mangrove.Parse.Tree.InTemplate
import Web.Mangrove.Parse.Tree.InText
import Web.Mangrove.Parse.Tree.Patch
import Web.Willow.Common.Parser
import Web.Willow.Common.Parser.Switch

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

import Control.Applicative ( (<|>) )
import Data.Functor ( ($>) )


-- | __HTML:__
--      @[the "in body" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inbody)@
-- 
-- The parsing instructions corresponding to the 'InBody' section of the state
-- machine.
treeInBody :: TreeBuilder TreeOutput
treeInBody :: TreeBuilder TreeOutput
treeInBody = 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
isNull ((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
UnexpectedNullCharacter]
    , (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)
 -> 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
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertCharacter 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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)
 -> 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
        TreeBuilder ()
setFramesetNotOk
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertCharacter 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
        TreeOutput
errs <- [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
NestedSingletonElement] TreeInput
t'
        [(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
        if Maybe (NodeIndex, ElementParams) -> Bool
forall a. Maybe a -> Bool
Y.isJust (Maybe (NodeIndex, ElementParams) -> Bool)
-> Maybe (NodeIndex, ElementParams) -> Bool
forall a b. (a -> b) -> a -> b
$ ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Text -> ElementParams -> Bool
nodeIsElement Text
"template" (ElementParams -> Bool)
-> ((NodeIndex, ElementParams) -> ElementParams)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd) [(NodeIndex, ElementParams)]
elements
            then TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
            else case [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. [a] -> [a]
reverse [(NodeIndex, ElementParams)]
elements of
                [] -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
                ((NodeIndex
i, ElementParams
_):[(NodeIndex, ElementParams)]
_) -> do
                    [[Patch]]
add <- (BasicAttribute -> TreeBuilder [Patch])
-> [BasicAttribute]
-> StateT TreeParserState (Parser [TreeInput]) [[Patch]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (InsertAt -> NodeIndex -> BasicAttribute -> TreeBuilder [Patch]
addAttribute InsertAt
InHtmlElement NodeIndex
i) ([BasicAttribute]
 -> StateT TreeParserState (Parser [TreeInput]) [[Patch]])
-> (TagParams -> [BasicAttribute])
-> TagParams
-> StateT TreeParserState (Parser [TreeInput]) [[Patch]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        HashMap Text Text -> [BasicAttribute]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap Text Text -> [BasicAttribute])
-> (TagParams -> HashMap Text Text)
-> TagParams
-> [BasicAttribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagParams -> HashMap Text Text
tagAttributes (TagParams
 -> StateT TreeParserState (Parser [TreeInput]) [[Patch]])
-> TagParams
-> StateT TreeParserState (Parser [TreeInput]) [[Patch]]
forall a b. (a -> b) -> a -> b
$ TreeInput -> TagParams
tokenTag 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
errs TreeOutput -> [Patch] -> TreeOutput
|++ [[Patch]] -> [Patch]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Patch]]
add
    , (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
"base"
        , String
"basefont"
        , String
"bgsound"
        , String
"link"
        , String
"meta"
        , String
"noframes"
        , String
"script"
        , String
"style"
        , String
"template"
        , String
"title"
        ]) ((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 -> TreeBuilder ()
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 ([String] -> TreeInput -> Bool
isEndTag [String
"template"]) ((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 -> TreeBuilder ()
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 ([String] -> TreeInput -> Bool
isStartTag [String
"body"]) ((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
        TreeOutput
errs <- [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
NestedSingletonElement] TreeInput
t'
        [(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
        case [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. [a] -> [a]
reverse [(NodeIndex, ElementParams)]
elements of
            [] -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
            [(NodeIndex, ElementParams)
_] -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
            [(NodeIndex, ElementParams)]
es | Maybe (NodeIndex, ElementParams) -> Bool
forall a. Maybe a -> Bool
Y.isJust (Maybe (NodeIndex, ElementParams) -> Bool)
-> Maybe (NodeIndex, ElementParams) -> Bool
forall a b. (a -> b) -> a -> b
$ ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Text -> ElementParams -> Bool
nodeIsElement Text
"template" (ElementParams -> Bool)
-> ((NodeIndex, ElementParams) -> ElementParams)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd) [(NodeIndex, ElementParams)]
es -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
            ((NodeIndex, ElementParams)
_:(NodeIndex
i, ElementParams
e):[(NodeIndex, ElementParams)]
es)
                | Bool -> Bool
not (Text -> ElementParams -> Bool
nodeIsElement Text
"body" ElementParams
e) -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
                | Bool
otherwise -> do
                    TreeBuilder ()
setFramesetNotOk
                    [[Patch]]
add <- (BasicAttribute -> TreeBuilder [Patch])
-> [BasicAttribute]
-> StateT TreeParserState (Parser [TreeInput]) [[Patch]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                        (InsertAt -> NodeIndex -> BasicAttribute -> TreeBuilder [Patch]
addAttribute (ReparentDepth -> InsertAt
RelativeLocation (ReparentDepth -> InsertAt)
-> (Int -> ReparentDepth) -> Int -> InsertAt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReparentDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> InsertAt) -> Int -> InsertAt
forall a b. (a -> b) -> a -> b
$ [(NodeIndex, ElementParams)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(NodeIndex, ElementParams)]
es) NodeIndex
i) ([BasicAttribute]
 -> StateT TreeParserState (Parser [TreeInput]) [[Patch]])
-> (TagParams -> [BasicAttribute])
-> TagParams
-> StateT TreeParserState (Parser [TreeInput]) [[Patch]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        HashMap Text Text -> [BasicAttribute]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap Text Text -> [BasicAttribute])
-> (TagParams -> HashMap Text Text)
-> TagParams
-> [BasicAttribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagParams -> HashMap Text Text
tagAttributes (TagParams
 -> StateT TreeParserState (Parser [TreeInput]) [[Patch]])
-> TagParams
-> StateT TreeParserState (Parser [TreeInput]) [[Patch]]
forall a b. (a -> b) -> a -> b
$ TreeInput -> TagParams
tokenTag 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
errs TreeOutput -> [Patch] -> TreeOutput
|++ [[Patch]] -> [Patch]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Patch]]
add
    , (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)
 -> 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
        let elements :: [ElementParams]
elements = ((NodeIndex, ElementParams) -> ElementParams)
-> [(NodeIndex, ElementParams)] -> [ElementParams]
forall a b. (a -> b) -> [a] -> [b]
map (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd ([(NodeIndex, ElementParams)] -> [ElementParams])
-> [(NodeIndex, ElementParams)] -> [ElementParams]
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
            err :: ParseError
err = ElementParams -> ParseError
FramesetInBody (ElementParams -> ParseError) -> ElementParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement TreeInput
t'
        TreeOutput
errs <- [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
err] TreeInput
t'
        case [ElementParams] -> [ElementParams]
forall a. [a] -> [a]
reverse [ElementParams]
elements of
            [] -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
            [ElementParams
_] -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
            (ElementParams
_:ElementParams
e:[ElementParams]
_) | Bool -> Bool
not (Text -> ElementParams -> Bool
nodeIsElement Text
"body" ElementParams
e) -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
            [ElementParams]
_ | Bool -> Bool
not (TreeParserState -> Bool
framesetOk TreeParserState
state) -> TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOutput
errs
            [ElementParams]
_ -> do
                [[Patch]]
clear <- Int
-> TreeBuilder [Patch]
-> StateT TreeParserState (Parser [TreeInput]) [[Patch]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
N.replicateM ([ElementParams] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ElementParams]
elements Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) TreeBuilder [Patch]
dropCurrentNode
                TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement TreeInput
t'
                InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InFrameset
                TreeOutput -> TreeBuilder TreeOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeOutput -> TreeBuilder TreeOutput)
-> (TreeOutput -> TreeOutput)
-> TreeOutput
-> TreeBuilder TreeOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> TreeOutput -> TreeOutput
consTreeError ParseError
err (TreeOutput -> TreeBuilder TreeOutput)
-> TreeOutput -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [[Patch]] -> [Patch]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Patch]]
clear [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
        [InsertionMode]
modes <- TreeParserState -> [InsertionMode]
templateInsertionModes (TreeParserState -> [InsertionMode])
-> StateT TreeParserState (Parser [TreeInput]) TreeParserState
-> StateT TreeParserState (Parser [TreeInput]) [InsertionMode]
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
        if [InsertionMode] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InsertionMode]
modes
            then do
                Bool
hasUnexpected <- TreeBuilder Bool
hasUnexpectedOpenElement
                if Bool
hasUnexpected
                    then ParseError -> TreeOutput -> TreeOutput
consTreeError ParseError
UnexpectedElementWithImpliedEndTag (TreeOutput -> TreeOutput)
-> TreeBuilder TreeOutput -> TreeBuilder TreeOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeInput -> TreeBuilder TreeOutput
stopParsing TreeInput
t'
                    else TreeInput -> TreeBuilder TreeOutput
stopParsing TreeInput
t'
            else do
                TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
                TreeBuilder TreeOutput
treeInTemplate
    , (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
"body"]) ((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
        InsertionMode -> TreeBuilder ()
switchMode InsertionMode
AfterBody
        Bool
hasBody <- [Text] -> TreeBuilder Bool
hasInScope [Text
"body"]
        Bool
hasUnexpected <- TreeBuilder Bool
hasUnexpectedOpenElement
        if Bool
hasBody
            then if Bool
hasUnexpected
                then [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
UnexpectedElementWithImpliedEndTag] TreeInput
t'
                else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'
            else [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'
    , (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
"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 -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
t'
        InsertionMode -> TreeBuilder ()
switchMode InsertionMode
AfterBody
        Bool
hasBody <- [Text] -> TreeBuilder Bool
hasInScope [Text
"body"]
        Bool
hasUnexpected <- TreeBuilder Bool
hasUnexpectedOpenElement
        if Bool
hasBody
            then if Bool
hasUnexpected
                then ParseError -> TreeOutput -> TreeOutput
consTreeError ParseError
UnexpectedElementWithImpliedEndTag (TreeOutput -> TreeOutput)
-> TreeBuilder TreeOutput -> TreeBuilder TreeOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeBuilder TreeOutput
dispatchHtml
                else [ParseError] -> TreeBuilder TreeOutput
packTreeErrors_ []
            else ParseError -> TreeOutput -> TreeOutput
consTreeError (ElementParams -> ParseError
UnmatchedEndTag (ElementParams -> ParseError) -> ElementParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement TreeInput
t') (TreeOutput -> TreeOutput)
-> TreeBuilder TreeOutput -> TreeBuilder TreeOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeBuilder TreeOutput
dispatchHtml
    , (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
"address"
        , String
"article"
        , String
"aside"
        , String
"blockquote"
        , String
"center"
        , String
"details"
        , String
"dialog"
        , String
"dir"
        , String
"div"
        , String
"dl"
        , String
"fieldset"
        , String
"figcaption"
        , String
"figure"
        , String
"footer"
        , String
"header"
        , String
"hgroup"
        , String
"main"
        , String
"menu"
        , String
"nav"
        , String
"ol"
        , String
"p"
        , String
"section"
        , String
"summary"
        , String
"ul"
        ]) ((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
            Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
            if Bool
hasP
                then do
                    [Patch]
close <- TreeBuilder [Patch]
closePElement
                    TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
close [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
                else TreeInput -> TreeBuilder TreeOutput
insertElement 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] -> TreeInput -> Bool) -> [String] -> TreeInput -> Bool
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
headerNames) ((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
        Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        [Patch]
close <- if Bool
hasP
            then TreeBuilder [Patch]
closePElement
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        [Patch]
nest <- case (ElementParams -> Text) -> Maybe ElementParams -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElementParams -> Text
elementName Maybe ElementParams
current of
            Just Text
h | Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
h [Text]
headerNames -> ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
OverlappingHeaderElements ([Patch] -> [Patch]) -> TreeBuilder [Patch] -> TreeBuilder [Patch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeBuilder [Patch]
closeCurrentNode_
            Maybe Text
_ -> [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
close [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
nest [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"pre", String
"listing"]) ((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
lineFeed <- StateT TreeParserState (Parser [TreeInput]) TreeInput
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next
        TokenizerOutputState
lineFeedState <- if TreeInput -> Token
tokenOut TreeInput
lineFeed Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Character Char
'\n'
            then TokenizerOutputState
-> StateT TreeParserState (Parser [TreeInput]) TokenizerOutputState
forall (m :: * -> *) a. Monad m => a -> m a
return (TokenizerOutputState
 -> StateT
      TreeParserState (Parser [TreeInput]) TokenizerOutputState)
-> TokenizerOutputState
-> StateT TreeParserState (Parser [TreeInput]) TokenizerOutputState
forall a b. (a -> b) -> a -> b
$ TreeInput -> TokenizerOutputState
tokenState TreeInput
lineFeed
            else TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
lineFeed TreeBuilder ()
-> TokenizerOutputState
-> StateT TreeParserState (Parser [TreeInput]) TokenizerOutputState
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TokenizerOutputState
forall a. Maybe a
Nothing
        TreeBuilder ()
setFramesetNotOk
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        [Patch]
close <- if Bool
hasP
            then TreeBuilder [Patch]
closePElement
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement (TreeInput -> TreeBuilder TreeOutput)
-> TreeInput -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ TreeInput
-> (TokenizerOutputState -> TokenizerOutputState) -> TreeInput
mapTokenState' TreeInput
t' (TokenizerOutputState
lineFeedState TokenizerOutputState
-> TokenizerOutputState -> TokenizerOutputState
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>)
        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
$ [Patch]
close [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"form"]) ((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
        let hasTemplate :: Bool
hasTemplate = ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> ElementParams -> Bool
nodeIsElement Text
"template" (ElementParams -> Bool)
-> ((NodeIndex, ElementParams) -> ElementParams)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd) ([(NodeIndex, ElementParams)] -> Bool)
-> [(NodeIndex, ElementParams)] -> Bool
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
        if Bool
hasTemplate Bool -> Bool -> Bool
|| Maybe NodeIndex -> Bool
forall a. Maybe a -> Bool
Y.isJust (TreeParserState -> Maybe NodeIndex
formElementPointer TreeParserState
state)
            then [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'
            else do
                Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
                [Patch]
close <- if Bool
hasP
                    then TreeBuilder [Patch]
closePElement
                    else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState) -> TreeBuilder ())
-> (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state' -> TreeParserState
state'
                    { formElementPointer :: Maybe NodeIndex
formElementPointer = NodeIndex -> Maybe NodeIndex
forall a. a -> Maybe a
Just (NodeIndex -> Maybe NodeIndex) -> NodeIndex -> Maybe NodeIndex
forall a b. (a -> b) -> a -> b
$ TreeParserState -> NodeIndex
elementIndex TreeParserState
state'
                    }
                TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
close [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"li"]) ((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
        TreeBuilder ()
setFramesetNotOk
        TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
        [Patch]
clear <- [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
liLoop ([(NodeIndex, ElementParams)] -> TreeBuilder [Patch])
-> [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        [Patch]
close <- if Bool
hasP
            then TreeBuilder [Patch]
closePElement
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
clear [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
close [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"dd", String
"dt"]) ((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
        TreeBuilder ()
setFramesetNotOk
        TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
        [Patch]
clear <- [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
ddLoop ([(NodeIndex, ElementParams)] -> TreeBuilder [Patch])
-> [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        [Patch]
close <- if Bool
hasP
            then TreeBuilder [Patch]
closePElement
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
clear [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
close [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"plaintext"]) ((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
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        [Patch]
close <- if Bool
hasP
            then TreeBuilder [Patch]
closePElement
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- 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
PlainTextState
            }
        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
$ [Patch]
close [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"button"]) ((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
        Bool
hasButton <- [Text] -> TreeBuilder Bool
hasInScope [Text
"button"]
        [Patch]
nested <- if Bool
hasButton
            then do
                [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags [Text]
impliedEndTags
                [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement Text
"button"
                [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Patch] -> TreeBuilder [Patch])
-> ([Patch] -> [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
NestedNonRecursiveElement ([Patch] -> TreeBuilder [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
clear
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement TreeInput
t'
        TreeBuilder ()
setFramesetNotOk
        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
$ [Patch]
nested [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"address"
        , String
"article"
        , String
"aside"
        , String
"blockquote"
        , String
"button"
        , String
"center"
        , String
"details"
        , String
"dialog"
        , String
"dir"
        , String
"div"
        , String
"dl"
        , String
"fieldset"
        , String
"figcaption"
        , String
"figure"
        , String
"footer"
        , String
"header"
        , String
"hgroup"
        , String
"listing"
        , String
"main"
        , String
"menu"
        , String
"nav"
        , String
"ol"
        , String
"pre"
        , String
"section"
        , String
"summary"
        , String
"ul"
        ]) ((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
            let d :: TagParams
d = TreeInput -> TagParams
tokenTag TreeInput
t'
            Bool
hasMatch <- [Text] -> TreeBuilder Bool
hasInScope [TagParams -> Text
tagName TagParams
d]
            if Bool
hasMatch
                then do
                    [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags [Text]
impliedEndTags
                    Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
                    let errF :: [Patch] -> [Patch]
errF = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement (Text -> ElementParams -> Bool) -> Text -> ElementParams -> Bool
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d) Maybe ElementParams
current
                            then [Patch] -> [Patch]
forall a. a -> a
id
                            else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                    [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement (Text -> TreeBuilder [Patch]) -> Text -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d
                    TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
clear
                else [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'
    , (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
"form"]) ((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
        if Maybe (NodeIndex, ElementParams) -> Bool
forall a. Maybe a -> Bool
Y.isJust (Maybe (NodeIndex, ElementParams) -> Bool)
-> ([(NodeIndex, ElementParams)]
    -> Maybe (NodeIndex, ElementParams))
-> [(NodeIndex, ElementParams)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Text -> ElementParams -> Bool
nodeIsElement Text
"template" (ElementParams -> Bool)
-> ((NodeIndex, ElementParams) -> ElementParams)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd) ([(NodeIndex, ElementParams)] -> Bool)
-> [(NodeIndex, ElementParams)] -> Bool
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
            then do
                Bool
hasTemplate <- [Text] -> TreeBuilder Bool
hasInScope [Text
"template"]
                if Bool
hasTemplate
                    then do
                        [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags [Text]
impliedEndTags
                        Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
                        let errF :: [Patch] -> [Patch]
errF = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement Text
"form") Maybe ElementParams
current
                                then [Patch] -> [Patch]
forall a. a -> a
id
                                else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                        [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement Text
"form"
                        TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
clear
                    else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'
            else do
                let formElement :: Maybe NodeIndex
formElement = TreeParserState -> Maybe NodeIndex
formElementPointer TreeParserState
state
                TreeParserState -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
N.S.put (TreeParserState -> TreeBuilder ())
-> TreeParserState -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ TreeParserState
state
                    { formElementPointer :: Maybe NodeIndex
formElementPointer = Maybe NodeIndex
forall a. Maybe a
Nothing
                    }
                Bool
hasFormElement <- TreeBuilder Bool
-> (NodeIndex -> TreeBuilder Bool)
-> Maybe NodeIndex
-> TreeBuilder Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> TreeBuilder Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) NodeIndex -> TreeBuilder Bool
hasIndexInScope Maybe NodeIndex
formElement
                if Bool
hasFormElement
                    then do
                        [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags [Text]
impliedEndTags
                        let current :: NodeIndex
current = NodeIndex
-> ((NodeIndex, ElementParams) -> NodeIndex)
-> Maybe (NodeIndex, ElementParams)
-> NodeIndex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeIndex
0 (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst (Maybe (NodeIndex, ElementParams) -> NodeIndex)
-> ([(NodeIndex, ElementParams)]
    -> Maybe (NodeIndex, ElementParams))
-> [(NodeIndex, ElementParams)]
-> NodeIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams)
forall a. [a] -> Maybe a
Y.listToMaybe ([(NodeIndex, ElementParams)] -> NodeIndex)
-> [(NodeIndex, ElementParams)] -> NodeIndex
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
                            es :: [(NodeIndex, ElementParams)]
es = ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (NodeIndex -> NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (NodeIndex -> Maybe NodeIndex -> NodeIndex
forall a. a -> Maybe a -> a
Y.fromMaybe NodeIndex
current Maybe NodeIndex
formElement) (NodeIndex -> Bool)
-> ((NodeIndex, ElementParams) -> NodeIndex)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst) ([(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)])
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a b. (a -> b) -> a -> b
$
                                TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
                            errF :: [Patch] -> [Patch]
errF = if [(NodeIndex, ElementParams)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(NodeIndex, ElementParams)]
es
                                then [Patch] -> [Patch]
forall a. a -> a
id
                                else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                        [Patch]
close <- ReparentDepth -> TreeBuilder [Patch]
closeAncestorNode_ (ReparentDepth -> TreeBuilder [Patch])
-> (Int -> ReparentDepth) -> Int -> TreeBuilder [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReparentDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> TreeBuilder [Patch]) -> Int -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [(NodeIndex, ElementParams)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(NodeIndex, ElementParams)]
es
                        TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
close
                    else [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'
    , (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
"p"]) ((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
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        [Patch]
ps <- if Bool
hasP
            then TreeBuilder [Patch]
closePElement
            else ([Patch] -> [Patch]) -> TreeBuilder [Patch] -> TreeBuilder [Patch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseError -> [Patch] -> [Patch]
consTreeError_ (ParseError -> [Patch] -> [Patch])
-> (ElementParams -> ParseError)
-> ElementParams
-> [Patch]
-> [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElementParams -> ParseError
UnmatchedEndTag (ElementParams -> [Patch] -> [Patch])
-> ElementParams -> [Patch] -> [Patch]
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement TreeInput
t') (TreeBuilder [Patch] -> TreeBuilder [Patch])
-> (TagParams -> TreeBuilder [Patch])
-> TagParams
-> TreeBuilder [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagParams -> TreeBuilder [Patch]
insertNullElement_ (TagParams -> TreeBuilder [Patch])
-> TagParams -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TagParams
emptyTagParams
                { tagName :: Text
tagName = Text
"p"
                }
        TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' [Patch]
ps
    , (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
"li"]) ((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
        Bool
hasLi <- [Text] -> TreeBuilder Bool
hasInListItemScope [Text
"li"]
        if Bool
hasLi
            then do
                [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags ([Text] -> TreeBuilder [Patch]) -> [Text] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
L.delete Text
"li" [Text]
impliedEndTags
                Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
                let errF :: [Patch] -> [Patch]
errF = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement Text
"li") Maybe ElementParams
current
                        then [Patch] -> [Patch]
forall a. a -> a
id
                        else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement Text
"li"
                TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
clear
            else [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'
    , (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
"dd", String
"dt"]) ((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
        let d :: TagParams
d = TreeInput -> TagParams
tokenTag TreeInput
t'
        Bool
hasMatch <- [Text] -> TreeBuilder Bool
hasInScope [TagParams -> Text
tagName TagParams
d]
        if Bool
hasMatch
            then do
                [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags ([Text] -> TreeBuilder [Patch]) -> [Text] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
L.delete (TagParams -> Text
tagName TagParams
d) [Text]
impliedEndTags
                Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
                let errF :: [Patch] -> [Patch]
errF = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement (Text -> ElementParams -> Bool) -> Text -> ElementParams -> Bool
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d) Maybe ElementParams
current
                        then [Patch] -> [Patch]
forall a. a -> a
id
                        else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement (Text -> TreeBuilder [Patch]) -> Text -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d
                TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
clear
            else [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'
    , (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] -> TreeInput -> Bool) -> [String] -> TreeInput -> Bool
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
headerNames) ((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
        let d :: TagParams
d = TreeInput -> TagParams
tokenTag TreeInput
t'
        Bool
hasMatch <- [Text] -> TreeBuilder Bool
hasInScope [Text]
headerNames
        if Bool
hasMatch
            then do
                [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags ([Text] -> TreeBuilder [Patch]) -> [Text] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
L.delete (TagParams -> Text
tagName TagParams
d) [Text]
impliedEndTags
                Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
                let errF :: [Patch] -> [Patch]
errF = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement (Text -> ElementParams -> Bool) -> Text -> ElementParams -> Bool
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d) Maybe ElementParams
current
                        then [Patch] -> [Patch]
forall a. a -> a
id
                        else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                [Patch]
clear <- [Text] -> TreeBuilder [Patch]
closeElements [Text]
headerNames
                TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
clear
            else [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'
    , (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
"a"]) ((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
        let formatting :: [[(NodeIndex, TagParams)]]
formatting = TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements TreeParserState
state
            active :: [(NodeIndex, TagParams)]
active = [(NodeIndex, TagParams)]
-> Maybe [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)]
forall a. a -> Maybe a -> a
Y.fromMaybe [] (Maybe [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)])
-> Maybe [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)]
forall a b. (a -> b) -> a -> b
$ [[(NodeIndex, TagParams)]] -> Maybe [(NodeIndex, TagParams)]
forall a. [a] -> Maybe a
Y.listToMaybe [[(NodeIndex, TagParams)]]
formatting
        TreeOutput
nested <- case ((NodeIndex, TagParams) -> Bool)
-> [(NodeIndex, TagParams)] -> Maybe (NodeIndex, TagParams)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(NodeIndex, TagParams)
f -> TagParams -> Text
tagName ((NodeIndex, TagParams) -> TagParams
forall a b. (a, b) -> b
snd (NodeIndex, TagParams)
f) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"a") [(NodeIndex, TagParams)]
active of
            Just (NodeIndex
i, TagParams
_) -> do
                TreeOutput
adopt <- ParseError -> TreeOutput -> TreeOutput
consTreeError ParseError
NestedElementForAdoptionAgency (TreeOutput -> TreeOutput)
-> TreeBuilder TreeOutput -> TreeBuilder TreeOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeInput -> TreeBuilder TreeOutput
runAdoptionAgency TreeInput
t'
                [(NodeIndex, ElementParams)]
open' <- 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
                [Patch]
close <- case ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)]
-> ([(NodeIndex, ElementParams)], [(NodeIndex, ElementParams)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (NodeIndex -> NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
(==) NodeIndex
i (NodeIndex -> Bool)
-> ((NodeIndex, ElementParams) -> NodeIndex)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst) [(NodeIndex, ElementParams)]
open' of
                    ([(NodeIndex, ElementParams)]
_, []) -> [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                    ([(NodeIndex, ElementParams)]
es1, [(NodeIndex, ElementParams)]
_) -> do
                        (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState) -> TreeBuilder ())
-> (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state' -> TreeParserState
state'
                            { activeFormattingElements :: [[(NodeIndex, TagParams)]]
activeFormattingElements = case TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements TreeParserState
state' of
                                [] -> []
                                ([(NodeIndex, TagParams)]
es:[[(NodeIndex, TagParams)]]
ess) -> ((NodeIndex, TagParams) -> Bool)
-> [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)]
forall a. (a -> Bool) -> [a] -> [a]
filter (NodeIndex -> NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
(/=) NodeIndex
i (NodeIndex -> Bool)
-> ((NodeIndex, TagParams) -> NodeIndex)
-> (NodeIndex, TagParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, TagParams) -> NodeIndex
forall a b. (a, b) -> a
fst) [(NodeIndex, TagParams)]
es [(NodeIndex, TagParams)]
-> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a. a -> [a] -> [a]
: [[(NodeIndex, TagParams)]]
ess
                            }
                        ReparentDepth -> TreeBuilder [Patch]
closeAncestorNode_ (ReparentDepth -> TreeBuilder [Patch])
-> (Int -> ReparentDepth) -> Int -> TreeBuilder [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReparentDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> TreeBuilder [Patch]) -> Int -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [(NodeIndex, ElementParams)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(NodeIndex, ElementParams)]
es1
                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
adopt TreeOutput -> [Patch] -> TreeOutput
|++ [Patch]
close
            Maybe (NodeIndex, TagParams)
Nothing -> [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertFormattingElement 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
nested TreeOutput -> TreeOutput -> TreeOutput
|++| [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"b"
        , String
"big"
        , String
"code"
        , String
"em"
        , String
"font"
        , String
"i"
        , String
"s"
        , String
"small"
        , String
"strike"
        , String
"strong"
        , String
"tt"
        , String
"u"
        ]) ((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
            [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
            TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertFormattingElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"nobr"]) ((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
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        Bool
hasNobr <- [Text] -> TreeBuilder Bool
hasInScope [Text
"nobr"]
        TreeOutput
nested <- if Bool
hasNobr
            then do
                --BUG: Adoption agency + insertion may duplicate the errors?
                TreeOutput
adopt <- ParseError -> TreeOutput -> TreeOutput
consTreeError ParseError
NestedElementForAdoptionAgency (TreeOutput -> TreeOutput)
-> TreeBuilder TreeOutput -> TreeBuilder TreeOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeInput -> TreeBuilder TreeOutput
runAdoptionAgency TreeInput
t'
                [Patch]
format' <- TreeBuilder [Patch]
reconstructFormattingElements
                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
adopt TreeOutput -> [Patch] -> TreeOutput
|++ [Patch]
format'
            else [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertFormattingElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
nested TreeOutput -> TreeOutput -> TreeOutput
|++| TreeOutput
insert
    , (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
"a"
        , String
"b"
        , String
"big"
        , String
"code"
        , String
"em"
        , String
"font"
        , String
"i"
        , String
"nobr"
        , String
"s"
        , String
"small"
        , String
"strike"
        , String
"strong"
        , String
"tt"
        , String
"u"
        ]) TreeInput -> TreeBuilder TreeOutput
runAdoptionAgency
    , (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
"applet", String
"marquee", String
"object"]) ((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
        TreeBuilder ()
setFramesetNotOk
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeBuilder ()
insertFormattingMarker
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"applet", String
"marquee", String
"object"]) ((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
        let d :: TagParams
d = TreeInput -> TagParams
tokenTag TreeInput
t'
        Bool
hasMatch <- [Text] -> TreeBuilder Bool
hasInScope [TagParams -> Text
tagName TagParams
d]
        if Bool
hasMatch
            then do
                [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags [Text]
impliedEndTags
                Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
                let errF :: [Patch] -> [Patch]
errF = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement (Text -> ElementParams -> Bool) -> Text -> ElementParams -> Bool
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d) Maybe ElementParams
current
                        then [Patch] -> [Patch]
forall a. a -> a
id
                        else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement (Text -> TreeBuilder [Patch]) -> Text -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d
                TreeBuilder ()
clearFormattingElements
                TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
clear
            else [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'
    , (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
"table"]) ((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
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        Bool
quirks <- (QuirksMode -> QuirksMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuirksMode
FullQuirks) (QuirksMode -> Bool)
-> (TreeParserState -> QuirksMode) -> TreeParserState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> QuirksMode
quirksMode (TreeParserState -> Bool)
-> StateT TreeParserState (Parser [TreeInput]) TreeParserState
-> TreeBuilder Bool
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
        [Patch]
clear <- if Bool
hasP Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
quirks
            then TreeBuilder [Patch]
closePElement
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement TreeInput
t'
        TreeBuilder ()
setFramesetNotOk
        InsertionMode -> TreeBuilder ()
switchMode InsertionMode
InTable
        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
$ [Patch]
clear [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"br"]) ((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 -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push (TreeInput -> TreeBuilder ())
-> ((Token -> Token) -> TreeInput)
-> (Token -> Token)
-> TreeBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ParseError] -> [ParseError]) -> TreeInput -> TreeInput
mapTokenErrs (ParseError
BREndTag ParseError -> [ParseError] -> [ParseError]
forall a. a -> [a] -> [a]
:) (TreeInput -> TreeInput)
-> ((Token -> Token) -> TreeInput) -> (Token -> Token) -> TreeInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Token -> Token) -> TreeInput -> TreeInput)
-> TreeInput -> (Token -> Token) -> TreeInput
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Token -> Token) -> TreeInput -> TreeInput
mapTokenOut TreeInput
t' ((Token -> Token) -> TreeBuilder ())
-> (Token -> Token) -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$
            Token -> Token -> Token
forall a b. a -> b -> a
const (TagParams -> Token
StartTag (TagParams -> Token) -> TagParams -> Token
forall a b. (a -> b) -> a -> b
$ (TreeInput -> TagParams
tokenTag TreeInput
t') { tagAttributes :: HashMap Text Text
tagAttributes = HashMap Text Text
forall k v. HashMap k v
M.empty })
        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
"area", String
"br", String
"embed", String
"img", String
"keygen", String
"wbr"]) ((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
        TreeBuilder ()
setFramesetNotOk
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertNullElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"input"]) ((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
        case (BasicAttribute -> Text) -> Maybe BasicAttribute -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BasicAttribute -> Text
forall a b. (a, b) -> b
snd (Maybe BasicAttribute -> Maybe Text)
-> (TagParams -> Maybe BasicAttribute) -> TagParams -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BasicAttribute -> Bool)
-> [BasicAttribute] -> Maybe BasicAttribute
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\BasicAttribute
a -> BasicAttribute -> Text
forall a b. (a, b) -> a
fst BasicAttribute
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"type") ([BasicAttribute] -> Maybe BasicAttribute)
-> (TagParams -> [BasicAttribute])
-> TagParams
-> Maybe BasicAttribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Text -> [BasicAttribute]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap Text Text -> [BasicAttribute])
-> (TagParams -> HashMap Text Text)
-> TagParams
-> [BasicAttribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagParams -> HashMap Text Text
tagAttributes (TagParams -> Maybe Text) -> TagParams -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TreeInput -> TagParams
tokenTag TreeInput
t' of
            Maybe Text
Nothing -> TreeBuilder ()
setFramesetNotOk
            Just Text
"hidden" -> () -> TreeBuilder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just Text
_ -> TreeBuilder ()
setFramesetNotOk
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertNullElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"param", String
"source", String
"track"]) 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
"hr"]) ((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
        TreeBuilder ()
setFramesetNotOk
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        [Patch]
close <- if Bool
hasP
            then TreeBuilder [Patch]
closePElement
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertNullElement 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
$ [Patch]
close [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"image"]) ((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 -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push (TreeInput -> TreeBuilder ())
-> ((Token -> Token) -> TreeInput)
-> (Token -> Token)
-> TreeBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ParseError] -> [ParseError]) -> TreeInput -> TreeInput
mapTokenErrs (Text -> ParseError
ObsoleteTagName Text
"image" ParseError -> [ParseError] -> [ParseError]
forall a. a -> [a] -> [a]
:) (TreeInput -> TreeInput)
-> ((Token -> Token) -> TreeInput) -> (Token -> Token) -> TreeInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Token -> Token) -> TreeInput -> TreeInput)
-> TreeInput -> (Token -> Token) -> TreeInput
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Token -> Token) -> TreeInput -> TreeInput
mapTokenOut TreeInput
t' ((Token -> Token) -> TreeBuilder ())
-> (Token -> Token) -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$
            Token -> Token -> Token
forall a b. a -> b -> a
const (TagParams -> Token
StartTag (TagParams -> Token) -> TagParams -> Token
forall a b. (a -> b) -> a -> b
$ (TreeInput -> TagParams
tokenTag TreeInput
t') { tagName :: Text
tagName = Text
"img" })
        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
"textarea"]) ((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
lineFeed <- StateT TreeParserState (Parser [TreeInput]) TreeInput
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next
        TokenizerOutputState
lineFeedState <- if TreeInput -> Token
tokenOut TreeInput
lineFeed Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Character Char
'\n'
            then TokenizerOutputState
-> StateT TreeParserState (Parser [TreeInput]) TokenizerOutputState
forall (m :: * -> *) a. Monad m => a -> m a
return (TokenizerOutputState
 -> StateT
      TreeParserState (Parser [TreeInput]) TokenizerOutputState)
-> TokenizerOutputState
-> StateT TreeParserState (Parser [TreeInput]) TokenizerOutputState
forall a b. (a -> b) -> a -> b
$ TreeInput -> TokenizerOutputState
tokenState TreeInput
lineFeed
            else TreeInput -> TreeBuilder ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push TreeInput
lineFeed TreeBuilder ()
-> TokenizerOutputState
-> StateT TreeParserState (Parser [TreeInput]) TokenizerOutputState
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TokenizerOutputState
forall a. Maybe a
Nothing
        TreeBuilder ()
setFramesetNotOk
        TreeInput -> TreeBuilder TreeOutput
genericRCDataElement (TreeInput -> TreeBuilder TreeOutput)
-> TreeInput -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ TreeInput
-> (TokenizerOutputState -> TokenizerOutputState) -> TreeInput
mapTokenState' TreeInput
t' (TokenizerOutputState
lineFeedState TokenizerOutputState
-> TokenizerOutputState -> TokenizerOutputState
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>)
    , (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
"xmp"]) ((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
        TreeBuilder ()
setFramesetNotOk
        Bool
hasP <- [Text] -> TreeBuilder Bool
hasInButtonScope [Text
"p"]
        [Patch]
close <- if Bool
hasP
            then TreeBuilder [Patch]
closePElement
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
text <- TreeInput -> TreeBuilder TreeOutput
genericRawTextElement 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
$ [Patch]
close [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
text
    , (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
"iframe"]) ((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
        TreeBuilder ()
setFramesetNotOk
        TreeInput -> TreeBuilder TreeOutput
genericRawTextElement 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
"noembed"]) TreeInput -> TreeBuilder TreeOutput
genericRawTextElement
    , (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
"noscript"]) ((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
        if TreeParserState -> Bool
scriptingEnabled TreeParserState
state
            then TreeInput -> TreeBuilder TreeOutput
genericRawTextElement TreeInput
t'
            else do -- "any other start tag"
                [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
                TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"select"]) ((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
        TreeBuilder ()
setFramesetNotOk
        TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
        InsertionMode -> TreeBuilder ()
switchMode (InsertionMode -> TreeBuilder ())
-> InsertionMode -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ if InsertionMode -> [InsertionMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TreeParserState -> InsertionMode
insertionMode TreeParserState
state)
                [ InsertionMode
InTable
                , InsertionMode
InCaption
                , InsertionMode
InTableBody
                , InsertionMode
InRow
                , InsertionMode
InCell
                ]
            then InsertionMode
InSelectInTable
            else InsertionMode
InSelect
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"optgroup", String
"option"]) ((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
        Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
        [Patch]
format <- case (ElementParams -> Text) -> Maybe ElementParams -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElementParams -> Text
elementName Maybe ElementParams
current of
                Just Text
"option" -> do
                    [Patch]
close <- TreeBuilder [Patch]
closeCurrentNode_
                    [Patch]
format' <- TreeBuilder [Patch]
reconstructFormattingElements
                    [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Patch] -> TreeBuilder [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [Patch]
close [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
format'
                Maybe Text
_ -> TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"rb", String
"rtc"]) ((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
        Bool
hasRuby <- [Text] -> TreeBuilder Bool
hasInScope [Text
"ruby"]
        [Patch]
generate <- if Bool
hasRuby
            then do
                [Patch]
generate' <- [Text] -> TreeBuilder [Patch]
generateEndTags [Text]
impliedEndTags
                Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
                let errF :: [Patch] -> [Patch]
errF = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> ElementParams -> Bool
nodeIsElement Text
"ruby") Maybe ElementParams
current
                        then [Patch] -> [Patch]
forall a. a -> a
id
                        else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Patch] -> TreeBuilder [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [Patch] -> [Patch]
errF [Patch]
generate'
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
generate [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"rp", String
"rt"]) ((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
        Bool
hasRuby <- [Text] -> TreeBuilder Bool
hasInScope [Text
"ruby"]
        [Patch]
generate <- if Bool
hasRuby
            then do
                [Patch]
generate' <- [Text] -> TreeBuilder [Patch]
generateEndTags ([Text] -> TreeBuilder [Patch]) -> [Text] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
L.delete Text
"rtc" [Text]
impliedEndTags
                Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
                let errF :: [Patch] -> [Patch]
errF = if Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\ElementParams
e -> Text -> ElementParams -> Bool
nodeIsElement Text
"ruby" ElementParams
e Bool -> Bool -> Bool
|| Text -> ElementParams -> Bool
nodeIsElement Text
"rtc" ElementParams
e) Maybe ElementParams
current
                        then [Patch] -> [Patch]
forall a. a -> a
id
                        else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Patch] -> TreeBuilder [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [Patch] -> [Patch]
errF [Patch]
generate'
            else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
generate [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"math"]) ((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
        let d :: TagParams
d = TreeInput -> TagParams
tokenTag TreeInput
t'
            insertF :: Text -> TreeInput -> TreeBuilder TreeOutput
insertF
                | TagParams -> Bool
tagIsSelfClosing TagParams
d = Text -> TreeInput -> TreeBuilder TreeOutput
insertForeignNullElement
                | Bool
otherwise = Text -> TreeInput -> TreeBuilder TreeOutput
insertForeignElement
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- Text -> TreeInput -> TreeBuilder TreeOutput
insertF Text
mathMLNamespace (TreeInput -> TreeBuilder TreeOutput)
-> TreeInput -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ (Token -> Token) -> TreeInput -> TreeInput
mapTokenOut (Token -> Token -> Token
forall a b. a -> b -> a
const (Token -> Token -> Token)
-> (TagParams -> Token) -> TagParams -> Token -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagParams -> Token
StartTag (TagParams -> Token -> Token) -> TagParams -> Token -> Token
forall a b. (a -> b) -> a -> b
$ TagParams -> TagParams
adjustMathMLAttributes TagParams
d) 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"svg"]) ((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
        let d :: TagParams
d = TreeInput -> TagParams
tokenTag TreeInput
t'
            insertF :: Text -> TreeInput -> TreeBuilder TreeOutput
insertF
                | TagParams -> Bool
tagIsSelfClosing TagParams
d = Text -> TreeInput -> TreeBuilder TreeOutput
insertForeignNullElement
                | Bool
otherwise = Text -> TreeInput -> TreeBuilder TreeOutput
insertForeignElement
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- Text -> TreeInput -> TreeBuilder TreeOutput
insertF Text
svgNamespace (TreeInput -> TreeBuilder TreeOutput)
-> TreeInput -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ (Token -> Token) -> TreeInput -> TreeInput
mapTokenOut (Token -> Token -> Token
forall a b. a -> b -> a
const (Token -> Token -> Token)
-> (TagParams -> Token) -> TagParams -> Token -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagParams -> Token
StartTag (TagParams -> Token -> Token) -> TagParams -> Token -> Token
forall a b. (a -> b) -> a -> b
$ TagParams -> TagParams
adjustSvgAttributes TagParams
d) 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
"caption"
        , String
"col"
        , String
"colgroup"
        , String
"frame"
        , String
"head"
        , String
"tbody"
        , String
"td"
        , String
"tfoot"
        , String
"th"
        , String
"thead"
        , String
"tr"
        ]) ((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 [ElementParams -> ParseError
UnexpectedDescendantElement (ElementParams -> ParseError) -> ElementParams -> ParseError
forall a b. (a -> b) -> a -> b
$ TreeInput -> ElementParams
tokenElement 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 TreeInput -> Bool
isAnyStartTag ((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
        [Patch]
format <- TreeBuilder [Patch]
reconstructFormattingElements
        TreeOutput
insert <- TreeInput -> TreeBuilder TreeOutput
insertElement 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
$ [Patch]
format [Patch] -> TreeOutput -> TreeOutput
++| TreeOutput
insert
    , (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
        TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
        [(NodeIndex, ElementParams)] -> TreeInput -> TreeBuilder TreeOutput
anyOtherEndTag (TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state) TreeInput
t'
    ]
  where headerNames :: [Text]
headerNames = [ Text -> Char -> Text
T.snoc Text
"h" Char
i | Char
i <- [Char
'1'..Char
'6'] ]
        hasUnexpectedOpenElement :: TreeBuilder Bool
hasUnexpectedOpenElement =
            [Text] -> TreeBuilder Bool
hasOpenElementExcept
                [ Text
"dd"
                , Text
"dt"
                , Text
"li"
                , Text
"optgroup"
                , Text
"option"
                , Text
"p"
                , Text
"rb"
                , Text
"rp"
                , Text
"rt"
                , Text
"rtc"
                , Text
"tbody"
                , Text
"td"
                , Text
"tfoot"
                , Text
"th"
                , Text
"thead"
                , Text
"tr"
                , Text
"body"
                , Text
"html"
                ]

-- | __HTML:__
--      the "any other end tag" entry in @[the "in body" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inbody)@
-- 
-- Delegate a token to to the 'InBody' section of the state machine, but skip
-- the token-dependent behaviour and instead simply treat it according to the
-- fallback case for 'EndTag' tokens.
anyOtherEndTag
    :: [(NodeIndex, ElementParams)]
        -- ^ The stack of open elements.
    -> TreeInput
        -- ^ The token to process.
    -> TreeBuilder TreeOutput
anyOtherEndTag :: [(NodeIndex, ElementParams)] -> TreeInput -> TreeBuilder TreeOutput
anyOtherEndTag [] TreeInput
t' = [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'
anyOtherEndTag ((NodeIndex
i, ElementParams
e):[(NodeIndex, ElementParams)]
es) TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    EndTag TagParams
d | Text -> ElementParams -> Bool
nodeIsElement (TagParams -> Text
tagName TagParams
d) ElementParams
e -> do
        [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags ([Text] -> TreeBuilder [Patch]) -> [Text] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
L.delete (TagParams -> Text
tagName TagParams
d) [Text]
impliedEndTags
        [NodeIndex]
elementIndices <- ((NodeIndex, ElementParams) -> NodeIndex)
-> [(NodeIndex, ElementParams)] -> [NodeIndex]
forall a b. (a -> b) -> [a] -> [b]
map (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst ([(NodeIndex, ElementParams)] -> [NodeIndex])
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> [NodeIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> [(NodeIndex, ElementParams)]
openElements (TreeParserState -> [NodeIndex])
-> StateT TreeParserState (Parser [TreeInput]) TreeParserState
-> StateT TreeParserState (Parser [TreeInput]) [NodeIndex]
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 :: [Patch] -> [Patch]
errF = if [NodeIndex] -> Maybe NodeIndex
forall a. [a] -> Maybe a
Y.listToMaybe [NodeIndex]
elementIndices Maybe NodeIndex -> Maybe NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
== NodeIndex -> Maybe NodeIndex
forall a. a -> Maybe a
Just NodeIndex
i
                then [Patch] -> [Patch]
forall a. a -> a
id
                else ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
            count :: Int
count = [NodeIndex] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((NodeIndex -> Bool) -> [NodeIndex] -> [NodeIndex]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (NodeIndex -> NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
/= NodeIndex
i) [NodeIndex]
elementIndices) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        [Patch]
clear <- ReparentDepth -> TreeBuilder [Patch]
clearCount (ReparentDepth -> TreeBuilder [Patch])
-> ReparentDepth -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Int -> ReparentDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count
        TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch] -> [Patch]
errF [Patch]
clear
    EndTag TagParams
_ -> if ElementParams -> Bool
nodeIsSpecial ElementParams
e
        then [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
UnexpectedElementWithImpliedEndTag] TreeInput
t'
        else [(NodeIndex, ElementParams)] -> TreeInput -> TreeBuilder TreeOutput
anyOtherEndTag [(NodeIndex, ElementParams)]
es TreeInput
t'
    Token
_ -> [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'


-- | Check whether a node is in 'scopeElements' -- the tags which break
-- open-tag searches.
isScopeElement :: ElementParams -> Bool
isScopeElement :: ElementParams -> Bool
isScopeElement ElementParams
d' = BasicAttribute -> [BasicAttribute] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Y.fromMaybe Text
T.empty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ElementParams -> Maybe Text
elementNamespace ElementParams
d', ElementParams -> Text
elementName ElementParams
d') [BasicAttribute]
scopeElements

-- | Check whether a node is in 'specialElements' -- the tags which are subject
-- to custom handling.
isSpecialElement :: ElementParams -> Bool
isSpecialElement :: ElementParams -> Bool
isSpecialElement ElementParams
d' = BasicAttribute -> [BasicAttribute] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Y.fromMaybe Text
T.empty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ElementParams -> Maybe Text
elementNamespace ElementParams
d', ElementParams -> Text
elementName ElementParams
d') [BasicAttribute]
specialElements


-- | __HTML:__
--      the substeps spanned by the /"Loop"/ for processing @\<dd\>@ and
--      @\<dt\>@ tags in @[the "in body" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inbody)@
-- 
-- @\<dd\>@ and @\<dt\>@ elements should close most opened elements if the
-- relevant end tag is left implied.
ddLoop
    :: [(NodeIndex, ElementParams)]
        -- ^ The stack of open elements.
    -> TreeBuilder [Patch]
ddLoop :: [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
ddLoop [] = [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
ddLoop ((NodeIndex
_, ElementParams
e):[(NodeIndex, ElementParams)]
es)
    | Text -> ElementParams -> Bool
nodeIsElement Text
"dd" ElementParams
e = do
        [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags ([Text] -> TreeBuilder [Patch]) -> [Text] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
L.delete Text
"dd" [Text]
impliedEndTags
        Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
        let err :: [Patch] -> [Patch]
err = case Maybe ElementParams
current of
                Just ElementParams
e' | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> ElementParams -> Bool
nodeIsElement Text
"dd" ElementParams
e' -> ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                Maybe ElementParams
_ -> [Patch] -> [Patch]
forall a. a -> a
id
        [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement Text
"dd"
        [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Patch] -> TreeBuilder [Patch])
-> ([Patch] -> [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Patch] -> [Patch]
err ([Patch] -> TreeBuilder [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
clear
    | Text -> ElementParams -> Bool
nodeIsElement Text
"dt" ElementParams
e = do
        [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags ([Text] -> TreeBuilder [Patch]) -> [Text] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
L.delete Text
"dt" [Text]
impliedEndTags
        Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
        let err :: [Patch] -> [Patch]
err = case Maybe ElementParams
current of
                Just ElementParams
e' | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> ElementParams -> Bool
nodeIsElement Text
"dt" ElementParams
e' -> ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                Maybe ElementParams
_ -> [Patch] -> [Patch]
forall a. a -> a
id
        [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement Text
"dt"
        [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Patch] -> TreeBuilder [Patch])
-> ([Patch] -> [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Patch] -> [Patch]
err ([Patch] -> TreeBuilder [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
clear
    | Text -> ElementParams -> Bool
nodeIsElement Text
"address" ElementParams
e = [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
ddLoop [(NodeIndex, ElementParams)]
es
    | Text -> ElementParams -> Bool
nodeIsElement Text
"div" ElementParams
e = [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
ddLoop [(NodeIndex, ElementParams)]
es
    | Text -> ElementParams -> Bool
nodeIsElement Text
"p" ElementParams
e = [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
ddLoop [(NodeIndex, ElementParams)]
es
    | ElementParams -> Bool
isSpecialElement ElementParams
e = [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise = [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
ddLoop [(NodeIndex, ElementParams)]
es

-- | __HTML:__
--      the substeps spanned by the /"Loop"/ for processing @\<li\>@ tags in
--      @[the "in body" insertion mode]
--      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inbody)@
-- 
-- @\<li\>@ elements should close most opened elements if the relevant end tag
-- is left implied.
liLoop
    :: [(NodeIndex, ElementParams)]
        -- ^ The stack of open elements.
    -> TreeBuilder [Patch]
liLoop :: [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
liLoop [] = [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
liLoop ((NodeIndex
_, ElementParams
e):[(NodeIndex, ElementParams)]
es)
    | Text -> ElementParams -> Bool
nodeIsElement Text
"li" ElementParams
e = do
        [Patch]
generate <- [Text] -> TreeBuilder [Patch]
generateEndTags ([Text] -> TreeBuilder [Patch]) -> [Text] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
L.delete Text
"li" [Text]
impliedEndTags
        Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
        let err :: [Patch] -> [Patch]
err = case Maybe ElementParams
current of
                Just ElementParams
e' | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> ElementParams -> Bool
nodeIsElement Text
"li" ElementParams
e' -> ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
UnexpectedElementWithImpliedEndTag
                Maybe ElementParams
_ -> [Patch] -> [Patch]
forall a. a -> a
id
        [Patch]
clear <- Text -> TreeBuilder [Patch]
closeElement Text
"li"
        [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Patch] -> TreeBuilder [Patch])
-> ([Patch] -> [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Patch] -> [Patch]
err ([Patch] -> TreeBuilder [Patch]) -> [Patch] -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ [Patch]
generate [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
clear
    | Text -> ElementParams -> Bool
nodeIsElement Text
"address" ElementParams
e = [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
liLoop [(NodeIndex, ElementParams)]
es
    | Text -> ElementParams -> Bool
nodeIsElement Text
"div" ElementParams
e = [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
liLoop [(NodeIndex, ElementParams)]
es
    | Text -> ElementParams -> Bool
nodeIsElement Text
"p" ElementParams
e = [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
liLoop [(NodeIndex, ElementParams)]
es
    | ElementParams -> Bool
isSpecialElement ElementParams
e = [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise = [(NodeIndex, ElementParams)] -> TreeBuilder [Patch]
liLoop [(NodeIndex, ElementParams)]
es


-- | __HTML:__
--      @[adoption agency algorithm]
--      (https://html.spec.whatwg.org/multipage/parsing.html#adoption-agency-algorithm)@
-- 
-- Handle a misnested formatting element by closing its ancestors up to a
-- stable branch point, and then reconstructing the tree in a more logical
-- order.
runAdoptionAgency :: TreeInput -> TreeBuilder TreeOutput
runAdoptionAgency :: TreeInput -> TreeBuilder TreeOutput
runAdoptionAgency TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    StartTag TagParams
d -> TagParams -> TreeBuilder TreeOutput
runAdoptionAgency' TagParams
d
    EndTag TagParams
d -> TagParams -> TreeBuilder TreeOutput
runAdoptionAgency' TagParams
d
    Token
_ -> [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'
  where runAdoptionAgency' :: TagParams -> TreeBuilder TreeOutput
runAdoptionAgency' TagParams
d = do
            Maybe ElementParams
current <- TreeBuilder (Maybe ElementParams)
currentNode
            Maybe NodeIndex
index <- TreeBuilder (Maybe NodeIndex)
currentNodeIndex
            [(NodeIndex, TagParams)]
active <- [[(NodeIndex, TagParams)]] -> [(NodeIndex, TagParams)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(NodeIndex, TagParams)]] -> [(NodeIndex, TagParams)])
-> (TreeParserState -> [[(NodeIndex, TagParams)]])
-> TreeParserState
-> [(NodeIndex, TagParams)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements (TreeParserState -> [(NodeIndex, TagParams)])
-> StateT TreeParserState (Parser [TreeInput]) TreeParserState
-> StateT
     TreeParserState (Parser [TreeInput]) [(NodeIndex, TagParams)]
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 isCurrent :: Bool
isCurrent = Bool -> (ElementParams -> Bool) -> Maybe ElementParams -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> ElementParams -> Bool
nodeIsElement (Text -> ElementParams -> Bool) -> Text -> ElementParams -> Bool
forall a b. (a -> b) -> a -> b
$ TagParams -> Text
tagName TagParams
d) Maybe ElementParams
current
                inActive :: Bool
inActive = Maybe (NodeIndex, TagParams) -> Bool
forall a. Maybe a -> Bool
Y.isJust (Maybe (NodeIndex, TagParams) -> Bool)
-> Maybe (NodeIndex, TagParams) -> Bool
forall a b. (a -> b) -> a -> b
$ ((NodeIndex, TagParams) -> Bool)
-> [(NodeIndex, TagParams)] -> Maybe (NodeIndex, TagParams)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(NodeIndex
i, TagParams
_) -> NodeIndex -> Maybe NodeIndex
forall a. a -> Maybe a
Just NodeIndex
i Maybe NodeIndex -> Maybe NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe NodeIndex
index) [(NodeIndex, TagParams)]
active
            if Bool
isCurrent Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inActive
                then TreeBuilder [Patch]
closeCurrentNode_ TreeBuilder [Patch]
-> ([Patch] -> TreeBuilder TreeOutput) -> TreeBuilder TreeOutput
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t'
                else ReparentDepth -> TreeInput -> TagParams -> TreeBuilder TreeOutput
runAdoptionAgencyOuterLoop ReparentDepth
8 TreeInput
t' TagParams
d

-- | __HTML:__
--      the substeps spanned by the /"Outer loop"/ within the
--      @[adoption agency algorithm]
--      (https://html.spec.whatwg.org/multipage/parsing.html#adoption-agency-algorithm)@
-- 
-- Determine whether the current formatting element close tag is mis-nested,
-- and if so, close the element and reconstruct an equivalent formatting tree.
runAdoptionAgencyOuterLoop
    :: Word
        -- ^ The maximum number of times the loop should be run, to avoid
        -- overly-costly input.  Note that this implementation counts down
        -- rather than up, and so this function should generally be passed @8@
        -- when it is originally called to implement the official behaviour.
    -> TreeInput
        -- ^ The token to process.
    -> TagParams
        -- ^ The inner element data extracted from the second parameter.
    -> TreeBuilder TreeOutput
-- 4.
runAdoptionAgencyOuterLoop :: ReparentDepth -> TreeInput -> TagParams -> TreeBuilder TreeOutput
runAdoptionAgencyOuterLoop ReparentDepth
0 TreeInput
t' TagParams
_ = [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [] TreeInput
t'
runAdoptionAgencyOuterLoop ReparentDepth
i TreeInput
t' TagParams
d = do
    Any
_ <- String -> StateT TreeParserState (Parser [TreeInput]) Any
forall a. HasCallStack => String -> a
error String
"Adoption agency not yet implemented"
    -- 6.
    TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
    let formatting :: [[(NodeIndex, TagParams)]]
formatting = TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements TreeParserState
state
        open :: [(NodeIndex, ElementParams)]
open = TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
    case ((Int, (NodeIndex, TagParams)) -> Bool)
-> [(Int, (NodeIndex, TagParams))]
-> Maybe (Int, (NodeIndex, TagParams))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(Int, (NodeIndex, TagParams))
f -> TagParams -> Text
tagName ((NodeIndex, TagParams) -> TagParams
forall a b. (a, b) -> b
snd ((NodeIndex, TagParams) -> TagParams)
-> (NodeIndex, TagParams) -> TagParams
forall a b. (a -> b) -> a -> b
$ (Int, (NodeIndex, TagParams)) -> (NodeIndex, TagParams)
forall a b. (a, b) -> b
snd (Int, (NodeIndex, TagParams))
f) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== TagParams -> Text
tagName TagParams
d) ([(Int, (NodeIndex, TagParams))]
 -> Maybe (Int, (NodeIndex, TagParams)))
-> ([(NodeIndex, TagParams)] -> [(Int, (NodeIndex, TagParams))])
-> [(NodeIndex, TagParams)]
-> Maybe (Int, (NodeIndex, TagParams))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> [(NodeIndex, TagParams)] -> [(Int, (NodeIndex, TagParams))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(NodeIndex, TagParams)] -> Maybe (Int, (NodeIndex, TagParams)))
-> [(NodeIndex, TagParams)] -> Maybe (Int, (NodeIndex, TagParams))
forall a b. (a -> b) -> a -> b
$ [[(NodeIndex, TagParams)]] -> [(NodeIndex, TagParams)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(NodeIndex, TagParams)]]
formatting of
        Maybe (Int, (NodeIndex, TagParams))
Nothing -> [(NodeIndex, ElementParams)] -> TreeInput -> TreeBuilder TreeOutput
anyOtherEndTag [(NodeIndex, ElementParams)]
open TreeInput
t'
        Just (Int
indexFormat, (NodeIndex, TagParams)
formattingElement) -> do
            let removeFormattingElement :: TreeBuilder ()
removeFormattingElement = TreeParserState -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
N.S.put (TreeParserState -> TreeBuilder ())
-> TreeParserState -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ TreeParserState
state
                    { activeFormattingElements :: [[(NodeIndex, TagParams)]]
activeFormattingElements = ([(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)])
-> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a b. (a -> b) -> [a] -> [b]
map ((NodeIndex, TagParams)
-> [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)]
forall a. Eq a => a -> [a] -> [a]
L.delete (NodeIndex, TagParams)
formattingElement) [[(NodeIndex, TagParams)]]
formatting
                    }
            -- 7.
            case NodeIndex -> [NodeIndex] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex ((NodeIndex, TagParams) -> NodeIndex
forall a b. (a, b) -> a
fst (NodeIndex, TagParams)
formattingElement) (((NodeIndex, ElementParams) -> NodeIndex)
-> [(NodeIndex, ElementParams)] -> [NodeIndex]
forall a b. (a -> b) -> [a] -> [b]
map (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst [(NodeIndex, ElementParams)]
open) of
                Maybe Int
Nothing -> do
                    TreeBuilder ()
removeFormattingElement
                    [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
IncompletelyClosedFormattingElement] TreeInput
t'
                Just Int
indexOpen -> do
                    -- 8.  Make use of the fact we can get an index rather than
                    -- just a 'Bool' when checking if the formatting element is
                    -- in the stack of open elements, to check if it's in
                    -- scope ('hasInScope' only checks the tag name, not UID).
                    let descendants :: [(NodeIndex, ElementParams)]
descendants = Int -> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. Int -> [a] -> [a]
take Int
indexOpen [(NodeIndex, ElementParams)]
open
                        formattingNode :: (NodeIndex, ElementParams)
formattingNode = [(NodeIndex, ElementParams)] -> (NodeIndex, ElementParams)
forall a. [a] -> a
head ([(NodeIndex, ElementParams)] -> (NodeIndex, ElementParams))
-> [(NodeIndex, ElementParams)] -> (NodeIndex, ElementParams)
forall a b. (a -> b) -> a -> b
$ Int -> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. Int -> [a] -> [a]
drop Int
indexOpen [(NodeIndex, ElementParams)]
open
                    if ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ElementParams -> Bool
isScopeElement (ElementParams -> Bool)
-> ((NodeIndex, ElementParams) -> ElementParams)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd) [(NodeIndex, ElementParams)]
descendants
                        then [ParseError] -> TreeInput -> TreeBuilder TreeOutput
packTreeErrors [ParseError
UnexpectedFormattingElementOutOfScope] TreeInput
t'
                        else do
                            -- 9.
                            let overlap :: [Patch] -> [Patch]
overlap = if Bool -> (NodeIndex -> Bool) -> Maybe NodeIndex -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((NodeIndex, TagParams) -> NodeIndex
forall a b. (a, b) -> a
fst (NodeIndex, TagParams)
formattingElement NodeIndex -> NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe NodeIndex -> Bool)
-> ([NodeIndex] -> Maybe NodeIndex) -> [NodeIndex] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeIndex] -> Maybe NodeIndex
forall a. [a] -> Maybe a
Y.listToMaybe ([NodeIndex] -> Bool) -> [NodeIndex] -> Bool
forall a b. (a -> b) -> a -> b
$ ((NodeIndex, ElementParams) -> NodeIndex)
-> [(NodeIndex, ElementParams)] -> [NodeIndex]
forall a b. (a -> b) -> [a] -> [b]
map (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst [(NodeIndex, ElementParams)]
open
                                    then ParseError -> [Patch] -> [Patch]
consTreeError_ ParseError
OverlappingFormattingElements
                                    else [Patch] -> [Patch]
forall a. a -> a
id
                            -- 10.
                            case ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (ElementParams -> Bool
isSpecialElement (ElementParams -> Bool)
-> ((NodeIndex, ElementParams) -> ElementParams)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd) ([(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams))
-> [(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams)
forall a b. (a -> b) -> a -> b
$ [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. [a] -> [a]
reverse [(NodeIndex, ElementParams)]
descendants of
                                Maybe (NodeIndex, ElementParams)
Nothing -> do
                                    -- 11.
                                    [Patch]
clear <- ReparentDepth -> TreeBuilder [Patch]
clearCount (ReparentDepth -> TreeBuilder [Patch])
-> ReparentDepth -> TreeBuilder [Patch]
forall a b. (a -> b) -> a -> b
$ Int -> ReparentDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indexOpen
                                    [Patch]
close <- TreeBuilder [Patch]
closeCurrentNode_
                                    TreeBuilder ()
removeFormattingElement
                                    TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch] -> [Patch]
overlap [Patch]
clear [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ [Patch]
close
                                Just (NodeIndex, ElementParams)
furthestBlock -> do
                                    -- 14.
                                    (Int
bookmark, (NodeIndex, TagParams)
lastTag) <-
                                        ReparentDepth
-> Int
-> (NodeIndex, TagParams)
-> (NodeIndex, ElementParams)
-> (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)]
-> TreeBuilder (Int, (NodeIndex, TagParams))
runAdoptionAgencyInnerLoop ReparentDepth
3 Int
indexFormat (NodeIndex, TagParams)
formattingElement (NodeIndex, ElementParams)
furthestBlock (NodeIndex, ElementParams)
furthestBlock ([(NodeIndex, ElementParams)]
 -> TreeBuilder (Int, (NodeIndex, TagParams)))
-> ([(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)])
-> [(NodeIndex, ElementParams)]
-> TreeBuilder (Int, (NodeIndex, TagParams))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. Int -> [a] -> [a]
drop Int
1 ([(NodeIndex, ElementParams)]
 -> TreeBuilder (Int, (NodeIndex, TagParams)))
-> [(NodeIndex, ElementParams)]
-> TreeBuilder (Int, (NodeIndex, TagParams))
forall a b. (a -> b) -> a -> b
$ ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((NodeIndex, ElementParams) -> (NodeIndex, ElementParams) -> Bool
forall a. Eq a => a -> a -> Bool
/= (NodeIndex, ElementParams)
furthestBlock) [(NodeIndex, ElementParams)]
open
                                    -- 15.
                                    [Patch]
reparent <- case NodeIndex -> [NodeIndex] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex ((NodeIndex, TagParams) -> NodeIndex
forall a b. (a, b) -> a
fst (NodeIndex, TagParams)
lastTag) ([NodeIndex] -> Maybe Int) -> [NodeIndex] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((NodeIndex, ElementParams) -> NodeIndex)
-> [(NodeIndex, ElementParams)] -> [NodeIndex]
forall a b. (a -> b) -> [a] -> [b]
map (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst [(NodeIndex, ElementParams)]
open of
                                            Maybe Int
Nothing -> [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                                            Just Int
indexInner -> if Int
indexInner Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexOpen
                                                then ReparentDepth -> ReparentDepth -> TreeBuilder [Patch]
closeAncestorNodes_
                                                    (Int -> ReparentDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indexInner)
                                                    (Int -> ReparentDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ReparentDepth) -> Int -> ReparentDepth
forall a b. (a -> b) -> a -> b
$ Int
indexOpen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
indexInner)
                                                else [Patch] -> TreeBuilder [Patch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                                    -- 16.
                                    (NodeIndex, ElementParams)
newElement <- ElementParams -> TreeBuilder (NodeIndex, ElementParams)
createElement (ElementParams -> TreeBuilder (NodeIndex, ElementParams))
-> ElementParams -> TreeBuilder (NodeIndex, ElementParams)
forall a b. (a -> b) -> a -> b
$ (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd (NodeIndex, ElementParams)
formattingNode
                                    let newTag :: (NodeIndex, TagParams)
newTag = ElementParams -> TagParams
unpackNodeData (ElementParams -> TagParams)
-> (NodeIndex, ElementParams) -> (NodeIndex, TagParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeIndex, ElementParams)
newElement
                                    (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState) -> TreeBuilder ())
-> (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state' -> TreeParserState
state'
                                        -- 19.
                                        { activeFormattingElements :: [[(NodeIndex, TagParams)]]
activeFormattingElements =
                                            let findBookmark :: Int -> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
findBookmark Int
_ [] = []
                                                findBookmark Int
bookmark' ([(NodeIndex, TagParams)]
es:[[(NodeIndex, TagParams)]]
ess)
                                                    | Int
bookmark' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l = [(NodeIndex, TagParams)]
es [(NodeIndex, TagParams)]
-> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a. a -> [a] -> [a]
: Int -> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
findBookmark (Int
bookmark' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) [[(NodeIndex, TagParams)]]
ess
                                                    | Bool
otherwise = ([(NodeIndex, TagParams)]
ds [(NodeIndex, TagParams)]
-> [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)]
forall a. [a] -> [a] -> [a]
++ (NodeIndex, TagParams)
newTag (NodeIndex, TagParams)
-> [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)]
forall a. a -> [a] -> [a]
: Int -> [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)]
forall a. Int -> [a] -> [a]
drop Int
1 [(NodeIndex, TagParams)]
as) [(NodeIndex, TagParams)]
-> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a. a -> [a] -> [a]
: [[(NodeIndex, TagParams)]]
ess
                                                  where l :: Int
l = [(NodeIndex, TagParams)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(NodeIndex, TagParams)]
es
                                                        ([(NodeIndex, TagParams)]
ds, [(NodeIndex, TagParams)]
as) = Int
-> [(NodeIndex, TagParams)]
-> ([(NodeIndex, TagParams)], [(NodeIndex, TagParams)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
bookmark' [(NodeIndex, TagParams)]
es
                                            in  Int -> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
findBookmark Int
bookmark [[(NodeIndex, TagParams)]]
formatting
                                        -- 20.
                                        , openElements :: [(NodeIndex, ElementParams)]
openElements =
                                            let es :: [(NodeIndex, ElementParams)]
es = (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. Eq a => a -> [a] -> [a]
L.delete (NodeIndex, ElementParams)
formattingNode [(NodeIndex, ElementParams)]
open
                                                ([(NodeIndex, ElementParams)]
ds, [(NodeIndex, ElementParams)]
as) = ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)]
-> ([(NodeIndex, ElementParams)], [(NodeIndex, ElementParams)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((NodeIndex, ElementParams) -> (NodeIndex, ElementParams) -> Bool
forall a. Eq a => a -> a -> Bool
== (NodeIndex, ElementParams)
furthestBlock) [(NodeIndex, ElementParams)]
es
                                            in  [(NodeIndex, ElementParams)]
ds [(NodeIndex, ElementParams)]
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. [a] -> [a] -> [a]
++ (NodeIndex, ElementParams)
newElement (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. a -> [a] -> [a]
: [(NodeIndex, ElementParams)]
as
                                        }
                                    -- 21.
                                    TreeOutput
recurse <- ReparentDepth -> TreeInput -> TagParams -> TreeBuilder TreeOutput
runAdoptionAgencyOuterLoop (ReparentDepth
i ReparentDepth -> ReparentDepth -> ReparentDepth
forall a. Num a => a -> a -> a
- ReparentDepth
1) TreeInput
t' TagParams
d
                                    TreeInput -> [Patch] -> TreeBuilder TreeOutput
packTree TreeInput
t' ([Patch] -> TreeBuilder TreeOutput)
-> [Patch] -> TreeBuilder TreeOutput
forall a b. (a -> b) -> a -> b
$ [Patch] -> [Patch]
overlap [Patch]
reparent [Patch] -> [Patch] -> [Patch]
forall a. [a] -> [a] -> [a]
++ TreeOutput -> [Patch]
treePatches TreeOutput
recurse

-- | __HTML:__
--      the substeps spanned by the /"Inner loop"/ within the
--      @[adoption agency algorithm]
--      (https://html.spec.whatwg.org/multipage/parsing.html#adoption-agency-algorithm)@
-- 
-- Close ancestor elements until reaching a stable node for the new tree, and
-- then reconstruct an equivalent tree.
runAdoptionAgencyInnerLoop
    :: Word
        -- ^ __HTML:__
        --      @inner loop counter@
        -- 
        -- The maximum number of times the loop should be run, to avoid
        -- overly-costly input.  Note that this implementation counts down
        -- rather than up, and so this function should generally be passed @3@.
    -> Int
        -- ^ __HTML:__
        --      the bookmark noting the position of @formatting element@
    -> (NodeIndex, TagParams)
        -- ^ __HTML:__
        --      @formatting element@
        -- 
        -- The node selected as the base of the reparenting process.
    -> (NodeIndex, ElementParams)
        -- ^ __HTML:__
        --      @last node@
        -- 
        -- The child node actively being reparented.
    -> (NodeIndex, ElementParams)
        -- ^ __HTML:__
        --      @furthest block@
        -- 
        -- The most senior descendant of @formatting element@ which will serve
        -- as a secondary fixed point.
    -> [(NodeIndex, ElementParams)]
        -- ^ The stack of open elements; @inner node@ is derived from this.
    -> TreeBuilder (Int, (NodeIndex, TagParams))
runAdoptionAgencyInnerLoop :: ReparentDepth
-> Int
-> (NodeIndex, TagParams)
-> (NodeIndex, ElementParams)
-> (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)]
-> TreeBuilder (Int, (NodeIndex, TagParams))
runAdoptionAgencyInnerLoop ReparentDepth
_ Int
bookmark (NodeIndex, TagParams)
formattingElement (NodeIndex, ElementParams)
_ (NodeIndex, ElementParams)
_ [] = (Int, (NodeIndex, TagParams))
-> TreeBuilder (Int, (NodeIndex, TagParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
bookmark, (NodeIndex, TagParams)
formattingElement)
runAdoptionAgencyInnerLoop ReparentDepth
i Int
bookmark (NodeIndex, TagParams)
formattingElement (NodeIndex, ElementParams)
lastNode (NodeIndex, ElementParams)
furthestBlock ((NodeIndex, ElementParams)
innerNode:[(NodeIndex, ElementParams)]
ns)
    -- 4.
    | (NodeIndex, TagParams) -> NodeIndex
forall a b. (a, b) -> a
fst (NodeIndex, TagParams)
formattingElement NodeIndex -> NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
== (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst (NodeIndex, ElementParams)
innerNode = (Int, (NodeIndex, TagParams))
-> TreeBuilder (Int, (NodeIndex, TagParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
bookmark, (NodeIndex, TagParams)
formattingElement)
    | Bool
otherwise = do
        TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
        let formatting :: [[(NodeIndex, TagParams)]]
formatting = TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements TreeParserState
state
        case (NodeIndex, TagParams) -> [(NodeIndex, TagParams)] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex (NodeIndex, TagParams)
innerTag ([(NodeIndex, TagParams)] -> Maybe Int)
-> [(NodeIndex, TagParams)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [[(NodeIndex, TagParams)]] -> [(NodeIndex, TagParams)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(NodeIndex, TagParams)]]
formatting of
            Just Int
innerIndex -> if ReparentDepth
i ReparentDepth -> ReparentDepth -> Bool
forall a. Eq a => a -> a -> Bool
== ReparentDepth
0
                -- 5. / 6.
                then do
                    (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState) -> TreeBuilder ())
-> (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state' -> TreeParserState
state'
                        --BUG: Not reflected in the patch list.
                        { openElements :: [(NodeIndex, ElementParams)]
openElements = (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. Eq a => a -> [a] -> [a]
L.delete (NodeIndex, ElementParams)
innerNode ([(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)])
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state'
                        , activeFormattingElements :: [[(NodeIndex, TagParams)]]
activeFormattingElements = ([(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)])
-> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a b. (a -> b) -> [a] -> [b]
map ((NodeIndex, TagParams)
-> [(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)]
forall a. Eq a => a -> [a] -> [a]
L.delete (NodeIndex, TagParams)
innerTag) [[(NodeIndex, TagParams)]]
formatting
                        }
                    let bookmark' :: Int
bookmark'
                            | Int
innerIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bookmark = Int -> Int
forall a. Enum a => a -> a
pred Int
bookmark
                            | Bool
otherwise = Int
bookmark
                    ReparentDepth
-> Int
-> (NodeIndex, TagParams)
-> (NodeIndex, ElementParams)
-> (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)]
-> TreeBuilder (Int, (NodeIndex, TagParams))
runAdoptionAgencyInnerLoop ReparentDepth
i' Int
bookmark' (NodeIndex, TagParams)
formattingElement (NodeIndex, ElementParams)
lastNode (NodeIndex, ElementParams)
furthestBlock [(NodeIndex, ElementParams)]
ns
                else do
                    -- 7.
                    (NodeIndex, ElementParams)
newElement <- ElementParams -> TreeBuilder (NodeIndex, ElementParams)
createElement (ElementParams -> TreeBuilder (NodeIndex, ElementParams))
-> ElementParams -> TreeBuilder (NodeIndex, ElementParams)
forall a b. (a -> b) -> a -> b
$ (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd (NodeIndex, ElementParams)
innerNode
                    let newTag :: (NodeIndex, TagParams)
newTag = ElementParams -> TagParams
unpackNodeData (ElementParams -> TagParams)
-> (NodeIndex, ElementParams) -> (NodeIndex, TagParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeIndex, ElementParams)
newElement
                    (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState) -> TreeBuilder ())
-> (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state' -> TreeParserState
state'
                        { openElements :: [(NodeIndex, ElementParams)]
openElements = (NodeIndex, ElementParams)
-> (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)]
-> [(NodeIndex, ElementParams)]
forall a. Eq a => a -> a -> [a] -> [a]
replaceNode (NodeIndex, ElementParams)
newElement (NodeIndex, ElementParams)
innerNode ([(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)])
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state'
                        , activeFormattingElements :: [[(NodeIndex, TagParams)]]
activeFormattingElements = ([(NodeIndex, TagParams)] -> [(NodeIndex, TagParams)])
-> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a b. (a -> b) -> [a] -> [b]
map ((NodeIndex, TagParams)
-> (NodeIndex, TagParams)
-> [(NodeIndex, TagParams)]
-> [(NodeIndex, TagParams)]
forall a. Eq a => a -> a -> [a] -> [a]
replaceNode (NodeIndex, TagParams)
newTag (NodeIndex, TagParams)
innerTag) [[(NodeIndex, TagParams)]]
formatting
                        }
                    -- 8.
                    let bookmark' :: Int
bookmark'
                            | (NodeIndex, ElementParams)
lastNode (NodeIndex, ElementParams) -> (NodeIndex, ElementParams) -> Bool
forall a. Eq a => a -> a -> Bool
== (NodeIndex, ElementParams)
furthestBlock =
                                Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
bookmark Int -> Int
forall a. Enum a => a -> a
succ (Maybe Int -> Int)
-> ([(NodeIndex, TagParams)] -> Maybe Int)
-> [(NodeIndex, TagParams)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, TagParams) -> [(NodeIndex, TagParams)] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex (NodeIndex, TagParams)
newTag ([(NodeIndex, TagParams)] -> Int)
-> [(NodeIndex, TagParams)] -> Int
forall a b. (a -> b) -> a -> b
$ [[(NodeIndex, TagParams)]] -> [(NodeIndex, TagParams)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(NodeIndex, TagParams)]]
formatting
                            | Bool
otherwise = Int
bookmark
                    -- 10. / 11.
                    ReparentDepth
-> Int
-> (NodeIndex, TagParams)
-> (NodeIndex, ElementParams)
-> (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)]
-> TreeBuilder (Int, (NodeIndex, TagParams))
runAdoptionAgencyInnerLoop ReparentDepth
i' Int
bookmark' (NodeIndex, TagParams)
formattingElement (NodeIndex, ElementParams)
innerNode (NodeIndex, ElementParams)
furthestBlock [(NodeIndex, ElementParams)]
ns
            -- 6.
            Maybe Int
Nothing -> do
                (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify ((TreeParserState -> TreeParserState) -> TreeBuilder ())
-> (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall a b. (a -> b) -> a -> b
$ \TreeParserState
state' -> TreeParserState
state'
                    --BUG: Not reflected in the patch list.
                    { openElements :: [(NodeIndex, ElementParams)]
openElements = (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. Eq a => a -> [a] -> [a]
L.delete (NodeIndex, ElementParams)
innerNode ([(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)])
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state'
                    }
                ReparentDepth
-> Int
-> (NodeIndex, TagParams)
-> (NodeIndex, ElementParams)
-> (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)]
-> TreeBuilder (Int, (NodeIndex, TagParams))
runAdoptionAgencyInnerLoop ReparentDepth
i' Int
bookmark (NodeIndex, TagParams)
formattingElement (NodeIndex, ElementParams)
lastNode (NodeIndex, ElementParams)
furthestBlock [(NodeIndex, ElementParams)]
ns
  where i' :: ReparentDepth
i' = if ReparentDepth
i ReparentDepth -> ReparentDepth -> Bool
forall a. Eq a => a -> a -> Bool
== ReparentDepth
0 then ReparentDepth
0 else ReparentDepth
i ReparentDepth -> ReparentDepth -> ReparentDepth
forall a. Num a => a -> a -> a
- ReparentDepth
1
        replaceNode :: a -> a -> [a] -> [a]
replaceNode a
newElement a
innerElement [a]
es = [a]
ds [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
newElement a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
as
          where ([a]
ds, [a]
as) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
innerElement) [a]
es
        innerTag :: (NodeIndex, TagParams)
innerTag = ElementParams -> TagParams
unpackNodeData (ElementParams -> TagParams)
-> (NodeIndex, ElementParams) -> (NodeIndex, TagParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeIndex, ElementParams)
innerNode

-- | Retrieve the data from the finalized form of the collection, and repack it
-- in the form expected by some of the parser combinators used by the
-- @runAdoptionAgency@ algorithm.
unpackNodeData :: ElementParams -> TagParams
unpackNodeData :: ElementParams -> TagParams
unpackNodeData ElementParams
d = TagParams
emptyTagParams
    { tagName :: Text
tagName = case ElementParams -> Maybe Text
elementPrefix ElementParams
d of
        Just Text
prefix -> Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ElementParams -> Text
elementName ElementParams
d
        Maybe Text
Nothing -> ElementParams -> Text
elementName ElementParams
d
    , tagAttributes :: HashMap Text Text
tagAttributes = [BasicAttribute] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([BasicAttribute] -> HashMap Text Text)
-> (AttributeMap -> [BasicAttribute])
-> AttributeMap
-> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttributeParams -> BasicAttribute)
-> [AttributeParams] -> [BasicAttribute]
forall a b. (a -> b) -> [a] -> [b]
map AttributeParams -> BasicAttribute
unpackAttribute ([AttributeParams] -> [BasicAttribute])
-> (AttributeMap -> [AttributeParams])
-> AttributeMap
-> [BasicAttribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeMap -> [AttributeParams]
toAttrList (AttributeMap -> HashMap Text Text)
-> AttributeMap -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ ElementParams -> AttributeMap
elementAttributes ElementParams
d
    -- Don't have to worry about self-closing tags, as if they're taking part
    -- in the adoption agency algorithm, they must have been able to have
    -- children.
    }
  where unpackAttribute :: AttributeParams -> BasicAttribute
unpackAttribute AttributeParams
d' = case AttributeParams -> Maybe Text
attrPrefix AttributeParams
d' of
            Just Text
prefix -> (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AttributeParams -> Text
attrName AttributeParams
d', AttributeParams -> Text
attrValue AttributeParams
d')
            Maybe Text
Nothing -> (AttributeParams -> Text
attrName AttributeParams
d', AttributeParams -> Text
attrValue AttributeParams
d')