{-# LANGUAGE OverloadedStrings #-}

{-|
Description:    Functions and objects used to build the tree construction parser.

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

Stability:      provisional
Portability:    portable

This module provides the data structures and common functions used in the
first half of this implementation's split
__[HTML](https://html.spec.whatwg.org/multipage/parsing.html#tree-construction)__
tree construction algorithm; for more discussion on the structure, see the
documentation on "Web.Mangrove.Parse.Tree.Patch".  In particular, these objects
handle the state transitions and token processing which form the foundation of
that parser on which the 'Web.Mangrove.Parse.Tree.Patch.Patch' generation will
be able to build.
-}
module Web.Mangrove.Parse.Tree.Common
    ( -- * Types
      -- ** Tree construction
      -- *** Parser
      TreeBuilder
    , TreeState ( .. )
    , TreeParserState ( .. )
    , defaultTreeState
    , NodeIndex
    , InsertionMode ( .. )
      -- *** Data
      -- **** Elements
    , nodeIsElement
    , nodeIsSpecial
    , ElementParams ( .. )
    , emptyElementParams
    , packNodeData
    , scopeElements
    , specialElements
      -- **** Attributes
    , AttributeParams ( .. )
    , emptyAttributeParams
    , adjustForeignAttributes
    , adjustMathMLAttributes
    , adjustSvgAttributes
      -- **** Document type declarations
    , DocumentTypeParams ( .. )
    , emptyDocumentTypeParams
    , QuirksMode ( .. )
      -- ** Tokenization
      -- *** Parser
    , TokenizerState ( .. )
    , CurrentTokenizerState ( .. )
      -- *** Data
    , Token ( .. )
    , TreeInput ( .. )
    , TokenizerOutputState
    , tokenRemainder
    , dummyToken
    , dummyStateToken
    , mapTokenState
    , mapTokenState'
    , TagParams ( .. )
    , emptyTagParams
      -- *** Extraction
    , tokenCharacter
    , tokenDoctype
    , tokenDocumentType
    , tokenTag
    , tokenElement
      -- * Parser building
      -- ** Token matching
    , isEOF
    , isCharacter
    , isNull
    , isWhitespace
    , isComment
    , isDoctype
    , isAnyStartTag
    , isAnyEndTag
    , isStartTag
    , isEndTag
      -- ** State modification
    , switchMode
    , resetMode
    , setFramesetNotOk
    , insertFormattingMarker
    , clearFormattingElements
    , pushTemplateMode
    , popTemplateMode
    , resetInsertionMode
    , resetInsertionMode'
      -- ** Current node
      -- *** Retrieval
    , currentNode
    , currentNodeIndex
    , adjustedCurrentNode
      -- *** Namespace boundaries
    , atHtmlIntegration
    , atMathMLIntegration
    , isMathMLAnnotationXml
      -- ** Ancestor testing
    , inFragment
    , inIFrameSrcDoc
    , hasOpenElement
    , hasOpenElementExcept
      -- *** Scope
    , hasInScope
    , hasIndexInScope
    , hasInButtonScope
    , hasInListItemScope
    , hasInTableScope
    , hasInSelectScope
    ) where


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

import qualified Data.Bifunctor as F.B
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as M
import qualified Data.Maybe as Y
import qualified Data.Text as T

import qualified Numeric.Natural as Z

import Web.Willow.DOM hiding
    ( Tree ( .. )
    , Node ( .. )
    )

import Web.Mangrove.Parse.Common.Error
import Web.Mangrove.Parse.Tokenize.Common
import Web.Willow.Common.Encoding.Character
import Web.Willow.Common.Parser


-- | Parser combinators written over the output of the
-- "Web.Mangrove.Parse.Tokenize" stage, transforming it into a sequence of
-- folding instruction 'Web.Mangrove.Parse.Tree.Patch.Patch'es.
type TreeBuilder out = StateParser TreeParserState [TreeInput] out

-- | The collection of data returned by the "Web.Mangrove.Parse.Tokenize"
-- stage, and so comprising the input to the tree construction parser.
-- Values may be easily instantiated through 'dummyToken' or dummyStateToken'.
data TreeInput = TreeInput
    { TreeInput -> [ParseError]
tokenErrs :: [ParseError]
        -- ^ Any authoring errors detected during decoding and tokenization.
    , TreeInput -> Token
tokenOut :: Token
        -- ^ The token itself.
    , TreeInput -> TokenizerOutputState
tokenState :: TokenizerOutputState
        -- ^ The data required to resume decoding immediately following the
        -- value, if possible.  See also 'decodedRemainder'.
    }
  deriving ( TreeInput -> TreeInput -> Bool
(TreeInput -> TreeInput -> Bool)
-> (TreeInput -> TreeInput -> Bool) -> Eq TreeInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeInput -> TreeInput -> Bool
$c/= :: TreeInput -> TreeInput -> Bool
== :: TreeInput -> TreeInput -> Bool
$c== :: TreeInput -> TreeInput -> Bool
Eq, Int -> TreeInput -> ShowS
[TreeInput] -> ShowS
TreeInput -> String
(Int -> TreeInput -> ShowS)
-> (TreeInput -> String)
-> ([TreeInput] -> ShowS)
-> Show TreeInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeInput] -> ShowS
$cshowList :: [TreeInput] -> ShowS
show :: TreeInput -> String
$cshow :: TreeInput -> String
showsPrec :: Int -> TreeInput -> ShowS
$cshowsPrec :: Int -> TreeInput -> ShowS
Show, ReadPrec [TreeInput]
ReadPrec TreeInput
Int -> ReadS TreeInput
ReadS [TreeInput]
(Int -> ReadS TreeInput)
-> ReadS [TreeInput]
-> ReadPrec TreeInput
-> ReadPrec [TreeInput]
-> Read TreeInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TreeInput]
$creadListPrec :: ReadPrec [TreeInput]
readPrec :: ReadPrec TreeInput
$creadPrec :: ReadPrec TreeInput
readList :: ReadS [TreeInput]
$creadList :: ReadS [TreeInput]
readsPrec :: Int -> ReadS TreeInput
$creadsPrec :: Int -> ReadS TreeInput
Read )

-- | The unparsed portion of the binary stream, /after/ parsing the associated
-- token.  See also 'tokenState'.
tokenRemainder :: TreeInput -> Maybe BS.ByteString
tokenRemainder :: TreeInput -> Maybe ByteString
tokenRemainder = ((TokenizerState, ByteString) -> ByteString)
-> TokenizerOutputState -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenizerState, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (TokenizerOutputState -> Maybe ByteString)
-> (TreeInput -> TokenizerOutputState)
-> TreeInput
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeInput -> TokenizerOutputState
tokenState

-- | All data with which to re-initialize the tokenizer, to resume as if the
-- state machine transition hadn't been interrupted.  If 'Nothing', the
-- associated 'Token' was emitted in the 'init' of several at once; in this
-- case, the tokenizer can't be re-entered in exactly the same place with the
-- data wrapped in this type, and so the stream must continue to be processed
-- until the first 'Just' value.
type TokenizerOutputState = Maybe (TokenizerState, BS.ByteString)


-- | Generate a token /a priori/ in the tree construction stage to pass to a
-- function expecting the raw tokenizer output.  See 'dummyStateToken' if a
-- known 'TokenizerOutputState' must be associated as well.
dummyToken :: [ParseError] -> Token -> TreeInput
dummyToken :: [ParseError] -> Token -> TreeInput
dummyToken [ParseError]
errs Token
t = [ParseError] -> Token -> TokenizerOutputState -> TreeInput
dummyStateToken [ParseError]
errs Token
t TokenizerOutputState
forall a. Maybe a
Nothing

-- | Generate a token /a priori/ in the tree construction stage to pass to a
-- function expecting the raw tokenizer output, attaching a specific resume
-- state.  For most of the standard parsers, 'dummyToken' should be used
-- instead.
dummyStateToken :: [ParseError] -> Token -> TokenizerOutputState -> TreeInput
dummyStateToken :: [ParseError] -> Token -> TokenizerOutputState -> TreeInput
dummyStateToken [ParseError]
errs Token
t TokenizerOutputState
state = TreeInput :: [ParseError] -> Token -> TokenizerOutputState -> TreeInput
TreeInput
    { tokenErrs :: [ParseError]
tokenErrs = [ParseError]
errs
    , tokenOut :: Token
tokenOut = Token
t
    , tokenState :: TokenizerOutputState
tokenState = TokenizerOutputState
state
    }

-- | Extract a single 'Char' from an input value.  Returns Nothing if the inner
-- 'Token' is not a 'Character'.
tokenCharacter :: TreeInput -> Maybe Char
tokenCharacter :: TreeInput -> Maybe Char
tokenCharacter TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    Character Char
c -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
    Token
_ -> Maybe Char
forall a. Maybe a
Nothing

-- | Extract the data comprising a DOCTYPE declaration from an input value.
-- Returns an empty collection if the inner 'Token' is not a 'Doctype'.
tokenDoctype :: TreeInput -> DoctypeParams
tokenDoctype :: TreeInput -> DoctypeParams
tokenDoctype TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    Doctype DoctypeParams
d -> DoctypeParams
d
    Token
_ -> DoctypeParams
emptyDoctypeParams

-- | Extract the data comprising a DOCTYPE declaration from an input value, in
-- a form suitable for 'ParseError's.  Returns an empty collection if the inner
-- 'Token' is not a 'Doctype'.
tokenDocumentType :: TreeInput -> DocumentTypeParams
tokenDocumentType :: TreeInput -> DocumentTypeParams
tokenDocumentType TreeInput
t' = DocumentTypeParams
emptyDocumentTypeParams
    { documentTypeName :: DoctypeName
documentTypeName = DoctypeName -> Maybe DoctypeName -> DoctypeName
forall a. a -> Maybe a -> a
Y.fromMaybe DoctypeName
T.empty (Maybe DoctypeName -> DoctypeName)
-> Maybe DoctypeName -> DoctypeName
forall a b. (a -> b) -> a -> b
$ DoctypeParams -> Maybe DoctypeName
doctypeName DoctypeParams
d
    , documentTypePublicId :: DoctypeName
documentTypePublicId = DoctypeName -> Maybe DoctypeName -> DoctypeName
forall a. a -> Maybe a -> a
Y.fromMaybe DoctypeName
T.empty (Maybe DoctypeName -> DoctypeName)
-> Maybe DoctypeName -> DoctypeName
forall a b. (a -> b) -> a -> b
$ DoctypeParams -> Maybe DoctypeName
doctypePublicId DoctypeParams
d
    , documentTypeSystemId :: DoctypeName
documentTypeSystemId = DoctypeName -> Maybe DoctypeName -> DoctypeName
forall a. a -> Maybe a -> a
Y.fromMaybe DoctypeName
T.empty (Maybe DoctypeName -> DoctypeName)
-> Maybe DoctypeName -> DoctypeName
forall a b. (a -> b) -> a -> b
$ DoctypeParams -> Maybe DoctypeName
doctypeSystemId DoctypeParams
d
    }
  where d :: DoctypeParams
d = TreeInput -> DoctypeParams
tokenDoctype TreeInput
t'

-- | Extract the data comprising a markup element from an input value.  Returns
-- 'emptyTagParams' if the inner 'Token' is neither a 'StartTag' nor an
-- 'EndTag'.
tokenTag :: TreeInput -> TagParams
tokenTag :: TreeInput -> TagParams
tokenTag TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    StartTag TagParams
d -> TagParams
d
    EndTag TagParams
d -> TagParams
d
    Token
