{-# LANGUAGE OverloadedStrings #-}
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 ( ($>) )
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
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
[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"
]
anyOtherEndTag
:: [(NodeIndex, ElementParams)]
-> TreeInput
-> 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'
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
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
ddLoop
:: [(NodeIndex, ElementParams)]
-> 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
liLoop
:: [(NodeIndex, ElementParams)]
-> 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
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
runAdoptionAgencyOuterLoop
:: Word
-> TreeInput
-> TagParams
-> TreeBuilder TreeOutput
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"
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
}
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
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
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
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
[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
(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
[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 []
(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'
{ 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
, 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
}
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
runAdoptionAgencyInnerLoop
:: Word
-> Int
-> (NodeIndex, TagParams)
-> (NodeIndex, ElementParams)
-> (NodeIndex, ElementParams)
-> [(NodeIndex, ElementParams)]
-> 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)
| (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
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'
{ 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
(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
}
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
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
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'
{ 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
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
}
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')