{-|
Description:    Functions to collapse a state-free instruction list into a document tree.

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

Stability:      provisional
Portability:    portable

This module provides the logic powering the second half of this
implementation's split
__[HTML](https://html.spec.whatwg.org/multipage/parsing.html#tree-construction)__
tree construction algorithm.  Namely, the functions in this module operate over
the single-dimensional stream of static tree-building instructions generated by
the rest of the "Web.Mangrove.Parse.Tree" hierarchy, folding them into a
simplified DOM tree.  For a more detailed discussion of the design behind this,
see the documentation of "Web.Mangrove.Parse.Tree.Patch".
-}
module Web.Mangrove.Parse.Tree.Patch.Fold
    ( buildTree
    ) where


import qualified Data.Bifunctor as F.B
import qualified Data.Either as E
import qualified Data.HashMap.Strict as M
import qualified Data.IntMap.Strict as M.I
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.Tree.Common hiding ( Token ( .. ) )
import Web.Mangrove.Parse.Tree.Patch


-- | Fold a series of instructions describing how to build a document tree
-- (without reference to any persistent state) into the tree they describe.
buildTree :: [Patch] -> Tree
buildTree :: [Patch] -> Tree
buildTree = ([Tree], [Patch]) -> Tree
buildTree' (([Tree], [Patch]) -> Tree)
-> ([Patch] -> ([Tree], [Patch])) -> [Patch] -> Tree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Patch] -> ([Tree], [Patch])
foldPatchset
  where buildTree' :: ([Tree], [Patch]) -> Tree
buildTree' ([Tree]
ts, []) = Tree
emptyTree
            { node :: Node
node = QuirksMode -> Node
Document QuirksMode
mode'
            , children :: [Tree]
children = [Tree]
ts'
            }
          where ([Tree]
ms, [Tree]
ts') = (Tree -> Bool) -> [Tree] -> ([Tree], [Tree])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (\Tree
t -> Node -> Maybe NodeType
nodeType (Tree -> Node
node Tree
t) Maybe NodeType -> Maybe NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
DocumentNode) [Tree]
ts
                mode' :: QuirksMode
mode' = (QuirksMode -> QuirksMode -> QuirksMode)
-> QuirksMode -> [QuirksMode] -> QuirksMode
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr QuirksMode -> QuirksMode -> QuirksMode
forall a. Ord a => a -> a -> a
max QuirksMode
NoQuirks ([QuirksMode] -> QuirksMode) -> [QuirksMode] -> QuirksMode
forall a b. (a -> b) -> a -> b
$ (Tree -> Maybe QuirksMode) -> [Tree] -> [QuirksMode]
forall a b. (a -> Maybe b) -> [a] -> [b]
Y.mapMaybe (Node -> Maybe QuirksMode
getQuirksMode (Node -> Maybe QuirksMode)
-> (Tree -> Node) -> Tree -> Maybe QuirksMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree -> Node
node) [Tree]
ms
                getQuirksMode :: Node -> Maybe QuirksMode
getQuirksMode (Document QuirksMode
mode) = QuirksMode -> Maybe QuirksMode
forall a. a -> Maybe a
Just QuirksMode
mode
                getQuirksMode Node
_ = Maybe QuirksMode
forall a. Maybe a
Nothing
        buildTree' ([Tree]
_, Patch
RestartParsing : [Patch]
ps) = ([Tree], [Patch]) -> Tree
buildTree' (([Tree], [Patch]) -> Tree) -> ([Tree], [Patch]) -> Tree
forall a b. (a -> b) -> a -> b
$ [Patch] -> ([Tree], [Patch])
foldPatchset [Patch]
ps
        buildTree' ([Tree]