_ -> TagParams
emptyTagParams

-- | Extract the data comprising a markup element from an input value, in a
-- form suitable for 'ParseError's.  Returns an empty collection in the
-- 'htmlNamespace' if the inner 'Token' is neither a 'StartTag' nor an
-- 'EndTag'.
tokenElement :: TreeInput -> ElementParams
tokenElement :: TreeInput -> ElementParams
tokenElement = Maybe DoctypeName -> TagParams -> ElementParams
packNodeData (DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
htmlNamespace) (TagParams -> ElementParams)
-> (TreeInput -> TagParams) -> TreeInput -> ElementParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeInput -> TagParams
tokenTag


-- | Modify the state of the tokenizer as given by one of the wrapped tokens
-- used as input to the tree construction parsers.
mapTokenState :: TreeInput -> (TokenParserState -> TokenParserState) -> TreeInput
mapTokenState :: TreeInput -> (TokenParserState -> TokenParserState) -> TreeInput
mapTokenState TreeInput
t' TokenParserState -> TokenParserState
f = TreeInput
t'
    { tokenState :: TokenizerOutputState
tokenState = (TokenizerState -> TokenizerState)
-> (TokenizerState, ByteString) -> (TokenizerState, ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first TokenizerState -> TokenizerState
f' ((TokenizerState, ByteString) -> (TokenizerState, ByteString))
-> TokenizerOutputState -> TokenizerOutputState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeInput -> TokenizerOutputState
tokenState TreeInput
t'
    }
  where f' :: TokenizerState -> TokenizerState
f' TokenizerState
state = TokenizerState
state
            { tokenParserState :: TokenParserState
tokenParserState = TokenParserState -> TokenParserState
f (TokenParserState -> TokenParserState)
-> TokenParserState -> TokenParserState
forall a b. (a -> b) -> a -> b
$ TokenizerState -> TokenParserState
tokenParserState TokenizerState
state
            }

-- | Modify the semi-opaque wrapped state of the tokenizer, within one of the
-- wrapped tokens used as input to the tree construction parsers.
mapTokenState' :: TreeInput -> (TokenizerOutputState -> TokenizerOutputState) -> TreeInput
mapTokenState' :: TreeInput
-> (TokenizerOutputState -> TokenizerOutputState) -> TreeInput
mapTokenState' TreeInput
t' TokenizerOutputState -> TokenizerOutputState
f = TreeInput
t'
    { tokenState :: TokenizerOutputState
tokenState = TokenizerOutputState -> TokenizerOutputState
f (TokenizerOutputState -> TokenizerOutputState)
-> TokenizerOutputState -> TokenizerOutputState
forall a b. (a -> b) -> a -> b
$ TreeInput -> TokenizerOutputState
tokenState TreeInput
t'
    }


-- | Lift the tag data collected by the tokenizer into the namespaced datatype
-- of the DOM tree.
packNodeData :: Maybe Namespace -> TagParams -> ElementParams
packNodeData :: Maybe DoctypeName -> TagParams -> ElementParams
packNodeData Maybe DoctypeName
ns TagParams
d = ElementParams
emptyElementParams
    { elementName :: DoctypeName
elementName = TagParams -> DoctypeName
tagName TagParams
d
    , elementNamespace :: Maybe DoctypeName
elementNamespace = Maybe DoctypeName
ns
    , elementAttributes :: AttributeMap
elementAttributes = [((Maybe DoctypeName, DoctypeName),
  (Maybe DoctypeName, DoctypeName))]
-> AttributeMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([((Maybe DoctypeName, DoctypeName),
   (Maybe DoctypeName, DoctypeName))]
 -> AttributeMap)
-> (HashMap DoctypeName DoctypeName
    -> [((Maybe DoctypeName, DoctypeName),
         (Maybe DoctypeName, DoctypeName))])
-> HashMap DoctypeName DoctypeName
-> AttributeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DoctypeName, DoctypeName)
 -> ((Maybe DoctypeName, DoctypeName),
     (Maybe DoctypeName, DoctypeName)))
-> [(DoctypeName, DoctypeName)]
-> [((Maybe DoctypeName, DoctypeName),
     (Maybe DoctypeName, DoctypeName))]
forall a b. (a -> b) -> [a] -> [b]
map (DoctypeName, DoctypeName)
-> ((Maybe DoctypeName, DoctypeName),
    (Maybe DoctypeName, DoctypeName))
forall b b a a. (b, b) -> ((Maybe a, b), (Maybe a, b))
packAttr ([(DoctypeName, DoctypeName)]
 -> [((Maybe DoctypeName, DoctypeName),
      (Maybe DoctypeName, DoctypeName))])
-> (HashMap DoctypeName DoctypeName
    -> [(DoctypeName, DoctypeName)])
-> HashMap DoctypeName DoctypeName
-> [((Maybe DoctypeName, DoctypeName),
     (Maybe DoctypeName, DoctypeName))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap DoctypeName DoctypeName -> [(DoctypeName, DoctypeName)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap DoctypeName DoctypeName -> AttributeMap)
-> HashMap DoctypeName DoctypeName -> AttributeMap
forall a b. (a -> b) -> a -> b
$ TagParams -> HashMap DoctypeName DoctypeName
tagAttributes TagParams
d
    }
  where packAttr :: (b, b) -> ((Maybe a, b), (Maybe a, b))
packAttr (b
n, b
v) = ((Maybe a
forall a. Maybe a
Nothing, b
n), (Maybe a
forall a. Maybe a
Nothing, b
v))


-- | Type-level clarification for an identifier uniquely identifying each
-- element in the document tree, assigned in a rough tree order.
-- 
-- The specification assumes a reference-based and mutable memory model, where
-- each element in, e.g., the stack of open elements not only describes the
-- shape of the node, but also is distinct from all other nodes with the same
-- data.  Haskell's memory is much less accessible and more likely to be
-- shared, so an extra datapoint needs to be carried along.
type NodeIndex = Z.Natural


-- | The collection of data required to extract a list of semantic atoms from a
-- binary document stream.  Values may be easily instantiated as updates to
-- 'defaultTreeState'.
data TreeState = TreeState
    { TreeState -> TreeParserState
treeParserState :: TreeParserState
        -- ^ The state of the current 'Web.Mangrove.Parse.Tree.tree' stage.
    , TreeState -> TokenizerState
tokenizerState :: TokenizerState
        -- ^ The state of the previous tokenization stage.  Note that the
        -- high-level conceptual view of the parser stack is of each stage
        -- moving along the 'BS.ByteString' as a (more or less) unified
        -- front, rather than each stage independently running over the output
        -- of the previous.
    }
  deriving ( TreeState -> TreeState -> Bool
(TreeState -> TreeState -> Bool)
-> (TreeState -> TreeState -> Bool) -> Eq TreeState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeState -> TreeState -> Bool
$c/= :: TreeState -> TreeState -> Bool
== :: TreeState -> TreeState -> Bool
$c== :: TreeState -> TreeState -> Bool
Eq, Int -> TreeState -> ShowS
[TreeState] -> ShowS
TreeState -> String
(Int -> TreeState -> ShowS)
-> (TreeState -> String)
-> ([TreeState] -> ShowS)
-> Show TreeState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeState] -> ShowS
$cshowList :: [TreeState] -> ShowS
show :: TreeState -> String
$cshow :: TreeState -> String
showsPrec :: Int -> TreeState -> ShowS
$cshowsPrec :: Int -> TreeState -> ShowS
Show, ReadPrec [TreeState]
ReadPrec TreeState
Int -> ReadS TreeState
ReadS [TreeState]
(Int -> ReadS TreeState)
-> ReadS [TreeState]
-> ReadPrec TreeState
-> ReadPrec [TreeState]
-> Read TreeState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TreeState]
$creadListPrec :: ReadPrec [TreeState]
readPrec :: ReadPrec TreeState
$creadPrec :: ReadPrec TreeState
readList :: ReadS [TreeState]
$creadList :: ReadS [TreeState]
readsPrec :: Int -> ReadS TreeState
$creadsPrec :: Int -> ReadS TreeState
Read )

