{-# LANGUAGE OverloadedStrings #-}
module Web.Mangrove.Parse.Tree.Common
(
TreeBuilder
, TreeState ( .. )
, TreeParserState ( .. )
, defaultTreeState
, NodeIndex
, InsertionMode ( .. )
, nodeIsElement
, nodeIsSpecial
, ElementParams ( .. )
, emptyElementParams
, packNodeData
, scopeElements
, specialElements
, AttributeParams ( .. )
, emptyAttributeParams
, adjustForeignAttributes
, adjustMathMLAttributes
, adjustSvgAttributes
, DocumentTypeParams ( .. )
, emptyDocumentTypeParams
, QuirksMode ( .. )
, TokenizerState ( .. )
, CurrentTokenizerState ( .. )
, Token ( .. )
, TreeInput ( .. )
, TokenizerOutputState
, tokenRemainder
, dummyToken
, dummyStateToken
, mapTokenState
, mapTokenState'
, TagParams ( .. )
, emptyTagParams
, tokenCharacter
, tokenDoctype
, tokenDocumentType
, tokenTag
, tokenElement
, isEOF
, isCharacter
, isNull
, isWhitespace
, isComment
, isDoctype
, isAnyStartTag
, isAnyEndTag
, isStartTag
, isEndTag
, switchMode
, resetMode
, setFramesetNotOk
, insertFormattingMarker
, clearFormattingElements
, pushTemplateMode
, popTemplateMode
, resetInsertionMode
, resetInsertionMode'
, currentNode
, currentNodeIndex
, adjustedCurrentNode
, atHtmlIntegration
, atMathMLIntegration
, isMathMLAnnotationXml
, inFragment
, inIFrameSrcDoc
, hasOpenElement
, hasOpenElementExcept
, 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
type TreeBuilder out = StateParser TreeParserState [TreeInput] out
data TreeInput = TreeInput
{ TreeInput -> [ParseError]
tokenErrs :: [ParseError]
, TreeInput -> Token
tokenOut :: Token
, TreeInput -> TokenizerOutputState
tokenState :: TokenizerOutputState
}
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 )
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
type TokenizerOutputState = Maybe (TokenizerState, BS.ByteString)
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
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
}
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
tokenDoctype :: TreeInput -> DoctypeParams
tokenDoctype :: TreeInput -> DoctypeParams
tokenDoctype TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
Doctype DoctypeParams
d -> DoctypeParams
d
Token
_ -> DoctypeParams
emptyDoctypeParams
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'
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
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
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
}
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'
}
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 NodeIndex = Z.Natural
data TreeState = TreeState
{ TreeState -> TreeParserState
treeParserState :: TreeParserState
, TreeState -> TokenizerState
tokenizerState :: TokenizerState
}
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 )
data TreeParserState = TreeParserState
{ TreeParserState -> InsertionMode
insertionMode :: InsertionMode
, TreeParserState -> Maybe InsertionMode
originalInsertionMode :: Maybe InsertionMode
, TreeParserState -> [InsertionMode]
templateInsertionModes :: [InsertionMode]
, TreeParserState -> [(NodeIndex, ElementParams)]
openElements :: [(NodeIndex, ElementParams)]
, TreeParserState -> [[(NodeIndex, TagParams)]]
activeFormattingElements :: [[(NodeIndex, TagParams)]]
, TreeParserState -> NodeIndex
elementIndex :: NodeIndex
, TreeParserState -> Bool
isInIFrameSrcDoc :: Bool
, TreeParserState
-> Maybe (ElementParams, [(NodeIndex, ElementParams)])
fragmentContext :: Maybe (ElementParams, [(NodeIndex, ElementParams)])
, TreeParserState -> QuirksMode
quirksMode :: QuirksMode
, TreeParserState -> Bool
fosteringEnabled :: Bool
, TreeParserState -> Bool
scriptingEnabled :: Bool
, TreeParserState -> Bool
framesetOk :: Bool
, TreeParserState -> Maybe NodeIndex
headElementPointer :: Maybe NodeIndex
, TreeParserState -> Maybe NodeIndex
formElementPointer :: Maybe NodeIndex
}
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 )
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
}
}
data InsertionMode
= Initial
| BeforeHtml
| BeforeHead
| InHead
| InHeadNoscript
| AfterHead
| InBody
| InText
| InTable
| InTableText
| InCaption
| InColumnGroup
| InTableBody
| InRow
| InCell
| InSelect
| InSelectInTable
| InTemplate
| AfterBody
| InFrameset
| AfterFrameset
| AfterAfterBody
| AfterAfterFrameset
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 )
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
}
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
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
}
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
}
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
}
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
}
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
}
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
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
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
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
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
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
}
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
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
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"
]
]
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
}
isEOF :: TreeInput -> Bool
isEOF :: TreeInput -> Bool
isEOF TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
Token
EndOfStream -> Bool
True
Token
_ -> Bool
False
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
isCharacter :: TreeInput -> Bool
isCharacter :: TreeInput -> Bool
isCharacter TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
Character Char
_ -> Bool
True
Token
_ -> Bool
False
isNull :: TreeInput -> Bool
isNull :: TreeInput -> Bool
isNull TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
Character Char
'\NUL' -> Bool
True
Token
_ -> Bool
False
isComment :: TreeInput -> Bool
TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
Comment DoctypeName
_ -> Bool
True
Token
_ -> Bool
False
isDoctype :: TreeInput -> Bool
isDoctype :: TreeInput -> Bool
isDoctype TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
Doctype DoctypeParams
_ -> Bool
True
Token
_ -> Bool
False
isAnyStartTag :: TreeInput -> Bool
isAnyStartTag :: TreeInput -> Bool
isAnyStartTag TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
StartTag TagParams
_ -> Bool
True
Token
_ -> Bool
False
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
isAnyEndTag :: TreeInput -> Bool
isAnyEndTag :: TreeInput -> Bool
isAnyEndTag TreeInput
t' = case TreeInput -> Token
tokenOut TreeInput
t' of
EndTag TagParams
_ -> Bool
True
Token
_ -> Bool
False
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
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
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
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
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
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"
]
]
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
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
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
hasInScope :: [T.Text] -> TreeBuilder Bool
hasInScope :: [DoctypeName] -> TreeBuilder Bool
hasInScope = [(DoctypeName, DoctypeName)] -> [DoctypeName] -> TreeBuilder Bool
inScope [(DoctypeName, DoctypeName)]
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
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
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"
]
]
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
resetInsertionMode :: TreeBuilder ()
resetInsertionMode :: TreeBuilder ()
resetInsertionMode = (TreeParserState -> TreeParserState) -> TreeBuilder ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
N.S.modify TreeParserState -> TreeParserState
resetInsertionMode'
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
}
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"]
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
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