ts, [Patch]
ps) = ([Tree], [Patch]) -> Tree
buildTree' (([Tree], [Patch]) -> Tree)
-> (([Tree], [Patch]) -> ([Tree], [Patch]))
-> ([Tree], [Patch])
-> Tree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Tree] -> [Tree]) -> ([Tree], [Patch]) -> ([Tree], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first ([Tree]
ts [Tree] -> [Tree] -> [Tree]
forall a. [a] -> [a] -> [a]
++) (([Tree], [Patch]) -> Tree) -> ([Tree], [Patch]) -> Tree
forall a b. (a -> b) -> a -> b
$ [Patch] -> ([Tree], [Patch])
foldPatchset [Patch]
ps

-- | Consume the next minimal sequence of folding instructions which would
-- result in at least one complete tree.  The input patchset is read according
-- to a sensible behaviour for trees providing a root for the document
-- (typically the /only/ root).
foldPatchset :: [Patch] -> ([Tree], [Patch])
foldPatchset :: [Patch] -> ([Tree], [Patch])
foldPatchset [Patch]
ps = ([Either ([ParseError], Char) (InsertAt, Tree)] -> [Tree])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Tree], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first ([Either ([ParseError], Char) Tree] -> [Tree]
joinTexts ([Either ([ParseError], Char) Tree] -> [Tree])
-> ([Either ([ParseError], Char) (InsertAt, Tree)]
    -> [Either ([ParseError], Char) Tree])
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Tree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ([ParseError], Char) (InsertAt, Tree)
 -> Maybe (Either ([ParseError], Char) Tree))
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) Tree]
forall a b. (a -> Maybe b) -> [a] -> [b]
Y.mapMaybe Either ([ParseError], Char) (InsertAt, Tree)
-> Maybe (Either ([ParseError], Char) Tree)
forall a a b. Either a (a, b) -> Maybe (Either a b)
filterNull) (([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
 -> ([Tree], [Patch]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Tree], [Patch])
forall a b. (a -> b) -> a -> b
$ Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
False [Patch]
ps
  where -- Preprocess the placeholder tuples, where the 'InsertAt' carries the
        -- semantic data rather than the 'Tree'.
        filterNull :: Either a (a, b) -> Maybe (Either a b)
filterNull (Right (a
_, b
t)) = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> Either a b -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ b -> Either a b
forall a b. b -> Either a b
Right b
t
        filterNull (Left a
c) = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> Either a b -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
c

-- | Consume the next sequence of folding instructions which would result in a
-- complete tree.  Any intervening instructions which are destined for other
-- parts of the final tree are extracted for re-direction upward.  Any textual
-- data to be inserted directly into the tree is returned as a 'Left' value for
-- later packing into a single 'Text' node, to avoid the exponential complexity
-- of, e.g., @'Data.Text'.'T.cons'@.
foldPatchset'
    :: Bool
        -- ^ Whether this function call originates from somewhere higher up the
        -- document tree; any explicit calls will almost always use 'False'.
    -> [Patch]
    -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' :: Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
_ [] = ([], [])
foldPatchset' Bool
isInner (ErrorList [ParseError]
_:[Patch]
ps) = Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
isInner [Patch]
ps
-- Break infinite loop on unmatched node-closing patches.
foldPatchset' Bool
False (CloseNodes IntMap ReparentDepth
_:[Patch]
ps) = Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
False [Patch]
ps
foldPatchset' Bool
False (Patch
SoftCloseCurrentNode:[Patch]
ps) = Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
False [Patch]
ps
foldPatchset' Bool
False (Patch
DropCurrentNode:[Patch]
ps) = Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
False [Patch]
ps
foldPatchset' Bool
False (Patch
RestartParsing:[Patch]
ps) = Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
False [Patch]
ps
-- Stop processing on node-closing patches to enable recursive consumption of
-- all patches until the end of the node.
foldPatchset' Bool
True ps :: [Patch]
ps@(Patch
DropCurrentNode:[Patch]
_) = ([], [Patch]
ps)
foldPatchset' Bool
True ps :: [Patch]
ps@(Patch
RestartParsing:[Patch]
_) = ([], [Patch]
ps)
-- Push a "close ancestors" along until it reaches one of the node-closing
-- patches; at that point, drop the payload destined for the current location.
foldPatchset' Bool
True (p :: Patch
p@(CloseNodes IntMap ReparentDepth
ls):[Patch]
ps) = case IntMap ReparentDepth -> (ReparentDepth, IntMap ReparentDepth)
decrementReparenting IntMap ReparentDepth
ls of
    (ReparentDepth, IntMap ReparentDepth)
_ | IntMap ReparentDepth -> Bool
forall a. IntMap a -> Bool
M.I.null IntMap ReparentDepth
ls -> Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True [Patch]
ps
    (ReparentDepth
0, IntMap ReparentDepth
toFloat) -> case [Patch]
ps of
        [] -> ([], [Patch
p])
        (CloseNodes IntMap ReparentDepth
ls':[Patch]
ps') ->
            Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True ([Patch]
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ IntMap ReparentDepth -> Patch
CloseNodes ((ReparentDepth -> ReparentDepth -> ReparentDepth)
-> IntMap ReparentDepth
-> IntMap ReparentDepth
-> IntMap ReparentDepth
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
M.I.unionWith ReparentDepth -> ReparentDepth -> ReparentDepth
forall a. Num a => a -> a -> a
(+) IntMap ReparentDepth
ls IntMap ReparentDepth
ls') Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: [Patch]
ps'
        (Patch
DropCurrentNode:[Patch]
ps') ->
            ([], Patch
DropCurrentNode Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: IntMap ReparentDepth -> Patch
CloseNodes IntMap ReparentDepth
toFloat Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: [Patch]
ps')
        (Patch
RestartParsing:[Patch]
_) ->
            ([], [Patch]
ps)
        (p' :: Patch
p'@InsertElement{}:[Patch]
ps') ->
            Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True ([Patch]
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Patch
p' Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: IntMap ReparentDepth -> Patch
CloseNodes (IntMap ReparentDepth -> IntMap ReparentDepth
incrementReparenting IntMap ReparentDepth
ls) Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: [Patch]
ps'
        (Patch
p':[Patch]
ps') ->
            Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True ([Patch]
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Patch
p' Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: Patch
p Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: [Patch]
ps'
    (ReparentDepth, IntMap ReparentDepth)
_ -> ([], Patch
p Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: [Patch]
ps)
-- Simple patch -> node translation.
foldPatchset' Bool
isInner (SetDocumentQuirks QuirksMode
mode:[Patch]
ps) =
    ([Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first ((InsertAt, Tree) -> Either ([ParseError], Char) (InsertAt, Tree)
forall a b. b -> Either a b
Right (InsertAt
InDocument, QuirksMode -> Tree
packQuirks QuirksMode
mode) Either ([ParseError], Char) (InsertAt, Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. a -> [a] -> [a]
:) (([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
isInner [Patch]
ps
foldPatchset' Bool
isInner (InsertAndSetDocumentType [ParseError]
_ DocumentTypeParams
d:[Patch]
ps) =
    ([Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first ((InsertAt, Tree) -> Either ([ParseError], Char) (InsertAt, Tree)
forall a b. b -> Either a b
Right (InsertAt
InDocument, DocumentTypeParams -> Tree
packDoctype DocumentTypeParams
d) Either ([ParseError], Char) (InsertAt, Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. a -> [a] -> [a]
:) (([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
isInner [Patch]
ps
foldPatchset' Bool
isInner (InsertComment [ParseError]
_ InsertAt
loc Text
txt:[Patch]
ps) =
    ([Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first ((InsertAt, Tree) -> Either ([ParseError], Char) (InsertAt, Tree)
forall a b. b -> Either a b
Right (InsertAt
loc, Text -> Tree
packComment Text
txt) Either ([ParseError], Char) (InsertAt, Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. a -> [a] -> [a]
:) (([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
isInner [Patch]
ps
foldPatchset' Bool
isInner (AddAttribute InsertAt
loc AttributeParams
attr:[Patch]
ps) =
    ([Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first ((InsertAt, Tree) -> Either ([ParseError], Char) (InsertAt, Tree)
forall a b. b -> Either a b
Right (InsertAt
loc, AttributeParams -> Tree
packAttribute AttributeParams
attr) Either ([ParseError], Char) (InsertAt, Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. a -> [a] -> [a]
:) (([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
isInner [Patch]
ps
-- Prepends to the following text rather than the spec's appending to the
-- previous.  That should still have an identical result.
foldPatchset' Bool
isInner (InsertCharacter [ParseError]
errs Char
h:[Patch]
ps) =
    ([Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first (([ParseError], Char)
-> Either ([ParseError], Char) (InsertAt, Tree)
forall a b. a -> Either a b
Left ([ParseError]
errs, Char
h) Either ([ParseError], Char) (InsertAt, Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. a -> [a] -> [a]
:) (([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
isInner [Patch]
ps
-- Float non-element nodes up one level.
foldPatchset' Bool
True (Patch
SoftCloseCurrentNode:[Patch]
ps) =
    ([Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first ((Either ([ParseError], Char) (InsertAt, Tree)
 -> Either ([ParseError], Char) (InsertAt, Tree))
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a b. (a -> b) -> [a] -> [b]
map Either ([ParseError], Char) (InsertAt, Tree)
-> Either ([ParseError], Char) (InsertAt, Tree)
forall a.
Either (a, Char) (InsertAt, Tree)
-> Either (a, Char) (InsertAt, Tree)
floatTrees) (([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True [Patch]
ps
  where floatTrees :: Either (a, Char) (InsertAt, Tree)
-> Either (a, Char) (InsertAt, Tree)
floatTrees t' :: Either (a, Char) (InsertAt, Tree)
t'@(Right (RelativeLocation ReparentDepth
l, Tree
t))
            | Node -> Maybe NodeType
nodeType (Tree -> Node
node Tree
t) Maybe NodeType -> Maybe NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
ElementNode = Either (a, Char) (InsertAt, Tree)
t'
            | Bool
otherwise = (InsertAt, Tree) -> Either (a, Char) (InsertAt, Tree)
forall a b. b -> Either a b
Right (ReparentDepth -> InsertAt
RelativeLocation (ReparentDepth -> InsertAt) -> ReparentDepth -> InsertAt
forall a b. (a -> b) -> a -> b
$ ReparentDepth -> ReparentDepth
forall a. Enum a => a -> a
succ ReparentDepth
l, Tree
t)
        -- Text nodes here don't take advantage of ahead-of-time gathering
        -- (thus need more complex concatenation), but shouldn't be a large
        -- portion of the document.
        floatTrees (Left (a
_, Char
c)) = (InsertAt, Tree) -> Either (a, Char) (InsertAt, Tree)
forall a b. b -> Either a b
Right (ReparentDepth -> InsertAt
RelativeLocation ReparentDepth
1, Tree
emptyTree
            { node :: Node
node = Text -> Node
Text (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
            })
        floatTrees Either (a, Char) (InsertAt, Tree)
t' = Either (a, Char) (InsertAt, Tree)
t'
-- Consume patches until and including the (matching) node-closing patch.
foldPatchset' Bool
isInner (InsertElement [ParseError]
_ ElementParams
tag:[Patch]
ps) =
    let ([Either ([ParseError], Char) (InsertAt, Tree)]
ts, [Patch]
ps') = Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True [Patch]
ps
        ([Either ([ParseError], Char) Tree]
ts', [Either ([ParseError], Char) (InsertAt, Tree)]
bubble) = [Either ([ParseError], Char) (InsertAt, Tree)]
-> [InsertAt]
-> ([Either ([ParseError], Char) Tree],
    [Either ([ParseError], Char) (InsertAt, Tree)])
filterFloaters [Either ([ParseError], Char) (InsertAt, Tree)]
ts ([InsertAt]
 -> ([Either ([ParseError], Char) Tree],
     [Either ([ParseError], Char) (InsertAt, Tree)]))
-> [InsertAt]
-> ([Either ([ParseError], Char) Tree],
    [Either ([ParseError], Char) (InsertAt, Tree)])
forall a b. (a -> b) -> a -> b
$ Bool -> ElementParams -> [InsertAt]
floatsElement Bool
isInner ElementParams
tag
        ([Either ([ParseError], Char) Tree]
attrs, [Either ([ParseError], Char) Tree]
ts'') = (Either ([ParseError], Char) Tree -> Bool)
-> [Either ([ParseError], Char) Tree]
-> ([Either ([ParseError], Char) Tree],
    [Either ([ParseError], Char) Tree])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Either ([ParseError], Char) Tree -> Bool
forall a. Either a Tree -> Bool
isAttribute [Either ([ParseError], Char) Tree]
ts'
        tag' :: ElementParams
tag' = ElementParams
tag
            { elementAttributes :: AttributeMap
elementAttributes = AttributeMap -> AttributeMap -> AttributeMap
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union (ElementParams -> AttributeMap
elementAttributes ElementParams
tag) (AttributeMap -> AttributeMap)
-> ([AttributeParams] -> AttributeMap)
-> [AttributeParams]
-> AttributeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                [AttributeParams] -> AttributeMap
fromAttrList ([AttributeParams] -> AttributeMap)
-> [AttributeParams] -> AttributeMap
forall a b. (a -> b) -> a -> b
$ (Either ([ParseError], Char) Tree -> Maybe AttributeParams)
-> [Either ([ParseError], Char) Tree] -> [AttributeParams]
forall a b. (a -> Maybe b) -> [a] -> [b]
Y.mapMaybe Either ([ParseError], Char) Tree -> Maybe AttributeParams
forall a. Either a Tree -> Maybe AttributeParams
toAttribute [Either ([ParseError], Char) Tree]
attrs
            }
        this :: Either a (InsertAt, Tree)
this = (InsertAt, Tree) -> Either a (InsertAt, Tree)
forall a b. b -> Either a b
Right (ReparentDepth -> InsertAt
RelativeLocation ReparentDepth
0, ElementParams -> [Tree] -> Tree
packElement ElementParams
tag' ([Tree] -> Tree) -> [Tree] -> Tree
forall a b. (a -> b) -> a -> b
$ [Either ([ParseError], Char) Tree] -> [Tree]
joinTexts [Either ([ParseError], Char) Tree]
ts'')
    in  case [Patch]
ps' of
        [] -> (Either ([ParseError], Char) (InsertAt, Tree)
forall a. Either a (InsertAt, Tree)
this Either ([ParseError], Char) (InsertAt, Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. a -> [a] -> [a]
: [Either ([ParseError], Char) (InsertAt, Tree)]
bubble, [])
        (Patch
DropCurrentNode:[Patch]
ps'') -> ([Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first ([Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. [a] -> [a] -> [a]
++ [Either ([ParseError], Char) (InsertAt, Tree)]
bubble) (([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True [Patch]
ps''
        (CloseNodes IntMap ReparentDepth
ls:[Patch]
ps'') ->
            let (ReparentDepth
here, IntMap ReparentDepth
toFloat) = IntMap ReparentDepth -> (ReparentDepth, IntMap ReparentDepth)
decrementReparenting IntMap ReparentDepth
ls
                ls' :: IntMap ReparentDepth
ls' = case ReparentDepth
here of
                    ReparentDepth
l | ReparentDepth
l ReparentDepth -> ReparentDepth -> Bool
forall a. Ord a => a -> a -> Bool
>= ReparentDepth
2 -> (ReparentDepth -> ReparentDepth -> ReparentDepth)
-> Key
-> ReparentDepth
-> IntMap ReparentDepth
-> IntMap ReparentDepth
forall a. (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
M.I.insertWith ReparentDepth -> ReparentDepth -> ReparentDepth
forall a. Num a => a -> a -> a
(+) Key
0 (ReparentDepth -> ReparentDepth
forall a. Enum a => a -> a
pred ReparentDepth
l) IntMap ReparentDepth
toFloat
                    ReparentDepth
_ -> IntMap ReparentDepth
toFloat
                ([Either ([ParseError], Char) (InsertAt, Tree)]
out, [Patch]
trail) = Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True ([Patch]
 -> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch]))
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
forall a b. (a -> b) -> a -> b
$ IntMap ReparentDepth -> Patch
CloseNodes IntMap ReparentDepth
ls' Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: [Patch]
ps''
            in  (Either ([ParseError], Char) (InsertAt, Tree)
forall a. Either a (InsertAt, Tree)
this Either ([ParseError], Char) (InsertAt, Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. a -> [a] -> [a]
: [Either ([ParseError], Char) (InsertAt, Tree)]
bubble [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. [a] -> [a] -> [a]
++ [Either ([ParseError], Char) (InsertAt, Tree)]
out, [Patch]
trail)
        (Patch
RestartParsing:[Patch]
_) -> ([], [Patch]
ps')
        [Patch]
_ ->
            let ([Either ([ParseError], Char) (InsertAt, Tree)]
out, [Patch]
trail) = Bool
-> [Patch]
-> ([Either ([ParseError], Char) (InsertAt, Tree)], [Patch])
foldPatchset' Bool
True [Patch]
ps'
                cleaned :: [Either ([ParseError], Char) (InsertAt, Tree)]
cleaned = (Either ([ParseError], Char) Tree
 -> Either ([ParseError], Char) (InsertAt, Tree))
-> [Either ([ParseError], Char) Tree]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a b. (a -> b) -> [a] -> [b]
map ((Tree -> (InsertAt, Tree))
-> Either ([ParseError], Char) Tree
-> Either ([ParseError], Char) (InsertAt, Tree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tree -> (InsertAt, Tree))
 -> Either ([ParseError], Char) Tree
 -> Either ([ParseError], Char) (InsertAt, Tree))
-> (Tree -> (InsertAt, Tree))
-> Either ([ParseError], Char) Tree
-> Either ([ParseError], Char) (InsertAt, Tree)
forall a b. (a -> b) -> a -> b
$ \Tree
c -> (ReparentDepth -> InsertAt
RelativeLocation ReparentDepth
0, Tree
c)) [Either ([ParseError], Char) Tree]
ts''
            in  ([Either ([ParseError], Char) (InsertAt, Tree)]
cleaned [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. [a] -> [a] -> [a]
++ [Either ([ParseError], Char) (InsertAt, Tree)]
out [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a. [a] -> [a] -> [a]
++ [Either ([ParseError], Char) (InsertAt, Tree)]
bubble, [Patch]
trail)
  where isAttribute :: Either a Tree -> Bool
isAttribute (Right Tree
tok) = Node -> Maybe NodeType
nodeType (Tree -> Node
node Tree
tok) Maybe NodeType -> Maybe NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
AttributeNode
        isAttribute (Left a
_) = Bool
False
        toAttribute :: Either a Tree -> Maybe AttributeParams
toAttribute (Right Tree
tok) = case Tree -> Node
node Tree
tok of
            Attribute AttributeParams
attr -> AttributeParams -> Maybe AttributeParams
forall a. a -> Maybe a
Just AttributeParams
attr
            Node
_ -> Maybe AttributeParams
forall a. Maybe a
Nothing
        toAttribute (Left a
_) = Maybe AttributeParams
forall a. Maybe a
Nothing


-- | Given a heterogeneous set of patches potentially destined for multiple
-- places within the document hierarchy, and a known set of addresses for the
-- current location, partition out the relevant patches from those continuing
-- onward.
filterFloaters
    :: [Either ([ParseError], Char) (InsertAt, Tree)]
    -> [InsertAt]
    -> ([Either ([ParseError], Char) Tree], [Either ([ParseError], Char) (InsertAt, Tree)])
filterFloaters :: [Either ([ParseError], Char) (InsertAt, Tree)]
-> [InsertAt]
-> ([Either ([ParseError], Char) Tree],
    [Either ([ParseError], Char) (InsertAt, Tree)])
filterFloaters [Either ([ParseError], Char) (InsertAt, Tree)]
ts [InsertAt]
here = ([Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) Tree])
-> ([Either ([ParseError], Char) (InsertAt, Tree)]
    -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) (InsertAt, Tree)],
    [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) Tree],
    [Either ([ParseError], Char) (InsertAt, Tree)])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
F.B.bimap
    ((Either ([ParseError], Char) (InsertAt, Tree)
 -> Either ([ParseError], Char) Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) Tree]
forall a b. (a -> b) -> [a] -> [b]
map ((Either ([ParseError], Char) (InsertAt, Tree)
  -> Either ([ParseError], Char) Tree)
 -> [Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) Tree])
-> (Either ([ParseError], Char) (InsertAt, Tree)
    -> Either ([ParseError], Char) Tree)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) Tree]
forall a b. (a -> b) -> a -> b
$ ((InsertAt, Tree) -> Tree)
-> Either ([ParseError], Char) (InsertAt, Tree)
-> Either ([ParseError], Char) Tree
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
F.B.second (InsertAt, Tree) -> Tree
forall a b. (a, b) -> b
snd)
    ((Either ([ParseError], Char) (InsertAt, Tree)
 -> Either ([ParseError], Char) (InsertAt, Tree))
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a b. (a -> b) -> [a] -> [b]
map ((Either ([ParseError], Char) (InsertAt, Tree)
  -> Either ([ParseError], Char) (InsertAt, Tree))
 -> [Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> (((InsertAt, Tree) -> (InsertAt, Tree))
    -> Either ([ParseError], Char) (InsertAt, Tree)
    -> Either ([ParseError], Char) (InsertAt, Tree))
-> ((InsertAt, Tree) -> (InsertAt, Tree))
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((InsertAt, Tree) -> (InsertAt, Tree))
-> Either ([ParseError], Char) (InsertAt, Tree)
-> Either ([ParseError], Char) (InsertAt, Tree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((InsertAt, Tree) -> (InsertAt, Tree))
 -> [Either ([ParseError], Char) (InsertAt, Tree)]
 -> [Either ([ParseError], Char) (InsertAt, Tree)])
-> ((InsertAt, Tree) -> (InsertAt, Tree))
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> [Either ([ParseError], Char) (InsertAt, Tree)]
forall a b. (a -> b) -> a -> b
$ (InsertAt -> InsertAt) -> (InsertAt, Tree) -> (InsertAt, Tree)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first InsertAt -> InsertAt
decrementTarget) (([Either ([ParseError], Char) (InsertAt, Tree)],
  [Either ([ParseError], Char) (InsertAt, Tree)])
 -> ([Either ([ParseError], Char) Tree],
     [Either ([ParseError], Char) (InsertAt, Tree)]))
-> ([Either ([ParseError], Char) (InsertAt, Tree)],
    [Either ([ParseError], Char) (InsertAt, Tree)])
-> ([Either ([ParseError], Char) Tree],
    [Either ([ParseError], Char) (InsertAt, Tree)])
forall a b. (a -> b) -> a -> b
$
    (Either ([ParseError], Char) (InsertAt, Tree) -> Bool)
-> [Either ([ParseError], Char) (InsertAt, Tree)]
-> ([Either ([ParseError], Char) (InsertAt, Tree)],
    [Either ([ParseError], Char) (InsertAt, Tree)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Either ([ParseError], Char) (InsertAt, Tree) -> Bool
forall a b. Either a (InsertAt, b) -> Bool
isHere [Either ([ParseError], Char) (InsertAt, Tree)]
ts
  where decrementTarget :: InsertAt -> InsertAt
decrementTarget InsertAt
loc = case InsertAt
loc of
            RelativeLocation ReparentDepth
0 -> InsertAt
loc
            RelativeLocation ReparentDepth
i -> ReparentDepth -> InsertAt
RelativeLocation (ReparentDepth -> InsertAt) -> ReparentDepth -> InsertAt
forall a b. (a -> b) -> a -> b
$ ReparentDepth -> ReparentDepth
forall a. Enum a => a -> a
pred ReparentDepth
i
            InsertAt
_ -> InsertAt
loc
        isHere :: Either a (InsertAt, b) -> Bool
isHere (Right (InsertAt
l, b
_)) = InsertAt -> [InsertAt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem InsertAt
l [InsertAt]
here
        isHere (Left a
_) = Bool
True

-- | Calculate the accepted addresses for the element at the current location;
-- usually just @'RelativeLocation' 0@, but a root @\<html\>@ node also accepts
-- 'InHtmlElement'.
floatsElement
    :: Bool
        -- ^ Whether this node is a descendant node of the root.
    -> ElementParams
    -> [InsertAt]
floatsElement :: Bool -> ElementParams -> [InsertAt]
floatsElement Bool
isInner ElementParams
d
    | ElementParams -> Text
elementName ElementParams
d Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"html" Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isInner = [ReparentDepth -> InsertAt
RelativeLocation ReparentDepth
0, InsertAt
InHtmlElement]
    | Bool
otherwise = [ReparentDepth -> InsertAt
RelativeLocation ReparentDepth
0]


-- | Given the list of reparenting directives used by a 'CloseNodes'
-- instruction, increase the distance to the node-to-reparent to account for
-- the patch being pushed into a child node.
incrementReparenting :: M.I.IntMap ReparentDepth -> M.I.IntMap ReparentDepth
incrementReparenting :: IntMap ReparentDepth -> IntMap ReparentDepth
incrementReparenting = (Key -> Key) -> IntMap ReparentDepth -> IntMap ReparentDepth
forall a. (Key -> Key) -> IntMap a -> IntMap a
M.I.mapKeys Key -> Key
forall a. Enum a => a -> a
succ

-- | Given the list of reparenting directives used by a 'CloseNodes'
-- instruction, partition out the accumulated directives intended for the
-- current node, and decrease the distance to the node-to-reparent to account
-- for the child node being closed.
decrementReparenting :: M.I.IntMap ReparentDepth -> (ReparentDepth, M.I.IntMap ReparentDepth)
decrementReparenting :: IntMap ReparentDepth -> (ReparentDepth, IntMap ReparentDepth)
decrementReparenting IntMap ReparentDepth
ls = (ReparentDepth -> Maybe ReparentDepth -> ReparentDepth
forall a. a -> Maybe a -> a
Y.fromMaybe ReparentDepth
0 (Maybe ReparentDepth -> ReparentDepth)
-> Maybe ReparentDepth -> ReparentDepth
forall a b. (a -> b) -> a -> b
$ Key -> IntMap ReparentDepth -> Maybe ReparentDepth
forall a. Key -> IntMap a -> Maybe a
M.I.lookup Key
0 IntMap ReparentDepth
ls, (Key -> Key) -> IntMap ReparentDepth -> IntMap ReparentDepth
forall a. (Key -> Key) -> IntMap a -> IntMap a
M.I.mapKeys Key -> Key
forall a. Enum a => a -> a
pred (IntMap ReparentDepth -> IntMap ReparentDepth)
-> IntMap ReparentDepth -> IntMap ReparentDepth
forall a b. (a -> b) -> a -> b
$ Key -> IntMap ReparentDepth -> IntMap ReparentDepth
forall a. Key -> IntMap a -> IntMap a
M.I.delete Key
0 IntMap ReparentDepth
ls)


-- | Collapse all sequential 'Char' sequences in the list and pack them into a
-- single 'Text' node, preserving the interspersed complete subtrees.
joinTexts :: [Either ([ParseError], Char) Tree] -> [Tree]
joinTexts :: [Either ([ParseError], Char) Tree] -> [Tree]
joinTexts [] = []
joinTexts (Right Tree
t : [Either ([ParseError], Char) Tree]
xs) = Tree
t Tree -> [Tree] -> [Tree]
forall a. a -> [a] -> [a]
: [Either ([ParseError], Char) Tree] -> [Tree]
joinTexts [Either ([ParseError], Char) Tree]
xs
joinTexts (Left ([ParseError], Char)
c : [Either ([ParseError], Char) Tree]
xs) = Tree
txt' Tree -> [Tree] -> [Tree]
forall a. a -> [a] -> [a]
: [Either ([ParseError], Char) Tree] -> [Tree]
joinTexts [Either ([ParseError], Char) Tree]
xs'
  where ([Either ([ParseError], Char) Tree]
cs', [Either ([ParseError], Char) Tree]
xs') = (Either ([ParseError], Char) Tree -> Bool)
-> [Either ([ParseError], Char) Tree]
-> ([Either ([ParseError], Char) Tree],
    [Either ([ParseError], Char) Tree])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Either ([ParseError], Char) Tree -> Bool
forall a b. Either a b -> Bool
E.isLeft [Either ([ParseError], Char) Tree]
xs
        cs :: [([ParseError], Char)]
cs = (Either ([ParseError], Char) Tree -> ([ParseError], Char))
-> [Either ([ParseError], Char) Tree] -> [([ParseError], Char)]
forall a b. (a -> b) -> [a] -> [b]
map ((([ParseError], Char) -> ([ParseError], Char))
-> (Tree -> ([ParseError], Char))
-> Either ([ParseError], Char) Tree
-> ([ParseError], Char)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([ParseError], Char) -> ([ParseError], Char)
forall a. a -> a
id ((Tree -> ([ParseError], Char))
 -> Either ([ParseError], Char) Tree -> ([ParseError], Char))
-> (Tree -> ([ParseError], Char))
-> Either ([ParseError], Char) Tree
-> ([ParseError], Char)
forall a b. (a -> b) -> a -> b
$ String -> Tree -> ([ParseError], Char)
forall a. HasCallStack => String -> a
error String
"unexpected 'Right' after @span isLeft@") [Either ([ParseError], Char) Tree]
cs'
        ([[ParseError]]
_, String
txt) = [([ParseError], Char)] -> ([[ParseError]], String)
forall a b. [(a, b)] -> ([a], [b])
unzip ([([ParseError], Char)] -> ([[ParseError]], String))
-> [([ParseError], Char)] -> ([[ParseError]], String)
forall a b. (a -> b) -> a -> b
$ ([ParseError], Char)
c ([ParseError], Char)
-> [([ParseError], Char)] -> [([ParseError], Char)]
forall a. a -> [a] -> [a]
: [([ParseError], Char)]
cs
        txt' :: Tree
txt' = Tree
emptyTree
            { node :: Node
node = Text -> Node
Text (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
txt
            }


-- | Wrap the desired level of backwards compatibility into a 'Document' node
-- as a placeholder.
packQuirks :: QuirksMode -> Tree
packQuirks :: QuirksMode -> Tree
packQuirks QuirksMode
mode = Tree
emptyTree
    { node :: Node
node = QuirksMode -> Node
Document QuirksMode
mode
    }

-- | Wrap a string of characters in the data types expected for a 'Comment'
-- node in the output of 'buildTree'.
packComment :: T.Text -> Tree
packComment :: Text -> Tree
packComment Text
txt = Tree
emptyTree
    { node :: Node
node = Text -> Node
Comment Text
txt
    }

-- | Wrap the metadata contained in a document type declaration in the data
-- types expected for a 'DocumentType' node in the output of 'buildTree'.
packDoctype :: DocumentTypeParams -> Tree
packDoctype :: DocumentTypeParams -> Tree
packDoctype DocumentTypeParams
dtd = Tree
emptyTree
    { node :: Node
node = DocumentTypeParams -> Node
DocumentType DocumentTypeParams
dtd
    }

-- | Wrap the metadata contained in a markup tag in the data types expected for
-- an 'Element' node in the output of 'buildTree'.  If it represents an HTML
-- @\<template\>@ element, additionally wrap the children in a
-- 'DocumentFragment' node to indicate the @[template
-- contents](https://html.spec.whatwg.org/scripting.html#template-contents)@
-- parameter.
packElement :: ElementParams -> [Tree] -> Tree
packElement :: ElementParams -> [Tree] -> Tree
packElement ElementParams
tag [Tree]
childTrees
    | Text -> ElementParams -> Bool
nodeIsElement (String -> Text
T.pack String
"template") ElementParams
tag = Tree
emptyTree
        { node :: Node
node = Node
e
        , children :: [Tree]
children = [Tree
emptyTree
            { node :: Node
node = Node
DocumentFragment
            , children :: [Tree]
children = [Tree]
childTrees
            }]
        }
    | Bool
otherwise = Tree
emptyTree
        { node :: Node
node = Node
e
        , children :: [Tree]
children = [Tree]
childTrees
        }
  where e :: Node
e = ElementParams -> Node
Element ElementParams
tag

-- | Wrap the metadata contained in a metadata tag's attribute in the data
-- types expected for an 'Attribute' node in the output of 'buildTree'; this
-- will then be subsumed into the parent 'Element' node, and does not remain in
-- the final document tree.
packAttribute :: AttributeParams -> Tree
packAttribute :: AttributeParams -> Tree
packAttribute AttributeParams
attr = Tree
emptyTree
    { node :: Node
node = AttributeParams -> Node
Attribute AttributeParams
attr
    }