-- | All the data which needs to be tracked for correct behaviour in the tree
-- construction stage.
data TreeParserState = TreeParserState
    { TreeParserState -> InsertionMode
insertionMode :: InsertionMode
        -- ^ __HTML:__
        --      @[insertion mode]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#insertion-mode)@
        -- 
        -- The set of rules currently active in the state machine.
    , TreeParserState -> Maybe InsertionMode
originalInsertionMode :: Maybe InsertionMode
        -- ^ __HTML:__
        --      @[original insertion mode]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#original-insertion-mode)@
        -- 
        -- Which part of the state machine should be returned to after exiting
        -- the 'InText' insertion mode.
    , TreeParserState -> [InsertionMode]
templateInsertionModes :: [InsertionMode]
        -- ^ __HTML:__
        --      @[stack of template insertion modes]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#stack-of-template-insertion-modes)@
        -- 
        -- Which part(s) of the state machine should be returned to after
        -- exiting the 'InTemplate' insertion mode.
    , TreeParserState -> [(NodeIndex, ElementParams)]
openElements :: [(NodeIndex, ElementParams)]
        -- ^ __HTML:__
        --      @[stack of open elements]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#stack-of-open-elements)@
        -- 
        -- The ancestors of/path to the currently "active" node, closest parent
        -- first.
    , TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements :: [[(NodeIndex, TagParams)]]
        -- ^ __HTML:__
        --      @[list of active formatting elements]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#list-of-active-formatting-elements)@
        -- 
        -- The elements which should be reconstructed at the beginning of a tag
        -- closed unexpectedly early (overlapping tags).  These are divided
        -- into groups at particularly independent sections of the tree.
    , TreeParserState -> NodeIndex
elementIndex :: NodeIndex
        -- ^ The unique ID for the /next/ node which will be generated.
    , TreeParserState -> Bool
isInIFrameSrcDoc :: Bool
        -- ^ __HTML:__
        --      @[an iframe srcdoc document]
        --      (https://html.spec.whatwg.org/multipage/iframe-embed-object.html#an-iframe-srcdoc-document)@
        -- 
        -- Test whether the current document is being loaded via an @\<iframe\>@.
    , TreeParserState
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
fragmentContext :: Maybe (ElementParams, [(NodeIndex, ElementParams)])
        -- ^ __HTML:__
        --      @[context]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#concept-frag-parse-context)@
        -- 
        -- The element passed to the [HTML fragment parsing algorithm]
        -- (https://html.spec.whatwg.org/multipage/parsing.html#html-fragment-parsing-algorithm)
        -- to provide its immediate (conceptual) parent.  The first element of
        -- the tuple is a description of the context node itself, while the
        -- second is a list of its ancestors, most recent parent first.
    , TreeParserState -> QuirksMode
quirksMode :: QuirksMode
        -- ^ __DOM:__
        --      @[Document mode]
        --      (https://dom.spec.whatwg.org/#concept-document-mode)@
        -- 
        -- The degree to which the document should emulate weirdness in
        -- historic browsers' rendering.
    , TreeParserState -> Bool
fosteringEnabled :: Bool
        -- ^ __HTML:__
        --      @[foster parenting]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#foster-parent)@
        -- 
        -- Whether the [appropriate place for inserting a node]
        -- (https://html.spec.whatwg.org/multipage/parsing.html#appropriate-place-for-inserting-a-node)
        -- should direct new nodes to be created outside the current @\<table\>@.
    , TreeParserState -> Bool
scriptingEnabled :: Bool
        -- ^ __HTML:__
        --      @[scripting flag]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#scripting-flag)@
        -- 
        -- Whether the document is required to be parsed with JavaScript
        -- enabled or disabled.  Currently a binary choice, but the type may
        -- change in the future if non-deterministic parsing is implemented.
    , TreeParserState -> Bool
framesetOk :: Bool
        -- ^ __HTML:__
        --      @[frameset-ok flag]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#frameset-ok-flag)@
        -- 
        -- Whether a particular class of content, which disallows the
        -- introduction of HTML page inclusion via @\<frameset\>@, has already
        -- been added to the tree.
    , TreeParserState -> Maybe NodeIndex
headElementPointer :: Maybe NodeIndex
        -- ^ __HTML:__
        --      @[head element pointer]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#head-element-pointer)@
        -- 
        -- The unique ID of the document's @\<head\>@ element, if one has been
        -- added to the tree.
    , TreeParserState -> Maybe NodeIndex
formElementPointer :: Maybe NodeIndex
        -- ^ __HTML:__
        --      @[form element pointer]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#form-element-pointer)@
        -- 
        -- The unique ID of the most recent @\<form\>@ element, if one exists.
    }
  deriving ( TreeParserState -> TreeParserState -> Bool
(TreeParserState -> TreeParserState -> Bool)
-> (TreeParserState -> TreeParserState -> Bool)
-> Eq TreeParserState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeParserState -> TreeParserState -> Bool
$c/= :: TreeParserState -> TreeParserState -> Bool
== :: TreeParserState -> TreeParserState -> Bool
$c== :: TreeParserState -> TreeParserState -> Bool
Eq, Int -> TreeParserState -> ShowS
[TreeParserState] -> ShowS
TreeParserState -> String
(Int -> TreeParserState -> ShowS)
-> (TreeParserState -> String)
-> ([TreeParserState] -> ShowS)
-> Show TreeParserState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeParserState] -> ShowS
$cshowList :: [TreeParserState] -> ShowS
show :: TreeParserState -> String
$cshow :: TreeParserState -> String
showsPrec :: Int -> TreeParserState -> ShowS
$cshowsPrec :: Int -> TreeParserState -> ShowS
Show, ReadPrec [TreeParserState]
ReadPrec TreeParserState
Int -> ReadS TreeParserState
ReadS [TreeParserState]
(Int -> ReadS TreeParserState)
-> ReadS [TreeParserState]
-> ReadPrec TreeParserState
-> ReadPrec [TreeParserState]
-> Read TreeParserState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TreeParserState]
$creadListPrec :: ReadPrec [TreeParserState]
readPrec :: ReadPrec TreeParserState
$creadPrec :: ReadPrec TreeParserState
readList :: ReadS [TreeParserState]
$creadList :: ReadS [TreeParserState]
readsPrec :: Int -> ReadS TreeParserState
$creadsPrec :: Int -> ReadS TreeParserState
Read )

-- | The collection of data which results in behaviour according to the
-- "initially" instructions in the HTML tree construction algorithm.
defaultTreeState :: TreeState
defaultTreeState :: TreeState
defaultTreeState = TreeState :: TreeParserState -> TokenizerState -> TreeState
TreeState
    { tokenizerState :: TokenizerState
tokenizerState = TokenizerState
defaultTokenizerState
    , treeParserState :: TreeParserState
treeParserState = TreeParserState :: InsertionMode
-> Maybe InsertionMode
-> [InsertionMode]
-> [(NodeIndex, ElementParams)]
-> [[(NodeIndex, TagParams)]]
-> NodeIndex
-> Bool
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
-> QuirksMode
-> Bool
-> Bool
-> Bool
-> Maybe NodeIndex
-> Maybe NodeIndex
-> TreeParserState
TreeParserState
        { insertionMode :: InsertionMode
insertionMode = InsertionMode
Initial
        , originalInsertionMode :: Maybe InsertionMode
originalInsertionMode = Maybe InsertionMode
forall a. Maybe a
Nothing
        , templateInsertionModes :: [InsertionMode]
templateInsertionModes = []
        , openElements :: [(NodeIndex, ElementParams)]
openElements = []
        , activeFormattingElements :: [[(NodeIndex, TagParams)]]
activeFormattingElements = []
        , elementIndex :: NodeIndex
elementIndex = NodeIndex
0
        , isInIFrameSrcDoc :: Bool
isInIFrameSrcDoc = Bool
False
        , fragmentContext :: Maybe (ElementParams, [(NodeIndex, ElementParams)])
fragmentContext = Maybe (ElementParams, [(NodeIndex, ElementParams)])
forall a. Maybe a
Nothing
        , quirksMode :: QuirksMode
quirksMode = QuirksMode
NoQuirks
        , fosteringEnabled :: Bool
fosteringEnabled = Bool
False
        , scriptingEnabled :: Bool
scriptingEnabled = Bool
False
        , framesetOk :: Bool
framesetOk = Bool
True
        , headElementPointer :: Maybe NodeIndex
headElementPointer = Maybe NodeIndex
forall a. Maybe a
Nothing
        , formElementPointer :: Maybe NodeIndex
formElementPointer = Maybe NodeIndex
forall a. Maybe a
Nothing
        }
    }


-- | The various fixed points in the tree construction algorithm, where the
-- parser may break and re-enter seamlessly.
data InsertionMode
    = Initial
        -- ^ __HTML:__
        --      @[initial]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#the-initial-insertion-mode)@
        -- 
        -- Before the doctype declaration, if one exists.
    | BeforeHtml
        -- ^ __HTML:__
        --      @[before html]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#the-before-html-insertion-mode)@
        -- 
        -- Before the first markup tag in the document.
    | BeforeHead
        -- ^ __HTML:__
        --      @[before head]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#the-before-head-insertion-mode)@
        -- 
        -- Between the root @\<html\>@ tag and the opening @\<head\>@.
    | InHead
        -- ^ __HTML:__
        --      @[in head]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inhead)@
        -- 
        -- Within the @\<head\>@ section, describing document metadata.
    | InHeadNoscript
        -- ^ __HTML:__
        --      @[in head noscript]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inheadnoscript)@
        -- 
        -- Within a @\<noscript\>@ section of the @\<head\>@, describing
        -- alternate document metadata to be used if script support has been
        -- disabled.
    | AfterHead
        -- ^ __HTML:__
        --      @[after head]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#the-after-head-insertion-mode)@
        -- 
        -- Between the closing @\</html\>@ and opening @\<body\>@ markup tags.
    | InBody
        -- ^ __HTML:__
        --      @[in body]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inbody)@
        -- 
        -- Within the @\<body\>@ section, describing the primary, renderable
        -- document content.
    | InText
        -- ^ __HTML:__
        --      @[text]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-incdata)@
        -- 
        -- Raw text which should be inserted into the document tree without
        -- translation to markup tags.  Corresponds to the
        -- "Web.Mangrove.Parse.Tokenize" state 'RCDataState', and as such it is
        -- critical that the 'currentState' and 'prevStartTag' items be set
        -- appropriately to allow the parser to continue to the next
        -- 'InsertionMode'.
    | InTable
        -- ^ __HTML:__
        --      @[in table]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intable)@
        -- 
        -- Within a @\<table\>@ markup section, describing content laid out in
        -- a rectangular grid.
    | InTableText
        -- ^ __HTML:__
        --      @[in table text]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intabletext)@
        -- 
        -- Special processing for content misnested within a @\<table\>@ but
        -- outside any @\<td\>@ or @\<th\>@.
    | InCaption
        -- ^ __HTML:__
        --      @[in caption]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-incaption)@
        -- 
        -- Within a @\<caption\>@ markup section, describing the data presented
        -- by the enclosing @\<table\>@.
    | InColumnGroup
        -- ^ __HTML:__
        --      @[in column group]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-incolgroup)@
        -- 
        -- Within a @\<colgroup\>@ markup section, describing how the vertical
        -- columns in the enclosing @\<table\>@ should be rendered.
    | InTableBody
        -- ^ __HTML:__
        --      @[in table body]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intbody)@
        -- 
        -- Within a @\<tbody\>@ markup section, describing the actual data
        -- presented by the enclosing @\<table\>@.
    | InRow
        -- ^ __HTML:__
        --      @[in row]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intr)@
        -- 
        -- Within a @\<tr\>@ markup section, describing a line of
        -- mutually-associated data presented by the enclosing @\<table\>@.
    | InCell
        -- ^ __HTML:__
        --      @[in cell]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intd)@
        -- 
        -- Within a @\<td\>@ markup section, describing a single point of data
        -- presented by the enclosing @\<table\>@.
    | InSelect
        -- ^ __HTML:__
        --      @[in select]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inselect)@
        -- 
        -- Within a @\<select\>@ markup section, presenting several predefined
        -- options for the user's input.
    | InSelectInTable
        -- ^ __HTML:__
        --      @[in select in table]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inselectintable)@
        -- 
        -- As 'InSelect', while providing extra cleanup logic for misnested
        -- table structure elements.
    | InTemplate
        -- ^ __HTML:__
        --      @[in template]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-intemplate)@
        -- 
        -- Within a @\<template\>@ section, providing a
        -- 'Web.Mangrove.DOM.DocumentFragment' for simpler script-driven
        -- dynamic generation.
    | AfterBody
        -- ^ __HTML:__
        --      @[after body]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-afterbody)@
        -- 
        -- Between the closing @\</body\>@ and @\</html\>@ markup tags.
    | InFrameset
        -- ^ __HTML:__
        --      @[in frameset]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inframeset)@
        -- 
        -- Within the @\<frameset\>@ section, listing several external
        -- documents to display in lieu of local content.
    | AfterFrameset
        -- ^ __HTML:__
        --      @[after frameset]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-afterframeset)@
        -- 
        -- Between the closing @\</frameset\>@ and @\</html\>@ markup tags.
    | AfterAfterBody
        -- ^ __HTML:__
        --      @[after after body]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#the-after-after-body-insertion-mode)@
        -- 
        -- After the final @\</html\>@ markup tag, when the primary content was
        -- described by a @\<body\>@ section.
    | AfterAfterFrameset
        -- ^ __HTML:__
        --      @[after after frameset]
        --      (https://html.spec.whatwg.org/multipage/parsing.html#the-after-after-frameset-insertion-mode)@
        -- 
        -- After the final @\</html\>@ markup tag, when the primary content was
        -- linked via a @\<frameset\>@ section.
  deriving ( InsertionMode -> InsertionMode -> Bool
(InsertionMode -> InsertionMode -> Bool)
-> (InsertionMode -> InsertionMode -> Bool) -> Eq InsertionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertionMode -> InsertionMode -> Bool
$c/= :: InsertionMode -> InsertionMode -> Bool
== :: InsertionMode -> InsertionMode -> Bool
$c== :: InsertionMode -> InsertionMode -> Bool
Eq, Eq InsertionMode
Eq InsertionMode
-> (InsertionMode -> InsertionMode -> Ordering)
-> (InsertionMode -> InsertionMode -> Bool)
-> (InsertionMode -> InsertionMode -> Bool)
-> (InsertionMode -> InsertionMode -> Bool)
-> (InsertionMode -> InsertionMode -> Bool)
-> (InsertionMode -> InsertionMode -> InsertionMode)
-> (InsertionMode -> InsertionMode -> InsertionMode)
-> Ord InsertionMode
InsertionMode -> InsertionMode -> Bool
InsertionMode -> InsertionMode -> Ordering
InsertionMode -> InsertionMode -> InsertionMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InsertionMode -> InsertionMode -> InsertionMode
$cmin :: InsertionMode -> InsertionMode -> InsertionMode
max :: InsertionMode -> InsertionMode -> InsertionMode
$cmax :: InsertionMode -> InsertionMode -> InsertionMode
>= :: InsertionMode -> InsertionMode -> Bool
$c>= :: InsertionMode -> InsertionMode -> Bool
> :: InsertionMode -> InsertionMode -> Bool
$c> :: InsertionMode -> InsertionMode -> Bool
<= :: InsertionMode -> InsertionMode -> Bool
$c<= :: InsertionMode -> InsertionMode -> Bool
< :: InsertionMode -> InsertionMode -> Bool
$c< :: InsertionMode -> InsertionMode -> Bool
compare :: InsertionMode -> InsertionMode -> Ordering
$ccompare :: InsertionMode -> InsertionMode -> Ordering
$cp1Ord :: Eq InsertionMode
Ord, InsertionMode
InsertionMode -> InsertionMode -> Bounded InsertionMode
forall a. a -> a -> Bounded a
maxBound :: InsertionMode
$cmaxBound :: InsertionMode
minBound :: InsertionMode
$cminBound :: InsertionMode
Bounded, Int -> InsertionMode
InsertionMode -> Int
InsertionMode -> [InsertionMode]
InsertionMode -> InsertionMode
InsertionMode -> InsertionMode -> [InsertionMode]
InsertionMode -> InsertionMode -> InsertionMode -> [InsertionMode]
(InsertionMode -> InsertionMode)
-> (InsertionMode -> InsertionMode)
-> (Int -> InsertionMode)
-> (InsertionMode -> Int)
-> (InsertionMode -> [InsertionMode])
-> (InsertionMode -> InsertionMode -> [InsertionMode])
-> (InsertionMode -> InsertionMode -> [InsertionMode])
-> (InsertionMode
    -> InsertionMode -> InsertionMode -> [InsertionMode])
-> Enum InsertionMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InsertionMode -> InsertionMode -> InsertionMode -> [InsertionMode]
$cenumFromThenTo :: InsertionMode -> InsertionMode -> InsertionMode -> [InsertionMode]
enumFromTo :: InsertionMode -> InsertionMode -> [InsertionMode]
$cenumFromTo :: InsertionMode -> InsertionMode -> [InsertionMode]
enumFromThen :: InsertionMode -> InsertionMode -> [InsertionMode]
$cenumFromThen :: InsertionMode -> InsertionMode -> [InsertionMode]
enumFrom :: InsertionMode -> [InsertionMode]
$cenumFrom :: InsertionMode -> [InsertionMode]
fromEnum :: InsertionMode -> Int
$cfromEnum :: InsertionMode -> Int
toEnum :: Int -> InsertionMode
$ctoEnum :: Int -> InsertionMode
pred :: InsertionMode -> InsertionMode
$cpred :: InsertionMode -> InsertionMode
succ :: InsertionMode -> InsertionMode
$csucc :: InsertionMode -> InsertionMode
Enum, Int -> InsertionMode -> ShowS
[InsertionMode] -> ShowS
InsertionMode -> String
(Int -> InsertionMode -> ShowS)
-> (InsertionMode -> String)
-> ([InsertionMode] -> ShowS)
-> Show InsertionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InsertionMode] -> ShowS
$cshowList :: [InsertionMode] -> ShowS
show :: InsertionMode -> String
$cshow :: InsertionMode -> String
showsPrec :: Int -> InsertionMode -> ShowS
$cshowsPrec :: Int -> InsertionMode -> ShowS
Show, ReadPrec [InsertionMode]
ReadPrec InsertionMode
Int -> ReadS InsertionMode
ReadS [InsertionMode]
(Int -> ReadS InsertionMode)
-> ReadS [InsertionMode]
-> ReadPrec InsertionMode
-> ReadPrec [InsertionMode]
-> Read InsertionMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InsertionMode]
$creadListPrec :: ReadPrec [InsertionMode]
readPrec :: ReadPrec InsertionMode
$creadPrec :: ReadPrec InsertionMode
readList :: ReadS [InsertionMode]
$creadList :: ReadS [InsertionMode]
readsPrec :: Int -> ReadS InsertionMode
$creadsPrec :: Int -> ReadS InsertionMode
Read )


-- | "Switch the insertion mode as specified."
switchMode :: InsertionMode -> TreeBuilder ()
switchMode :: InsertionMode -> TreeBuilder ()
switchMode InsertionMode
mode = (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
    { insertionMode :: InsertionMode
insertionMode = InsertionMode
mode
    }

-- | "Switch the insertion mode to the original insertion mode."
resetMode :: TreeBuilder ()
resetMode :: TreeBuilder ()
resetMode = (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 -> case TreeParserState -> Maybe InsertionMode
originalInsertionMode TreeParserState
state of
    Just InsertionMode
mode -> TreeParserState
state
        { insertionMode :: InsertionMode
insertionMode = InsertionMode
mode
        , originalInsertionMode :: Maybe InsertionMode
originalInsertionMode = Maybe InsertionMode
forall a. Maybe a
Nothing
        }
    Maybe InsertionMode
Nothing -> TreeParserState
state


-- | Indicate that the content which is or will be added to the document tree,
-- disallows the later use of @\<frameset\>@ transclusion.
setFramesetNotOk :: TreeBuilder ()
setFramesetNotOk :: TreeBuilder ()
setFramesetNotOk = (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
    { framesetOk :: Bool
framesetOk = Bool
False
    }


-- | "Insert a marker at the end of the list of active formatting elements."
insertFormattingMarker :: TreeBuilder ()
insertFormattingMarker :: TreeBuilder ()
insertFormattingMarker = (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 = [] [(NodeIndex, TagParams)]
-> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a. a -> [a] -> [a]
: TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements TreeParserState
state
    }

-- | "Clear the list of active formatting elements up to the last marker."
clearFormattingElements :: TreeBuilder ()
clearFormattingElements :: TreeBuilder ()
clearFormattingElements = (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 = Int -> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a. Int -> [a] -> [a]
drop Int
1 ([[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]])
-> [[(NodeIndex, TagParams)]] -> [[(NodeIndex, TagParams)]]
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements TreeParserState
state
    }


-- | "Push the specified insertion mode onto the stack of template insertion
-- modes."
pushTemplateMode :: InsertionMode -> TreeBuilder ()
pushTemplateMode :: InsertionMode -> TreeBuilder ()
pushTemplateMode InsertionMode
mode = (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
    { templateInsertionModes :: [InsertionMode]
templateInsertionModes = InsertionMode
mode InsertionMode -> [InsertionMode] -> [InsertionMode]
forall a. a -> [a] -> [a]
: TreeParserState -> [InsertionMode]
templateInsertionModes TreeParserState
state
    }

-- | "Pop the current template insertion mode off the stack of template
-- insertion modes."
popTemplateMode :: TreeBuilder ()
popTemplateMode :: TreeBuilder ()
popTemplateMode = (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
    { templateInsertionModes :: [InsertionMode]
templateInsertionModes = Int -> [InsertionMode] -> [InsertionMode]
forall a. Int -> [a] -> [a]
drop Int
1 ([InsertionMode] -> [InsertionMode])
-> [InsertionMode] -> [InsertionMode]
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [InsertionMode]
templateInsertionModes TreeParserState
state
    }


-- | __HTML:__
--      @[an iframe srcdoc document]
--      (https://html.spec.whatwg.org/multipage/iframe-embed-object.html#an-iframe-srcdoc-document)@
-- 
-- Test whether the current document is being loaded via an @\<iframe\>@.
inIFrameSrcDoc :: TreeBuilder Bool
inIFrameSrcDoc :: TreeBuilder Bool
inIFrameSrcDoc = TreeParserState -> Bool
isInIFrameSrcDoc (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


-- | __HTML:__
--      @[current node]
--      (https://html.spec.whatwg.org/multipage/parsing.html#current-node)@
-- 
-- The most-recently opened markup tag which has not yet been closed.
currentNode :: TreeBuilder (Maybe ElementParams)
currentNode :: TreeBuilder (Maybe ElementParams)
currentNode = ((NodeIndex, ElementParams) -> ElementParams)
-> Maybe (NodeIndex, ElementParams) -> Maybe ElementParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeIndex, ElementParams) -> ElementParams
forall a b. (a, b) -> b
snd (Maybe (NodeIndex, ElementParams) -> Maybe ElementParams)
-> (TreeParserState -> Maybe (NodeIndex, ElementParams))
-> TreeParserState
-> Maybe ElementParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams)
forall a. [a] -> Maybe a
Y.listToMaybe ([(NodeIndex, ElementParams)] -> Maybe (NodeIndex, ElementParams))
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> Maybe (NodeIndex, ElementParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> [(NodeIndex, ElementParams)]
openElements (TreeParserState -> Maybe ElementParams)
-> StateT TreeParserState (Parser [TreeInput]) TreeParserState
-> TreeBuilder (Maybe 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

-- | The unique ID of the element described by 'currentNode'.
currentNodeIndex :: TreeBuilder (Maybe NodeIndex)
currentNodeIndex :: TreeBuilder (Maybe NodeIndex)
currentNodeIndex = ((NodeIndex, ElementParams) -> NodeIndex)
-> Maybe (NodeIndex, ElementParams) -> Maybe NodeIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeIndex, ElementParams) -> NodeIndex
forall a b. (a, b) -> a
fst (Maybe (NodeIndex, ElementParams) -> Maybe NodeIndex)
-> (TreeParserState -> Maybe (NodeIndex, ElementParams))
-> TreeParserState
-> Maybe 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)] -> Maybe (NodeIndex, ElementParams))
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> Maybe (NodeIndex, ElementParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> [(NodeIndex, ElementParams)]
openElements (TreeParserState -> Maybe NodeIndex)
-> StateT TreeParserState (Parser [TreeInput]) TreeParserState
-> TreeBuilder (Maybe 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

-- | __HTML:__
--      @[adjusted current node]
--      (https://html.spec.whatwg.org/multipage/parsing.html#adjusted-current-node)@
-- 
-- The most-recently opened markup tag which has not yet been closed, or the
-- context element if the document is being read as a document fragment and
-- everything else has been closed.
adjustedCurrentNode :: TreeBuilder (Maybe ElementParams)
adjustedCurrentNode :: TreeBuilder (Maybe ElementParams)
adjustedCurrentNode = do
    TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
    if [(NodeIndex, ElementParams)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
&& Maybe (ElementParams, [(NodeIndex, ElementParams)]) -> Bool
forall a. Maybe a -> Bool
Y.isJust (TreeParserState
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
fragmentContext TreeParserState
state)
        then Maybe ElementParams -> TreeBuilder (Maybe ElementParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ElementParams -> TreeBuilder (Maybe ElementParams))
-> (Maybe (ElementParams, [(NodeIndex, ElementParams)])
    -> Maybe ElementParams)
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
-> TreeBuilder (Maybe ElementParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ElementParams, [(NodeIndex, ElementParams)]) -> ElementParams)
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
-> Maybe ElementParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ElementParams, [(NodeIndex, ElementParams)]) -> ElementParams
forall a b. (a, b) -> a
fst (Maybe (ElementParams, [(NodeIndex, ElementParams)])
 -> TreeBuilder (Maybe ElementParams))
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
-> TreeBuilder (Maybe ElementParams)
forall a b. (a -> b) -> a -> b
$ TreeParserState
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
fragmentContext TreeParserState
state
        else TreeBuilder (Maybe ElementParams)
currentNode

-- | "Whether the parser was created as part of the HTML fragment parsing
-- algorithm."
inFragment :: TreeBuilder Bool
inFragment :: TreeBuilder Bool
inFragment = do
    TreeParserState
state <- StateT TreeParserState (Parser [TreeInput]) TreeParserState
forall (m :: * -> *) s. Monad m => StateT s m s
N.S.get
    Bool -> TreeBuilder Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> TreeBuilder Bool)
-> (Maybe (ElementParams, [(NodeIndex, ElementParams)]) -> Bool)
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
-> TreeBuilder Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (ElementParams, [(NodeIndex, ElementParams)]) -> Bool
forall a. Maybe a -> Bool
Y.isJust (Maybe (ElementParams, [(NodeIndex, ElementParams)])
 -> TreeBuilder Bool)
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
-> TreeBuilder Bool
forall a b. (a -> b) -> a -> b
$ TreeParserState
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
fragmentContext TreeParserState
state


-- | Map the given function over all attributes in the token data.
adjustAttributes :: (AttributeName -> AttributeName) -> TagParams -> TagParams
adjustAttributes :: (DoctypeName -> DoctypeName) -> TagParams -> TagParams
adjustAttributes DoctypeName -> DoctypeName
adjust TagParams
d = TagParams
d
    { tagAttributes :: HashMap DoctypeName DoctypeName
tagAttributes = [(DoctypeName, DoctypeName)] -> HashMap DoctypeName DoctypeName
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(DoctypeName, DoctypeName)] -> HashMap DoctypeName DoctypeName)
-> (HashMap DoctypeName DoctypeName
    -> [(DoctypeName, DoctypeName)])
-> HashMap DoctypeName DoctypeName
-> HashMap DoctypeName DoctypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DoctypeName, DoctypeName) -> (DoctypeName, DoctypeName))
-> [(DoctypeName, DoctypeName)] -> [(DoctypeName, DoctypeName)]
forall a b. (a -> b) -> [a] -> [b]
map ((DoctypeName -> DoctypeName)
-> (DoctypeName, DoctypeName) -> (DoctypeName, DoctypeName)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first DoctypeName -> DoctypeName
adjust) ([(DoctypeName, DoctypeName)] -> [(DoctypeName, DoctypeName)])
-> (HashMap DoctypeName DoctypeName
    -> [(DoctypeName, DoctypeName)])
-> HashMap DoctypeName DoctypeName
-> [(DoctypeName, DoctypeName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap DoctypeName DoctypeName -> [(DoctypeName, DoctypeName)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap DoctypeName DoctypeName
 -> HashMap DoctypeName DoctypeName)
-> HashMap DoctypeName DoctypeName
-> HashMap DoctypeName DoctypeName
forall a b. (a -> b) -> a -> b
$ TagParams -> HashMap DoctypeName DoctypeName
tagAttributes TagParams
d
    }

-- | __HTML:__
--      @[adjust MathML attributes]
--      (https://html.spec.whatwg.org/multipage/parsing.html#adjust-mathml-attributes)@
-- 
-- Some attributes on [MathML](https://www.w3.org/TR/MathML/) elements are
-- defined in mixed case; restore that distinction to the case-folded token
-- data.
adjustMathMLAttributes :: TagParams -> TagParams
adjustMathMLAttributes :: TagParams -> TagParams
adjustMathMLAttributes = (DoctypeName -> DoctypeName) -> TagParams -> TagParams
adjustAttributes DoctypeName -> DoctypeName
adjust
  where adjust :: T.Text -> T.Text
        adjust :: DoctypeName -> DoctypeName
adjust DoctypeName
"definitionurl" = DoctypeName
"definitionURL"
        adjust DoctypeName
name = DoctypeName
name

-- | __HTML:__
--      @[adjust SVG attributes]
--      (https://html.spec.whatwg.org/multipage/parsing.html#adjust-svg-attributes)@
-- 
-- Some attributes on [SVG](https://www.w3.org/TR/SVG/) elements are defined in
-- mixed case; restore that distinction to the case-folded token data.
adjustSvgAttributes :: TagParams -> TagParams
adjustSvgAttributes :: TagParams -> TagParams
adjustSvgAttributes = (DoctypeName -> DoctypeName) -> TagParams -> TagParams
adjustAttributes DoctypeName -> DoctypeName
adjust
  where adjust :: T.Text -> T.Text
        adjust :: DoctypeName -> DoctypeName
adjust DoctypeName
"attributename" = DoctypeName
"attributeName"
        adjust DoctypeName
"attributetype" = DoctypeName
"attributeType"
        adjust DoctypeName
"basefrequency" = DoctypeName
"baseFrequency"
        adjust DoctypeName
"baseprofile" = DoctypeName
"baseProfile"
        adjust DoctypeName
"calcmode" = DoctypeName
"calcMode"
        adjust DoctypeName
"clippathunits" = DoctypeName
"clipPathUnits"
        adjust DoctypeName
"diffuseconstant" = DoctypeName
"diffuseConstant"
        adjust DoctypeName
"edgemode" = DoctypeName
"edgeMode"
        adjust DoctypeName
"filterunits" = DoctypeName
"filterUnits"
        adjust DoctypeName
"glyphref" = DoctypeName
"glyphRef"
        adjust DoctypeName
"gradienttransform" = DoctypeName
"gradientTransform"
        adjust DoctypeName
"gradientunits" = DoctypeName
"gradientUnits"
        adjust DoctypeName
"kernelmatrix" = DoctypeName
"kernelMatrix"
        adjust DoctypeName
"kernelunitlength" = DoctypeName
"kernelUnitLength"
        adjust DoctypeName
"keypoints" = DoctypeName
"keyPoints"
        adjust DoctypeName
"keysplines" = DoctypeName
"keySplines"
        adjust DoctypeName
"keytimes" = DoctypeName
"keyTimes"
        adjust DoctypeName
"lengthadjust" = DoctypeName
"lengthAdjust"
        adjust DoctypeName
"limitingconeangle" = DoctypeName
"limitingConeAngle"
        adjust DoctypeName
"markerheight" = DoctypeName
"markerHeight"
        adjust DoctypeName
"markerunits" = DoctypeName
"markerUnits"
        adjust DoctypeName
"markerwidth" = DoctypeName
"markerWidth"
        adjust DoctypeName
"maskcontentunits" = DoctypeName
"maskContentUnits"
        adjust DoctypeName
"maskunits" = DoctypeName
"maskUnits"
        adjust DoctypeName
"numoctaves" = DoctypeName
"numOctaves"
        adjust DoctypeName
"pathlength" = DoctypeName
"pathLength"
        adjust DoctypeName
"patterncontentunits" = DoctypeName
"patternContentUnits"
        adjust DoctypeName
"patterntransform" = DoctypeName
"patternTransform"
        adjust DoctypeName
"patternunits" = DoctypeName
"patternUnits"
        adjust DoctypeName
"pointsatx" = DoctypeName
"pointsAtX"
        adjust DoctypeName
"pointsaty" = DoctypeName
"pointsAtY"
        adjust DoctypeName
"pointsatz" = DoctypeName
"pointsAtZ"
        adjust DoctypeName
"preservealpha" = DoctypeName
"preserveAlpha"
        adjust DoctypeName
"preserveaspectratio" = DoctypeName
"preserveAspectRatio"
        adjust DoctypeName
"primitiveunits" = DoctypeName
"primitiveUnits"
        adjust DoctypeName
"refx" = DoctypeName
"refX"
        adjust DoctypeName
"refy" = DoctypeName
"refY"
        adjust DoctypeName
"repeatcount" = DoctypeName
"repeatCount"
        adjust DoctypeName
"repeatdur" = DoctypeName
"repeatDur"
        adjust DoctypeName
"requiredextensions" = DoctypeName
"requiredExtensions"
        adjust DoctypeName
"requiredfeatures" = DoctypeName
"requiredFeatures"
        adjust DoctypeName
"specularconstant" = DoctypeName
"specularConstant"
        adjust DoctypeName
"specularexponent" = DoctypeName
"specularExponent"
        adjust DoctypeName
"spreadmethod" = DoctypeName
"spreadMethod"
        adjust DoctypeName
"startoffset" = DoctypeName
"startOffset"
        adjust DoctypeName
"stddeviation" = DoctypeName
"stdDeviation"
        adjust DoctypeName
"stitchtiles" = DoctypeName
"stitchTiles"
        adjust DoctypeName
"surfacescale" = DoctypeName
"surfaceScale"
        adjust DoctypeName
"systemlanguage" = DoctypeName
"systemLanguage"
        adjust DoctypeName
"tablevalues" = DoctypeName
"tableValues"
        adjust DoctypeName
"targetx" = DoctypeName
"targetX"
        adjust DoctypeName
"targety" = DoctypeName
"targetY"
        adjust DoctypeName
"textlength" = DoctypeName
"textLength"
        adjust DoctypeName
"viewbox" = DoctypeName
"viewBox"
        adjust DoctypeName
"viewtarget" = DoctypeName
"viewTarget"
        adjust DoctypeName
"xchannelselector" = DoctypeName
"xChannelSelector"
        adjust DoctypeName
"ychannelselector" = DoctypeName
"yChannelSelector"
        adjust DoctypeName
"zoomandpan" = DoctypeName
"zoomAndPan"
        adjust DoctypeName
name = DoctypeName
name


-- | __HTML:__
--      @[adjust foreign attributes]
--      (https://html.spec.whatwg.org/multipage/parsing.html#adjust-foreign-attributes)@
-- 
-- The HTML specification expects most names to not carry XML-style prefixes
-- (e.g. @xlink:role@), and handles most which do anyway without issue.
-- However, that assumption proves disruptive for a few attributes, and those
-- exceptions should therefore be fixed.
-- 
-- Note that this is a very simple algorithm in simply assuming a standard
-- prefix<->namespace assignment, and doesn't perform any scope test.  As
-- perfect representation of the structured data isn't actually the goal, that
-- winds up being enough /in this case/.  Do not expect actual XML to play
-- nicely.
adjustForeignAttributes :: ElementParams -> ElementParams
adjustForeignAttributes :: ElementParams -> ElementParams
adjustForeignAttributes ElementParams
tag = case AttributeMap
-> HashMap (Maybe DoctypeName, DoctypeName) () -> AttributeMap
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
M.intersection AttributeMap
attrs HashMap (Maybe DoctypeName, DoctypeName) ()
foreignNames of
    AttributeMap
foreignAttrs | AttributeMap -> Bool
forall k v. HashMap k v -> Bool
M.null AttributeMap
foreignAttrs -> ElementParams
tag
    AttributeMap
foreignAttrs ->
        let foreignAttrs' :: AttributeMap
foreignAttrs' = [AttributeParams] -> AttributeMap
fromAttrList ([AttributeParams] -> AttributeMap)
-> ([AttributeParams] -> [AttributeParams])
-> [AttributeParams]
-> AttributeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttributeParams -> AttributeParams)
-> [AttributeParams] -> [AttributeParams]
forall a b. (a -> b) -> [a] -> [b]
map AttributeParams -> AttributeParams
adjustForeignAttribute ([AttributeParams] -> AttributeMap)
-> [AttributeParams] -> AttributeMap
forall a b. (a -> b) -> a -> b
$ AttributeMap -> [AttributeParams]
toAttrList AttributeMap
foreignAttrs
        in  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 AttributeMap
foreignAttrs' (AttributeMap -> AttributeMap) -> AttributeMap -> AttributeMap
forall a b. (a -> b) -> a -> b
$ AttributeMap
-> HashMap (Maybe DoctypeName, DoctypeName) () -> AttributeMap
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
M.difference AttributeMap
attrs HashMap (Maybe DoctypeName, DoctypeName) ()
foreignNames
                }
  where attrs :: AttributeMap
attrs = ElementParams -> AttributeMap
elementAttributes ElementParams
tag
        foreignNames :: HashMap (Maybe DoctypeName, DoctypeName) ()
foreignNames = [((Maybe DoctypeName, DoctypeName), ())]
-> HashMap (Maybe DoctypeName, DoctypeName) ()
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList
            [ ((Maybe DoctypeName
forall a. Maybe a
Nothing, DoctypeName
n), ())
            | DoctypeName
n <-
                [ DoctypeName
"xlink:actuate"
                , DoctypeName
"xlink:arcrole"
                , DoctypeName
"xlink:href"
                , DoctypeName
"xlink:role"
                , DoctypeName
"xlink:show"
                , DoctypeName
"xlink:title"
                , DoctypeName
"xlink:type"
                , DoctypeName
"xml:lang"
                , DoctypeName
"xml:space"
                , DoctypeName
"xmlns"
                , DoctypeName
"xmlns:xlink"
                ]
            ]

-- | Compare the name of a single attribute to the known exceptions described
-- in 'adjustForeignAttributes', and update the values if it matches.
adjustForeignAttribute :: AttributeParams -> AttributeParams
adjustForeignAttribute :: AttributeParams -> AttributeParams
adjustForeignAttribute AttributeParams
attr = case DoctypeName -> DoctypeName -> [DoctypeName]
T.splitOn DoctypeName
":" (DoctypeName -> [DoctypeName]) -> DoctypeName -> [DoctypeName]
forall a b. (a -> b) -> a -> b
$ AttributeParams -> DoctypeName
attrName AttributeParams
attr of
    [p :: DoctypeName
p@DoctypeName
"xlink", n :: DoctypeName
n@DoctypeName
"actuate"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xlinkNamespace
    [p :: DoctypeName
p@DoctypeName
"xlink", n :: DoctypeName
n@DoctypeName
"arcrole"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xlinkNamespace
    [p :: DoctypeName
p@DoctypeName
"xlink", n :: DoctypeName
n@DoctypeName
"href"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xlinkNamespace
    [p :: DoctypeName
p@DoctypeName
"xlink", n :: DoctypeName
n@DoctypeName
"role"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xlinkNamespace
    [p :: DoctypeName
p@DoctypeName
"xlink", n :: DoctypeName
n@DoctypeName
"show"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xlinkNamespace
    [p :: DoctypeName
p@DoctypeName
"xlink", n :: DoctypeName
n@DoctypeName
"title"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xlinkNamespace
    [p :: DoctypeName
p@DoctypeName
"xlink", n :: DoctypeName
n@DoctypeName
"type"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xlinkNamespace
    [p :: DoctypeName
p@DoctypeName
"xml", n :: DoctypeName
n@DoctypeName
"lang"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xmlNamespace
    [p :: DoctypeName
p@DoctypeName
"xml", n :: DoctypeName
n@DoctypeName
"space"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xmlNamespace
    [n :: DoctypeName
n@DoctypeName
"xmlns"] -> AttributeParams
attr
        { attrPrefix :: Maybe DoctypeName
attrPrefix = Maybe DoctypeName
forall a. Maybe a
Nothing
        , attrName :: DoctypeName
attrName = DoctypeName
n
        , attrNamespace :: Maybe DoctypeName
attrNamespace = DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
xmlnsNamespace
        }
    [p :: DoctypeName
p@DoctypeName
"xmlns", n :: DoctypeName
n@DoctypeName
"xlink"] -> DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
xmlnsNamespace
    [DoctypeName]
_ -> AttributeParams
attr
  where updateAttr :: DoctypeName -> DoctypeName -> DoctypeName -> AttributeParams
updateAttr DoctypeName
p DoctypeName
n DoctypeName
ns = AttributeParams
attr
            { attrPrefix :: Maybe DoctypeName
attrPrefix = DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
p
            , attrName :: DoctypeName
attrName = DoctypeName
n
            , attrNamespace :: Maybe DoctypeName
attrNamespace = DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
ns
            }


-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token indicates the end of the stream.
isEOF :: TreeInput -> Bool
isEOF :: TreeInput -> Bool
isEOF TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    -- 'EndOfStream' only works as an explicit EOF because of the manipulations in
    -- the parser runner ('Web.Mangrove.Parse.Tree.repackStream').
    Token
EndOfStream -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is a whitespace 'Character' in the ASCII range.
isWhitespace :: TreeInput -> Bool
isWhitespace :: TreeInput -> Bool
isWhitespace TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    Character Char
c | Char -> Bool
isAsciiWhitespace Char
c -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is any 'Character'.
isCharacter :: TreeInput -> Bool
isCharacter :: TreeInput -> Bool
isCharacter TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    Character Char
_ -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is specifically a @U+0000@ null 'Character'.
isNull :: TreeInput -> Bool
isNull :: TreeInput -> Bool
isNull TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    Character Char
'\NUL' -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is any 'Comment'.
isComment :: TreeInput -> Bool
isComment :: TreeInput -> Bool
isComment TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    Comment DoctypeName
_ -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is any 'Doctype'.
isDoctype :: TreeInput -> Bool
isDoctype :: TreeInput -> Bool
isDoctype TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    Doctype DoctypeParams
_ -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is any 'StartTag'.  If the behaviour further requires the
-- 'StartTag' to have a specific name, use 'isStartTag' instead.
isAnyStartTag :: TreeInput -> Bool
isAnyStartTag :: TreeInput -> Bool
isAnyStartTag TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    StartTag TagParams
_ -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is a 'StartTag' with any of the given names; the list should
-- be entirely in lower-case.  If the exact name doesn't actually matter, use
-- 'isAnyStartTag' instead.
isStartTag :: [String] -> TreeInput -> Bool
isStartTag :: [String] -> TreeInput -> Bool
isStartTag [String]
names TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    StartTag TagParams
d | String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (DoctypeName -> String
T.unpack (DoctypeName -> String) -> DoctypeName -> String
forall a b. (a -> b) -> a -> b
$ TagParams -> DoctypeName
tagName TagParams
d) [String]
names -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is any 'EndTag'.  If the behaviour further requires the
-- 'EndTag' to have a specific name, use 'isEndTag' instead.
isAnyEndTag :: TreeInput -> Bool
isAnyEndTag :: TreeInput -> Bool
isAnyEndTag TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    EndTag TagParams
_ -> Bool
True
    Token
_ -> Bool
False

-- | 'Web.Mangrove.Parse.Common.Parser.switch' case guard testing whether the
-- wrapped token is a 'EndTag' with any of the given names; the list should be
-- entirely in lower-case.  If the exact name doesn't actually matter, use
-- 'isAnyEndTag' instead.
isEndTag :: [String] -> TreeInput -> Bool
isEndTag :: [String] -> TreeInput -> Bool
isEndTag [String]
names TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
    EndTag TagParams
d | String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (DoctypeName -> String
T.unpack (DoctypeName -> String) -> DoctypeName -> String
forall a b. (a -> b) -> a -> b
$ TagParams -> DoctypeName
tagName TagParams
d) [String]
names -> Bool
True
    Token
_ -> Bool
False


-- | Check if the described node has the given name, and is in the HTML
-- namespace.
nodeIsElement :: T.Text -> ElementParams -> Bool
nodeIsElement :: DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
name ElementParams
node = ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
node Maybe DoctypeName -> Maybe DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
htmlNamespace Bool -> Bool -> Bool
&& ElementParams -> DoctypeName
elementName ElementParams
node DoctypeName -> DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DoctypeName
name

-- | Check if the described node is one of the many which have specific behaviour
-- governing their addition to the document tree.  See 'specialElements' for
-- the nodes themselves.
nodeIsSpecial :: ElementParams -> Bool
nodeIsSpecial :: ElementParams -> Bool
nodeIsSpecial ElementParams
node = case ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
node of
    Just DoctypeName
ns -> (DoctypeName, DoctypeName) -> [(DoctypeName, DoctypeName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (DoctypeName
ns, ElementParams -> DoctypeName
elementName ElementParams
node) [(DoctypeName, DoctypeName)]
specialElements
    Maybe DoctypeName
Nothing -> Bool
False


-- | Check whether any of the given tags, in the HTML namespace, are in the
-- stack of open elements.
hasOpenElement :: [ElementName] -> TreeBuilder Bool
hasOpenElement :: [DoctypeName] -> TreeBuilder Bool
hasOpenElement [DoctypeName]
names = (ElementParams -> Bool) -> [ElementParams] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ElementParams -> Bool
isElement ([ElementParams] -> Bool)
-> (TreeParserState -> [ElementParams]) -> TreeParserState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElementParams -> Bool) -> [ElementParams] -> [ElementParams]
forall a. (a -> Bool) -> [a] -> [a]
filter ElementParams -> Bool
isHtml ([ElementParams] -> [ElementParams])
-> (TreeParserState -> [ElementParams])
-> TreeParserState
-> [ElementParams]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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])
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> [ElementParams]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> [(NodeIndex, ElementParams)]
openElements (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
  where isElement :: ElementParams -> Bool
isElement ElementParams
tag = DoctypeName -> [DoctypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (ElementParams -> DoctypeName
elementName ElementParams
tag) [DoctypeName]
names
        isHtml :: ElementParams -> Bool
isHtml ElementParams
tag = ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
tag Maybe DoctypeName -> Maybe DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
htmlNamespace

-- | Check if there are any tags on the stack of open elements, which are not
-- one of the given list, or are in a non-HTML namespace.
hasOpenElementExcept :: [ElementName] -> TreeBuilder Bool
hasOpenElementExcept :: [DoctypeName] -> TreeBuilder Bool
hasOpenElementExcept [DoctypeName]
names = (ElementParams -> Bool) -> [ElementParams] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ElementParams -> Bool
isNotElement ([ElementParams] -> Bool)
-> (TreeParserState -> [ElementParams]) -> TreeParserState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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])
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> [ElementParams]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> [(NodeIndex, ElementParams)]
openElements (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
  where isNotElement :: ElementParams -> Bool
isNotElement ElementParams
tag = ElementParams -> Bool
isNotHtml ElementParams
tag Bool -> Bool -> Bool
|| DoctypeName -> [DoctypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem (ElementParams -> DoctypeName
elementName ElementParams
tag) [DoctypeName]
names
        isNotHtml :: ElementParams -> Bool
isNotHtml ElementParams
tag = ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
tag Maybe DoctypeName -> Maybe DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
/= DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
htmlNamespace


-- | __HTML:__
--      the elements listed for @[has a particular element in scope]
--      (https://html.spec.whatwg.org/multipage/parsing.html#has-an-element-in-scope)@
-- 
-- Several elements provide a breakpoint which limits how far up the tree some
-- searches for open tags will propagate; this list defines those.  See
-- 'hasInScope' for a test using this list.
scopeElements :: [(Namespace, ElementName)]
scopeElements :: [(DoctypeName, DoctypeName)]
scopeElements =
    [ (DoctypeName
htmlNamespace, DoctypeName
n)
    | DoctypeName
n <-
        [ DoctypeName
"applet"
        , DoctypeName
"caption"
        , DoctypeName
"html"
        , DoctypeName
"table"
        , DoctypeName
"td"
        , DoctypeName
"th"
        , DoctypeName
"marquee"
        , DoctypeName
"object"
        , DoctypeName
"template"
        ]
    ] [(DoctypeName, DoctypeName)]
-> [(DoctypeName, DoctypeName)] -> [(DoctypeName, DoctypeName)]
forall a. [a] -> [a] -> [a]
++
    [ (DoctypeName
mathMLNamespace, DoctypeName
n)
    | DoctypeName
n <-
        [ DoctypeName
"mi"
        , DoctypeName
"mo"
        , DoctypeName
"mn"
        , DoctypeName
"ms"
        , DoctypeName
"mtext"
        , DoctypeName
"annotation-xml"
        ]
    ] [(DoctypeName, DoctypeName)]
-> [(DoctypeName, DoctypeName)] -> [(DoctypeName, DoctypeName)]
forall a. [a] -> [a] -> [a]
++
    [ (DoctypeName
svgNamespace, DoctypeName
n)
    | DoctypeName
n <-
        [ DoctypeName
"foreignObject"
        , DoctypeName
"desc"
        , DoctypeName
"title"
        ]
    ]

-- | __HTML:__
--      @[special category]
--      (https://html.spec.whatwg.org/multipage/parsing.html#special)@
-- 
-- The specification describes specific behaviour for many tags, and refers
-- back to those same tags at a few points in the parse algorithm.  This then
-- collects everything in that category; see 'nodeIsSpecial' to test against
-- it.
specialElements :: [(Namespace, ElementName)]
specialElements :: [(DoctypeName, DoctypeName)]
specialElements =
    [ (DoctypeName
htmlNamespace, DoctypeName
n)
    | DoctypeName
n <-
        [ DoctypeName
"address"
        , DoctypeName
"area"
        , DoctypeName
"article"
        , DoctypeName
"aside"
        , DoctypeName
"base"
        , DoctypeName
"basefont"
        , DoctypeName
"bgsound"
        , DoctypeName
"blockquote"
        , DoctypeName
"body"
        , DoctypeName
"br"
        , DoctypeName
"button"
        , DoctypeName
"center"
        , DoctypeName
"col"
        , DoctypeName
"colgroup"
        , DoctypeName
"dd"
        , DoctypeName
"details"
        , DoctypeName
"dir"
        , DoctypeName
"div"
        , DoctypeName
"dl"
        , DoctypeName
"dt"
        , DoctypeName
"embed"
        , DoctypeName
"fieldset"
        , DoctypeName
"figcaption"
        , DoctypeName
"figure"
        , DoctypeName
"footer"
        , DoctypeName
"form"
        , DoctypeName
"frame"
        , DoctypeName
"frameset"
        , DoctypeName
"h1"
        , DoctypeName
"h2"
        , DoctypeName
"h3"
        , DoctypeName
"h4"
        , DoctypeName
"h5"
        , DoctypeName
"h6"
        , DoctypeName
"head"
        , DoctypeName
"header"
        , DoctypeName
"hgroup"
        , DoctypeName
"hr"
        , DoctypeName
"iframe"
        , DoctypeName
"img"
        , DoctypeName
"input"
        , DoctypeName
"keygen"
        , DoctypeName
"li"
        , DoctypeName
"link"
        , DoctypeName
"listing"
        , DoctypeName
"main"
        , DoctypeName
"menu"
        , DoctypeName
"meta"
        , DoctypeName
"nav"
        , DoctypeName
"noembed"
        , DoctypeName
"noframes"
        , DoctypeName
"noscript"
        , DoctypeName
"ol"
        , DoctypeName
"p"
        , DoctypeName
"param"
        , DoctypeName
"plaintext"
        , DoctypeName
"pre"
        , DoctypeName
"script"
        , DoctypeName
"section"
        , DoctypeName
"select"
        , DoctypeName
"style"
        , DoctypeName
"source"
        , DoctypeName
"summary"
        , DoctypeName
"tbody"
        , DoctypeName
"textarea"
        , DoctypeName
"tfoot"
        , DoctypeName
"thead"
        , DoctypeName
"title"
        , DoctypeName
"tr"
        , DoctypeName
"track"
        , DoctypeName
"ul"
        , DoctypeName
"wbr"
        , DoctypeName
"xmp"
        ]
    ] [(DoctypeName, DoctypeName)]
-> [(DoctypeName, DoctypeName)] -> [(DoctypeName, DoctypeName)]
forall a. [a] -> [a] -> [a]
++ [(DoctypeName, DoctypeName)]
scopeElements


-- | __HTML:__
--      @[has a particular element in a specific scope]
--      (https://html.spec.whatwg.org/multipage/parsing.html#has-an-element-in-the-specific-scope)@
-- 
-- Check if a tag with any of the given names, in the HTML namespace, is in the
-- stack of open elements more recently than the closest boundary element.  See
-- 'scopeElements' for the typical list, but generally 'hasInScope',
-- 'hasInButtonScope', 'hasInListItemScope', 'hasInSelectScope', or
-- 'hasInTableScope' should be used instead.
inScope :: [(Namespace, ElementName)] -> [T.Text] -> TreeBuilder Bool
inScope :: [(DoctypeName, DoctypeName)] -> [DoctypeName] -> TreeBuilder Bool
inScope [(DoctypeName, DoctypeName)]
bound [DoctypeName]
names = [(NodeIndex, ElementParams)] -> Bool
forall a. [(a, ElementParams)] -> Bool
recurse ([(NodeIndex, ElementParams)] -> Bool)
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> [(NodeIndex, ElementParams)]
openElements (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
  where recurse :: [(a, ElementParams)] -> Bool
recurse [] = Bool
False
        recurse ((a
_, ElementParams
e):[(a, ElementParams)]
es)
            | DoctypeName -> [DoctypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (ElementParams -> DoctypeName
elementName ElementParams
e) [DoctypeName]
names = Bool
True
            | (Maybe DoctypeName, DoctypeName)
-> [(Maybe DoctypeName, DoctypeName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
e, ElementParams -> DoctypeName
elementName ElementParams
e) (((DoctypeName, DoctypeName) -> (Maybe DoctypeName, DoctypeName))
-> [(DoctypeName, DoctypeName)]
-> [(Maybe DoctypeName, DoctypeName)]
forall a b. (a -> b) -> [a] -> [b]
map ((DoctypeName -> Maybe DoctypeName)
-> (DoctypeName, DoctypeName) -> (Maybe DoctypeName, DoctypeName)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just) [(DoctypeName, DoctypeName)]
bound) = Bool
False
            | Bool
otherwise = [(a, ElementParams)] -> Bool
recurse [(a, ElementParams)]
es

-- | Given a node's unique ID, check if it is in the stack of open elements,
-- more recently than the closest boundary node from 'scopeElements'.  See
-- 'hasInScope' if any node with a given name will suffice.
hasIndexInScope :: NodeIndex -> TreeBuilder Bool
hasIndexInScope :: NodeIndex -> TreeBuilder Bool
hasIndexInScope NodeIndex
index = ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((NodeIndex -> NodeIndex -> Bool
forall a. Eq a => a -> a -> Bool
== NodeIndex
index) (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)] -> Bool)
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NodeIndex, ElementParams) -> Bool)
-> [(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool)
-> ((NodeIndex, ElementParams) -> Bool)
-> (NodeIndex, ElementParams)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeIndex, ElementParams) -> Bool
forall a. (a, ElementParams) -> Bool
isScopeElement) ([(NodeIndex, ElementParams)] -> [(NodeIndex, ElementParams)])
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> [(NodeIndex, ElementParams)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    TreeParserState -> [(NodeIndex, ElementParams)]
openElements (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
  where isScopeElement :: (a, ElementParams) -> Bool
isScopeElement (a
_, ElementParams
e) = case ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
e of
            Just DoctypeName
ns -> (DoctypeName, DoctypeName) -> [(DoctypeName, DoctypeName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (DoctypeName
ns, ElementParams -> DoctypeName
elementName ElementParams
e) [(DoctypeName, DoctypeName)]
scopeElements
            Maybe DoctypeName
Nothing -> Bool
False

-- | __HTML:__
--      @[has a particular element in scope]
--      (https://html.spec.whatwg.org/multipage/parsing.html#has-an-element-in-scope)@
-- 
-- Check if a tag with any of the given names, in the HTML namespace, is in the
-- stack of open elements more recently than the closest boundary node from
-- 'scopeElements'.  See 'hasIndexInScope' if a specific existing element is
-- required.
hasInScope :: [T.Text] -> TreeBuilder Bool
hasInScope :: [DoctypeName] -> TreeBuilder Bool
hasInScope = [(DoctypeName, DoctypeName)] -> [DoctypeName] -> TreeBuilder Bool
inScope [(DoctypeName, DoctypeName)]
scopeElements

-- | __HTML:__
--      @[has a particular element in list item scope]
--      (https://html.spec.whatwg.org/multipage/parsing.html#has-an-element-in-list-item-scope)@
-- 
-- Check if a tag with any of the given names, in the HTML namespace, is in the
-- stack of open elements more recently than the closest boundary node of
-- either @\<ol\>@, @\<ul\>@, or any from 'scopeElements'.
hasInListItemScope :: [T.Text] -> TreeBuilder Bool
hasInListItemScope :: [DoctypeName] -> TreeBuilder Bool
hasInListItemScope = [(DoctypeName, DoctypeName)] -> [DoctypeName] -> TreeBuilder Bool
inScope ([(DoctypeName, DoctypeName)] -> [DoctypeName] -> TreeBuilder Bool)
-> [(DoctypeName, DoctypeName)]
-> [DoctypeName]
-> TreeBuilder Bool
forall a b. (a -> b) -> a -> b
$
    [ (DoctypeName
htmlNamespace, DoctypeName
n)
    | DoctypeName
n <-
        [ DoctypeName
"ol"
        , DoctypeName
"ul"
        ]
    ] [(DoctypeName, DoctypeName)]
-> [(DoctypeName, DoctypeName)] -> [(DoctypeName, DoctypeName)]
forall a. [a] -> [a] -> [a]
++ [(DoctypeName, DoctypeName)]
scopeElements

-- | __HTML:__
--      @[has a particular element in button scope]
--      (https://html.spec.whatwg.org/multipage/parsing.html#has-an-element-in-button-scope)@
-- 
-- Check if a tag with any of the given names, in the HTML namespace, is in the
-- stack of open elements more recently than the closest boundary node of
-- either @\<button\>@ or any from 'scopeElements'.
hasInButtonScope :: [T.Text] -> TreeBuilder Bool
hasInButtonScope :: [DoctypeName] -> TreeBuilder Bool
hasInButtonScope = [(DoctypeName, DoctypeName)] -> [DoctypeName] -> TreeBuilder Bool
inScope ([(DoctypeName, DoctypeName)] -> [DoctypeName] -> TreeBuilder Bool)
-> [(DoctypeName, DoctypeName)]
-> [DoctypeName]
-> TreeBuilder Bool
forall a b. (a -> b) -> a -> b
$ (DoctypeName
htmlNamespace, DoctypeName
"button") (DoctypeName, DoctypeName)
-> [(DoctypeName, DoctypeName)] -> [(DoctypeName, DoctypeName)]
forall a. a -> [a] -> [a]
: [(DoctypeName, DoctypeName)]
scopeElements

-- | __HTML:__
--      @[has a particular element in table scope]
--      (https://html.spec.whatwg.org/multipage/parsing.html#has-an-element-in-table-scope)@
-- 
-- Check if a tag with any of the given names, in the HTML namespace, is in the
-- stack of open elements more recently than the closest boundary node of
-- either @\<table\>@ or a top-level element.
hasInTableScope :: [T.Text] -> TreeBuilder Bool
hasInTableScope :: [DoctypeName] -> TreeBuilder Bool
hasInTableScope = [(DoctypeName, DoctypeName)] -> [DoctypeName] -> TreeBuilder Bool
inScope
    [ (DoctypeName
htmlNamespace, DoctypeName
n)
    | DoctypeName
n <-
        [ DoctypeName
"html"
        , DoctypeName
"table"
        , DoctypeName
"template"
        ]
    ]

-- | __HTML:__
--      @[has a particular element in select scope]
--      (https://html.spec.whatwg.org/multipage/parsing.html#has-an-element-in-select-scope)@
-- 
-- Check if a tag with any of the given names, in the HTML namespace, is in the
-- stack of open elements more recently than /any/ node except an
-- @\<optgroup\>@ or @\<option\>@ element.
hasInSelectScope :: [T.Text] -> TreeBuilder Bool
hasInSelectScope :: [DoctypeName] -> TreeBuilder Bool
hasInSelectScope [DoctypeName]
names = [(NodeIndex, ElementParams)] -> Bool
forall a. [(a, ElementParams)] -> Bool
recurse ([(NodeIndex, ElementParams)] -> Bool)
-> (TreeParserState -> [(NodeIndex, ElementParams)])
-> TreeParserState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeParserState -> [(NodeIndex, ElementParams)]
openElements (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
  where recurse :: [(a, ElementParams)] -> Bool
recurse [] = Bool
False
        recurse ((a
_, ElementParams
e):[(a, ElementParams)]
es)
            | DoctypeName -> [DoctypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (ElementParams -> DoctypeName
elementName ElementParams
e) [DoctypeName]
names = Bool
True
            | DoctypeName -> [DoctypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (ElementParams -> DoctypeName
elementName ElementParams
e) [DoctypeName
"optgroup", DoctypeName
"option"]
                Bool -> Bool -> Bool
&& ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
e Maybe DoctypeName -> Maybe DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
htmlNamespace = [(a, ElementParams)] -> Bool
recurse [(a, ElementParams)]
es
            | Bool
otherwise = Bool
False


-- | __HTML:__
--      @[reset the insertion mode appropriately]
--      (https://html.spec.whatwg.org/multipage/parsing.html#reset-the-insertion-mode-appropriately)@
-- 
-- Guess what part of the state machine should be active, according to the
-- stack of open elements.  See 'resetInsertionMode'' for use outside a parser
-- monad.
resetInsertionMode :: TreeBuilder ()
resetInsertionMode :: TreeBuilder ()
resetInsertionMode = (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify TreeParserState -> TreeParserState
resetInsertionMode'

-- | __HTML:__
--      @[reset the insertion mode appropriately]
--      (https://html.spec.whatwg.org/multipage/parsing.html#reset-the-insertion-mode-appropriately)@
-- 
-- Guess what part of the state machine should be active, according to the
-- stack of open elements.  See 'resetInsertionMode' if the calculation is
-- being made as part of the tree construction parsing algorithm.
resetInsertionMode' :: TreeParserState -> TreeParserState
resetInsertionMode' :: TreeParserState -> TreeParserState
resetInsertionMode' TreeParserState
state = [(NodeIndex, ElementParams)] -> TreeParserState
forall a. [(a, ElementParams)] -> TreeParserState
resetInsertionMode'' ([(NodeIndex, ElementParams)] -> TreeParserState)
-> [(NodeIndex, ElementParams)] -> TreeParserState
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [(NodeIndex, ElementParams)]
openElements TreeParserState
state
  where resetInsertionMode'' :: [(a, ElementParams)] -> TreeParserState
resetInsertionMode'' [] = InsertionMode -> TreeParserState
switchMode' InsertionMode
InBody
        resetInsertionMode'' ((a
_, ElementParams
e):[(a, ElementParams)]
es)
            | Bool
isLast Bool -> Bool -> Bool
&& DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"select" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InSelect
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"select" ElementParams
e' = [(a, ElementParams)] -> TreeParserState
forall a. [(a, ElementParams)] -> TreeParserState
loopSelect [(a, ElementParams)]
es
            | Bool -> Bool
not Bool
isLast Bool -> Bool -> Bool
&& DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"td" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InCell
            | Bool -> Bool
not Bool
isLast Bool -> Bool -> Bool
&& DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"th" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InCell
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"tr" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InRow
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"tbody" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InTableBody
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"thead" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InTableBody
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"tfoot" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InTableBody
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"caption" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InCaption
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"colgroup" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InColumnGroup
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"table" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InTable
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"template" ElementParams
e' = TreeParserState
-> (InsertionMode -> TreeParserState)
-> Maybe InsertionMode
-> TreeParserState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TreeParserState
state InsertionMode -> TreeParserState
switchMode' (Maybe InsertionMode -> TreeParserState)
-> ([InsertionMode] -> Maybe InsertionMode)
-> [InsertionMode]
-> TreeParserState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InsertionMode] -> Maybe InsertionMode
forall a. [a] -> Maybe a
Y.listToMaybe ([InsertionMode] -> TreeParserState)
-> [InsertionMode] -> TreeParserState
forall a b. (a -> b) -> a -> b
$ TreeParserState -> [InsertionMode]
templateInsertionModes TreeParserState
state
            | Bool -> Bool
not Bool
isLast Bool -> Bool -> Bool
&& DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"head" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InHead
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"body" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InBody
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"frameset" ElementParams
e' = InsertionMode -> TreeParserState
switchMode' InsertionMode
InFrameset
            | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"html" ElementParams
e' =
                InsertionMode -> TreeParserState
switchMode' (InsertionMode -> TreeParserState)
-> InsertionMode -> TreeParserState
forall a b. (a -> b) -> a -> b
$ if Maybe NodeIndex -> Bool
forall a. Maybe a -> Bool
Y.isNothing (Maybe NodeIndex -> Bool) -> Maybe NodeIndex -> Bool
forall a b. (a -> b) -> a -> b
$ TreeParserState -> Maybe NodeIndex
headElementPointer TreeParserState
state
                    then InsertionMode
BeforeHead
                    else InsertionMode
AfterHead
            | Bool
isLast = InsertionMode -> TreeParserState
switchMode' InsertionMode
InBody
            | Bool
otherwise = [(a, ElementParams)] -> TreeParserState
resetInsertionMode'' [(a, ElementParams)]
es
          where isLast :: Bool
isLast = [(a, ElementParams)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, ElementParams)]
es
                e' :: ElementParams
e' = case TreeParserState
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
fragmentContext TreeParserState
state of
                    Maybe (ElementParams, [(NodeIndex, ElementParams)])
Nothing -> ElementParams
e
                    Just (ElementParams, [(NodeIndex, ElementParams)])
context -> (ElementParams, [(NodeIndex, ElementParams)]) -> ElementParams
forall a b. (a, b) -> a
fst (ElementParams, [(NodeIndex, ElementParams)])
context
                loopSelect :: [(a, ElementParams)] -> TreeParserState
loopSelect [] = InsertionMode -> TreeParserState
switchMode' InsertionMode
InSelect
                loopSelect [(a, ElementParams)
_] = InsertionMode -> TreeParserState
switchMode' InsertionMode
InSelect
                loopSelect ((a
_, ElementParams
n):[(a, ElementParams)]
ns)
                    | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"template" ElementParams
n = InsertionMode -> TreeParserState
switchMode' InsertionMode
InSelect
                    | DoctypeName -> ElementParams -> Bool
nodeIsElement DoctypeName
"table" ElementParams
n = InsertionMode -> TreeParserState
switchMode' InsertionMode
InSelectInTable
                    | Bool
otherwise = [(a, ElementParams)] -> TreeParserState
loopSelect [(a, ElementParams)]
ns
        switchMode' :: InsertionMode -> TreeParserState
switchMode' InsertionMode
mode = TreeParserState
state
            { insertionMode :: InsertionMode
insertionMode = InsertionMode
mode
            }


-- | __HTML:__
--      @[MathML text integration point]
--      (https://html.spec.whatwg.org/multipage/parsing.html#mathml-text-integration-point)@
-- 
-- Whether the markup tag introduces a section of less-structured text content
-- embedded within a MathML object.
atMathMLIntegration :: ElementParams -> Bool
atMathMLIntegration :: ElementParams -> Bool
atMathMLIntegration ElementParams
current =
    ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
current Maybe DoctypeName -> Maybe DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
mathMLNamespace
    Bool -> Bool -> Bool
&& DoctypeName -> [DoctypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (ElementParams -> DoctypeName
elementName ElementParams
current) [DoctypeName
"mi", DoctypeName
"mo", DoctypeName
"mn", DoctypeName
"ms", DoctypeName
"mtext"]

-- | Whether the markup tag is specifically an @\<annotation-xml\>@ tag within
-- the MathML namespace.
isMathMLAnnotationXml :: ElementParams -> Bool
isMathMLAnnotationXml :: ElementParams -> Bool
isMathMLAnnotationXml ElementParams
current
    | ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
current Maybe DoctypeName -> Maybe DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
mathMLNamespace
        Bool -> Bool -> Bool
&& ElementParams -> DoctypeName
elementName ElementParams
current DoctypeName -> DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DoctypeName
"annotation-xml" = Bool
True
    | Bool
otherwise = Bool
False

-- | __HTML:__
--      @[HTML integration point]
--      (https://html.spec.whatwg.org/multipage/parsing.html#html-integration-point)@
-- 
-- Whether the markup tag introduces a section of HTML content embedded within
-- a MathML or SVG object.
atHtmlIntegration :: ElementParams -> Bool
atHtmlIntegration :: ElementParams -> Bool
atHtmlIntegration ElementParams
current
    | ElementParams -> Bool
isMathMLAnnotationXml ElementParams
current
        Bool -> Bool -> Bool
&& Maybe (Maybe DoctypeName, DoctypeName) -> Bool
forall a. Maybe (a, DoctypeName) -> Bool
isIntegrationAttribute ((Maybe DoctypeName, DoctypeName)
-> AttributeMap -> Maybe (Maybe DoctypeName, DoctypeName)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (Maybe DoctypeName
forall a. Maybe a
Nothing, DoctypeName
"encoding") (AttributeMap -> Maybe (Maybe DoctypeName, DoctypeName))
-> AttributeMap -> Maybe (Maybe DoctypeName, DoctypeName)
forall a b. (a -> b) -> a -> b
$ ElementParams -> AttributeMap
elementAttributes ElementParams
current) = Bool
True
    | ElementParams -> Maybe DoctypeName
elementNamespace ElementParams
current Maybe DoctypeName -> Maybe DoctypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DoctypeName -> Maybe DoctypeName
forall a. a -> Maybe a
Just DoctypeName
svgNamespace
        Bool -> Bool -> Bool
&& DoctypeName -> [DoctypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (ElementParams -> DoctypeName
elementName ElementParams
current) [DoctypeName
"foreignObject", DoctypeName
"desc", DoctypeName
"title"] = Bool
True
    | Bool
otherwise = Bool
False
  where isIntegrationAttribute :: Maybe (a, DoctypeName) -> Bool
isIntegrationAttribute (Just (a
_, DoctypeName
value)) = case (Char -> Char) -> DoctypeName -> DoctypeName
T.map Char -> Char
toAsciiLower DoctypeName
value of
            DoctypeName
"text/html" -> Bool
True
            DoctypeName
"application/xhtml+xml" -> Bool
True
            DoctypeName
_ -> Bool
False
        isIntegrationAttribute Maybe (a, DoctypeName)
_ = Bool
False