{-|
Description:    Basic data structures for building markup trees.

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

Stability:      experimental
Portability:    portable

In lieu of a fully-featured __[DOM](https://dom.spec.whatwg.org/)__
implementation ---and even, for that matter, a styled tree--- this module
provides bare-bones data structures to temporarily contain the minimal data
currently returned by tree parsing.  Eventually this will be padded out into a
fully-featured DOM implementation, but doing so now would be creating much more
work than necessary.
-}
module Web.Willow.DOM
    ( -- * Structure
      Tree ( .. )
    , emptyTree
    , Node ( .. )
    , NodeType ( .. )
    , nodeType
      -- * Data
      -- ** Document
    , QuirksMode ( .. )
      -- ** Elements
    , ElementParams ( .. )
    , emptyElementParams
    , ElementName
    , ElementPrefix
      -- *** Attribute list
    , AttributeMap
    , fromAttrList
    , toAttrList
    , insertAttribute
      -- ** Attributes
    , BasicAttribute
    , AttributeParams ( .. )
    , emptyAttributeParams
    , AttributeName
    , AttributeValue
    , AttributePrefix
      -- ** Document type declarations
    , DocumentTypeParams ( .. )
    , emptyDocumentTypeParams
    , DoctypeName
    , DoctypePublicId
    , DoctypeSystemId
      -- ** Namespaces
    , Namespace
    , htmlNamespace
    , mathMLNamespace
    , svgNamespace
    , xlinkNamespace
    , xmlNamespace
    , xmlnsNamespace
    ) where


import qualified Data.HashMap.Strict as M
import qualified Data.Text as T


-- | __DOM:__
--      @[tree]
--      (https://dom.spec.whatwg.org/#concept-tree)@
-- 
-- The core concept underlying HTML and related languages: a nested collection
-- of data and metadata marked up according to several broad categories.
-- Values may be easily instantiated as updates to 'emptyTree'.
data Tree = Tree
    { Tree -> Node
node :: Node
        -- ^ The atomic portion of the tree at the current location.
    , Tree -> [Tree]
children :: [Tree]
        -- ^ All parts of the tree nested below the current location.
    }
  deriving ( Tree -> Tree -> Bool
(Tree -> Tree -> Bool) -> (Tree -> Tree -> Bool) -> Eq Tree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree -> Tree -> Bool
$c/= :: Tree -> Tree -> Bool
== :: Tree -> Tree -> Bool
$c== :: Tree -> Tree -> Bool
Eq, Int -> Tree -> ShowS
[Tree] -> ShowS
Tree -> String
(Int -> Tree -> ShowS)
-> (Tree -> String) -> ([Tree] -> ShowS) -> Show Tree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> String
$cshow :: Tree -> String
showsPrec :: Int -> Tree -> ShowS
$cshowsPrec :: Int -> Tree -> ShowS
Show, ReadPrec [Tree]
ReadPrec Tree
Int -> ReadS Tree
ReadS [Tree]
(Int -> ReadS Tree)
-> ReadS [Tree] -> ReadPrec Tree -> ReadPrec [Tree] -> Read Tree
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tree]
$creadListPrec :: ReadPrec [Tree]
readPrec :: ReadPrec Tree
$creadPrec :: ReadPrec Tree
readList :: ReadS [Tree]
$creadList :: ReadS [Tree]
readsPrec :: Int -> ReadS Tree
$creadsPrec :: Int -> ReadS Tree
Read )

-- | A sane default collection for easy record initialization; namely, a
-- 'Document' without any 'children'.
emptyTree :: Tree
emptyTree :: Tree
emptyTree = Tree :: Node -> [Tree] -> Tree
Tree
    { node :: Node
node = QuirksMode -> Node
Document QuirksMode
NoQuirks
    , children :: [Tree]
children = []
    }


-- | __DOM:__
--      @[node]
--      (https://dom.spec.whatwg.org/#concept-node)@
-- 
-- The sum type of all different classes of behaviour a particular point of
-- data may fill.
data Node
    = Text T.Text
        -- ^ __DOM:__
        --      @[Text]
        --      (https://dom.spec.whatwg.org/#interface-text)@
        -- 
        -- A simple character string to be rendered to the output or to be
        -- processed further, according to which 'Element's enclose it.
    | Comment T.Text
        -- ^ __DOM:__
        --      @[Comment]
        --      (https://dom.spec.whatwg.org/#interface-comment)@
        -- 
        -- An author's aside, not intended to be shown to the end user.
    | DocumentType DocumentTypeParams
        -- ^ __DOM:__
        --      @[DocumentType]
        --      (https://dom.spec.whatwg.org/#interface-documenttype)@
        -- 
        -- Largely vestigial in HTML5, but used in previous versions and
        -- related languages to specify the semantics of 'Element's used in the
        -- document.
    | Element ElementParams
        -- ^ __DOM:__
        --      @[Element]
        --      (https://dom.spec.whatwg.org/#interface-element)@
        -- 
        -- Markup instructions directing the behaviour or classifying a portion
        -- of the document's content.
    | Attribute AttributeParams
        -- ^ __DOM:__
        --      @[Attr]
        --      (https://dom.spec.whatwg.org/#interface-attr)@
        -- 
        -- Metadata allowing finer customization and description of the heavier
        -- 'Element's.
    | DocumentFragment
        -- ^ __DOM:__
        --      @[DocumentType]
        --      (https://dom.spec.whatwg.org/#interface-documenttype)@
        -- 
        -- As like 'Document', but requiring less precise structure in its
        -- 'children' and generally only containing a small slice of a larger
        -- document.
    | Document QuirksMode
        -- ^ __DOM:__
        --      @[Document]
        --      (https://dom.spec.whatwg.org/#interface-document)@
        -- 
        -- The root of a 'Tree', typically imposing a principled structure.
  deriving ( Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, ReadPrec [Node]
ReadPrec Node
Int -> ReadS Node
ReadS [Node]
(Int -> ReadS Node)
-> ReadS [Node] -> ReadPrec Node -> ReadPrec [Node] -> Read Node
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Node]
$creadListPrec :: ReadPrec [Node]
readPrec :: ReadPrec Node
$creadPrec :: ReadPrec Node
readList :: ReadS [Node]
$creadList :: ReadS [Node]
readsPrec :: Int -> ReadS Node
$creadsPrec :: Int -> ReadS Node
Read )

-- | __DOM:__
--      @[nodeType]
--      (https://dom.spec.whatwg.org/#dom-node-nodetype)@
-- 
-- Simplify the algebraic data type to a one-dimensional 'Enum' to allow
-- equality testing rather than requiring pattern matching.
nodeType :: Node -> Maybe NodeType
nodeType :: Node -> Maybe NodeType
nodeType Text{} = NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
TextNode
nodeType Comment{} = NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
CommentNode
nodeType DocumentType{} = NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
DocumentTypeNode
nodeType Element{} = NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
ElementNode
nodeType Attribute{} = NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
AttributeNode
nodeType DocumentFragment{} = NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
DocumentFragmentNode
nodeType Document{} = NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
DocumentNode


-- | Through the long history of HTML browsers, many unique and/or buggy
-- behaviours have become enshrined due to the simple fact that website authors
-- used them.  As the standards and the parse engines have continued to
-- develop, three separated degrees of emulation have emerged for that
-- backwards compatibility.
data QuirksMode
    = NoQuirks
        -- ^ __DOM:__
        --      @[no-quirks mode]
        --      (https://dom.spec.whatwg.org/#concept-document-no-quirks)@
        -- 
        -- Fully compliant with the modern standard.
    | LimitedQuirks
        -- ^ __DOM:__
        --      @[limited-quirks mode]
        --      (https://dom.spec.whatwg.org/#concept-document-limited-quirks)@
        -- 
        -- Largely compliant with the standard, except for a couple height
        -- calculations.
    | FullQuirks
        -- ^ __DOM:__
        --      @[quirks mode]
        --      (https://dom.spec.whatwg.org/#concept-document-quirks)@
        -- 
        -- Backwards compatibility with 1990's-era technology.
  deriving ( QuirksMode -> QuirksMode -> Bool
(QuirksMode -> QuirksMode -> Bool)
-> (QuirksMode -> QuirksMode -> Bool) -> Eq QuirksMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuirksMode -> QuirksMode -> Bool
$c/= :: QuirksMode -> QuirksMode -> Bool
== :: QuirksMode -> QuirksMode -> Bool
$c== :: QuirksMode -> QuirksMode -> Bool
Eq, Eq QuirksMode
Eq QuirksMode
-> (QuirksMode -> QuirksMode -> Ordering)
-> (QuirksMode -> QuirksMode -> Bool)
-> (QuirksMode -> QuirksMode -> Bool)
-> (QuirksMode -> QuirksMode -> Bool)
-> (QuirksMode -> QuirksMode -> Bool)
-> (QuirksMode -> QuirksMode -> QuirksMode)
-> (QuirksMode -> QuirksMode -> QuirksMode)
-> Ord QuirksMode
QuirksMode -> QuirksMode -> Bool
QuirksMode -> QuirksMode -> Ordering
QuirksMode -> QuirksMode -> QuirksMode
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 :: QuirksMode -> QuirksMode -> QuirksMode
$cmin :: QuirksMode -> QuirksMode -> QuirksMode
max :: QuirksMode -> QuirksMode -> QuirksMode
$cmax :: QuirksMode -> QuirksMode -> QuirksMode
>= :: QuirksMode -> QuirksMode -> Bool
$c>= :: QuirksMode -> QuirksMode -> Bool
> :: QuirksMode -> QuirksMode -> Bool
$c> :: QuirksMode -> QuirksMode -> Bool
<= :: QuirksMode -> QuirksMode -> Bool
$c<= :: QuirksMode -> QuirksMode -> Bool
< :: QuirksMode -> QuirksMode -> Bool
$c< :: QuirksMode -> QuirksMode -> Bool
compare :: QuirksMode -> QuirksMode -> Ordering
$ccompare :: QuirksMode -> QuirksMode -> Ordering
$cp1Ord :: Eq QuirksMode
Ord, Int -> QuirksMode
QuirksMode -> Int
QuirksMode -> [QuirksMode]
QuirksMode -> QuirksMode
QuirksMode -> QuirksMode -> [QuirksMode]
QuirksMode -> QuirksMode -> QuirksMode -> [QuirksMode]
(QuirksMode -> QuirksMode)
-> (QuirksMode -> QuirksMode)
-> (Int -> QuirksMode)
-> (QuirksMode -> Int)
-> (QuirksMode -> [QuirksMode])
-> (QuirksMode -> QuirksMode -> [QuirksMode])
-> (QuirksMode -> QuirksMode -> [QuirksMode])
-> (QuirksMode -> QuirksMode -> QuirksMode -> [QuirksMode])
-> Enum QuirksMode
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 :: QuirksMode -> QuirksMode -> QuirksMode -> [QuirksMode]
$cenumFromThenTo :: QuirksMode -> QuirksMode -> QuirksMode -> [QuirksMode]
enumFromTo :: QuirksMode -> QuirksMode -> [QuirksMode]
$cenumFromTo :: QuirksMode -> QuirksMode -> [QuirksMode]
enumFromThen :: QuirksMode -> QuirksMode -> [QuirksMode]
$cenumFromThen :: QuirksMode -> QuirksMode -> [QuirksMode]
enumFrom :: QuirksMode -> [QuirksMode]
$cenumFrom :: QuirksMode -> [QuirksMode]
fromEnum :: QuirksMode -> Int
$cfromEnum :: QuirksMode -> Int
toEnum :: Int -> QuirksMode
$ctoEnum :: Int -> QuirksMode
pred :: QuirksMode -> QuirksMode
$cpred :: QuirksMode -> QuirksMode
succ :: QuirksMode -> QuirksMode
$csucc :: QuirksMode -> QuirksMode
Enum, QuirksMode
QuirksMode -> QuirksMode -> Bounded QuirksMode
forall a. a -> a -> Bounded a
maxBound :: QuirksMode
$cmaxBound :: QuirksMode
minBound :: QuirksMode
$cminBound :: QuirksMode
Bounded, Int -> QuirksMode -> ShowS
[QuirksMode] -> ShowS
QuirksMode -> String
(Int -> QuirksMode -> ShowS)
-> (QuirksMode -> String)
-> ([QuirksMode] -> ShowS)
-> Show QuirksMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuirksMode] -> ShowS
$cshowList :: [QuirksMode] -> ShowS
show :: QuirksMode -> String
$cshow :: QuirksMode -> String
showsPrec :: Int -> QuirksMode -> ShowS
$cshowsPrec :: Int -> QuirksMode -> ShowS
Show, ReadPrec [QuirksMode]
ReadPrec QuirksMode
Int -> ReadS QuirksMode
ReadS [QuirksMode]
(Int -> ReadS QuirksMode)
-> ReadS [QuirksMode]
-> ReadPrec QuirksMode
-> ReadPrec [QuirksMode]
-> Read QuirksMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QuirksMode]
$creadListPrec :: ReadPrec [QuirksMode]
readPrec :: ReadPrec QuirksMode
$creadPrec :: ReadPrec QuirksMode
readList :: ReadS [QuirksMode]
$creadList :: ReadS [QuirksMode]
readsPrec :: Int -> ReadS QuirksMode
$creadsPrec :: Int -> ReadS QuirksMode
Read )


-- | A simple key-value representation of an attribute on an HTML tag, before
-- any namespace processing.
type BasicAttribute = (AttributeName, AttributeValue)

-- | Type-level clarification for the short namespace reference classifying a
-- supplemental point of metadata.
type AttributePrefix = T.Text

-- | Type-level clarification for the key of a supplemental point of metadata.
type AttributeName = T.Text

-- | Type-level clarification for the value of a supplemental point of
-- metadata.
type AttributeValue = T.Text

-- | __DOM:__
--      @[Attr]
--      (https://dom.spec.whatwg.org/#attr)@
-- 
-- A more complete representation of an attribute, including extensions beyond
-- the 'BasicAttribute' to support more structured (XML-like) markup languages.
-- Values may be easily instantiated as updates to 'emptyAttributeParams'.
data AttributeParams = AttributeParams
    { AttributeParams -> Maybe AttributePrefix
attrPrefix :: Maybe AttributePrefix
        -- ^ The variable fragment used to represent the 'attrNamespace' in the
        -- original source.
    , AttributeParams -> AttributePrefix
attrName :: AttributeName
        -- ^ The key defining what role the metadata value point at 'attrValue'
        -- is meant to represent, as defined by the 'attrNamespace'.
    , AttributeParams -> Maybe AttributePrefix
attrNamespace :: Maybe Namespace
        -- ^ The scope defining the language by which the attribute
        -- participates in the document.
    , AttributeParams -> AttributePrefix
attrValue :: AttributeValue
        -- ^ A point of metadata further describing rendering behaviour or
        -- adding other information.
    }
  deriving ( AttributeParams -> AttributeParams -> Bool
(AttributeParams -> AttributeParams -> Bool)
-> (AttributeParams -> AttributeParams -> Bool)
-> Eq AttributeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeParams -> AttributeParams -> Bool
$c/= :: AttributeParams -> AttributeParams -> Bool
== :: AttributeParams -> AttributeParams -> Bool
$c== :: AttributeParams -> AttributeParams -> Bool
Eq, Int -> AttributeParams -> ShowS
[AttributeParams] -> ShowS
AttributeParams -> String
(Int -> AttributeParams -> ShowS)
-> (AttributeParams -> String)
-> ([AttributeParams] -> ShowS)
-> Show AttributeParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeParams] -> ShowS
$cshowList :: [AttributeParams] -> ShowS
show :: AttributeParams -> String
$cshow :: AttributeParams -> String
showsPrec :: Int -> AttributeParams -> ShowS
$cshowsPrec :: Int -> AttributeParams -> ShowS
Show, ReadPrec [AttributeParams]
ReadPrec AttributeParams
Int -> ReadS AttributeParams
ReadS [AttributeParams]
(Int -> ReadS AttributeParams)
-> ReadS [AttributeParams]
-> ReadPrec AttributeParams
-> ReadPrec [AttributeParams]
-> Read AttributeParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeParams]
$creadListPrec :: ReadPrec [AttributeParams]
readPrec :: ReadPrec AttributeParams
$creadPrec :: ReadPrec AttributeParams
readList :: ReadS [AttributeParams]
$creadList :: ReadS [AttributeParams]
readsPrec :: Int -> ReadS AttributeParams
$creadsPrec :: Int -> ReadS AttributeParams
Read )

-- | A sane default collection for easy record initialization; namely,
-- 'Nothing's and 'T.empty's.
emptyAttributeParams :: AttributeParams
emptyAttributeParams :: AttributeParams
emptyAttributeParams = AttributeParams :: Maybe AttributePrefix
-> AttributePrefix
-> Maybe AttributePrefix
-> AttributePrefix
-> AttributeParams
AttributeParams
    { attrPrefix :: Maybe AttributePrefix
attrPrefix = Maybe AttributePrefix
forall a. Maybe a
Nothing
    , attrName :: AttributePrefix
attrName = AttributePrefix
T.empty
    , attrNamespace :: Maybe AttributePrefix
attrNamespace = Maybe AttributePrefix
forall a. Maybe a
Nothing
    , attrValue :: AttributePrefix
attrValue = AttributePrefix
T.empty
    }


-- | Type-level clarification for the short namespace reference classifying a
-- markup tag.
type ElementPrefix = T.Text

-- | Type-level clarification for the name of a markup tag.
type ElementName = T.Text

-- | __DOM:__
--      @[Element]
--      (https://dom.spec.whatwg.org/#element)@
-- 
-- The collection of metadata identifying and describing a markup tag used to
-- associate text or other data with its broader role in the document, or to
-- indicate a preferred rendering.  Values may be easily instantiated as
-- updates to 'emptyElementParams'.
data ElementParams = ElementParams
    { ElementParams -> Maybe AttributePrefix
elementPrefix :: Maybe ElementPrefix
        -- ^ The variable fragment used to represent the 'elementNamespace' in
        -- the original source.
    , ElementParams -> AttributePrefix
elementName :: ElementName
        -- ^ The key defining what role the markup tag is meant to represent,
        -- as defined by the 'elementNamespace'.
    , ElementParams -> Maybe AttributePrefix
elementNamespace :: Maybe Namespace
        -- ^ The scope defining the language by which the elementibute
        -- participates in the document.
    , ElementParams -> AttributeMap
elementAttributes :: AttributeMap
        -- ^ The points of metadata further describing rendering behaviour or
        -- adding other information.
    }
  deriving ( ElementParams -> ElementParams -> Bool
(ElementParams -> ElementParams -> Bool)
-> (ElementParams -> ElementParams -> Bool) -> Eq ElementParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementParams -> ElementParams -> Bool
$c/= :: ElementParams -> ElementParams -> Bool
== :: ElementParams -> ElementParams -> Bool
$c== :: ElementParams -> ElementParams -> Bool
Eq, Int -> ElementParams -> ShowS
[ElementParams] -> ShowS
ElementParams -> String
(Int -> ElementParams -> ShowS)
-> (ElementParams -> String)
-> ([ElementParams] -> ShowS)
-> Show ElementParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementParams] -> ShowS
$cshowList :: [ElementParams] -> ShowS
show :: ElementParams -> String
$cshow :: ElementParams -> String
showsPrec :: Int -> ElementParams -> ShowS
$cshowsPrec :: Int -> ElementParams -> ShowS
Show, ReadPrec [ElementParams]
ReadPrec ElementParams
Int -> ReadS ElementParams
ReadS [ElementParams]
(Int -> ReadS ElementParams)
-> ReadS [ElementParams]
-> ReadPrec ElementParams
-> ReadPrec [ElementParams]
-> Read ElementParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ElementParams]
$creadListPrec :: ReadPrec [ElementParams]
readPrec :: ReadPrec ElementParams
$creadPrec :: ReadPrec ElementParams
readList :: ReadS [ElementParams]
$creadList :: ReadS [ElementParams]
readsPrec :: Int -> ReadS ElementParams
$creadsPrec :: Int -> ReadS ElementParams
Read )

-- | A sane default collection for easy record initialization.
emptyElementParams :: ElementParams
emptyElementParams :: ElementParams
emptyElementParams = ElementParams :: Maybe AttributePrefix
-> AttributePrefix
-> Maybe AttributePrefix
-> AttributeMap
-> ElementParams
ElementParams
    { elementPrefix :: Maybe AttributePrefix
elementPrefix = Maybe AttributePrefix
forall a. Maybe a
Nothing
    , elementName :: AttributePrefix
elementName = AttributePrefix
T.empty
    , elementNamespace :: Maybe AttributePrefix
elementNamespace = Maybe AttributePrefix
forall a. Maybe a
Nothing
    , elementAttributes :: AttributeMap
elementAttributes = AttributeMap
forall k v. HashMap k v
M.empty
    }


-- | __DOM:__
--      @[NamedNodeMap]
--      (https://dom.spec.whatwg.org/#interface-namednodemap)@
-- 
-- Type-level clarification for the collection of key-value points of
-- supplemental metadata attached to an 'Element'.  Note that, while an
-- 'Attribute'\'s prefix is used to determine the associated namespace (and
-- needs to be tracked for round-trip serialization), it doesn't factor into
-- testing equality or in lookups.
type AttributeMap = M.HashMap (Maybe Namespace, AttributeName) (Maybe AttributePrefix, AttributeValue)

-- | Helper function to transform key-value metadata from the indexable form
-- stored by an 'AttributeMap' into more structured data.
packAttr
    :: (Maybe Namespace, AttributeName)
    -> (Maybe AttributePrefix, AttributeValue)
    -> AttributeParams
packAttr :: (Maybe AttributePrefix, AttributePrefix)
-> (Maybe AttributePrefix, AttributePrefix) -> AttributeParams
packAttr (Maybe AttributePrefix
ns, AttributePrefix
n) (Maybe AttributePrefix
p, AttributePrefix
v) = AttributeParams
emptyAttributeParams
    { attrNamespace :: Maybe AttributePrefix
attrNamespace = Maybe AttributePrefix
ns
    , attrName :: AttributePrefix
attrName = AttributePrefix
n
    , attrPrefix :: Maybe AttributePrefix
attrPrefix = Maybe AttributePrefix
p
    , attrValue :: AttributePrefix
attrValue = AttributePrefix
v
    }

-- | Helper function to transform structured key-value metadata into the
-- indexable form stored by an 'AttributeMap'.
unpackAttr
    :: AttributeParams
    -> ((Maybe Namespace, AttributeName), (Maybe AttributePrefix, AttributeValue))
unpackAttr :: AttributeParams
-> ((Maybe AttributePrefix, AttributePrefix),
    (Maybe AttributePrefix, AttributePrefix))
unpackAttr AttributeParams
d = ((AttributeParams -> Maybe AttributePrefix
attrNamespace AttributeParams
d, AttributeParams -> AttributePrefix
attrName AttributeParams
d), (AttributeParams -> Maybe AttributePrefix
attrPrefix AttributeParams
d, AttributeParams -> AttributePrefix
attrValue AttributeParams
d))

-- | Extract the key-value metadata pairs from a indexed collection into an
-- iterable form.  The order of elements is unspecified.
toAttrList :: AttributeMap -> [AttributeParams]
toAttrList :: AttributeMap -> [AttributeParams]
toAttrList = (((Maybe AttributePrefix, AttributePrefix),
  (Maybe AttributePrefix, AttributePrefix))
 -> AttributeParams)
-> [((Maybe AttributePrefix, AttributePrefix),
     (Maybe AttributePrefix, AttributePrefix))]
-> [AttributeParams]
forall a b. (a -> b) -> [a] -> [b]
map (((Maybe AttributePrefix, AttributePrefix)
 -> (Maybe AttributePrefix, AttributePrefix) -> AttributeParams)
-> ((Maybe AttributePrefix, AttributePrefix),
    (Maybe AttributePrefix, AttributePrefix))
-> AttributeParams
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe AttributePrefix, AttributePrefix)
-> (Maybe AttributePrefix, AttributePrefix) -> AttributeParams
packAttr) ([((Maybe AttributePrefix, AttributePrefix),
   (Maybe AttributePrefix, AttributePrefix))]
 -> [AttributeParams])
-> (AttributeMap
    -> [((Maybe AttributePrefix, AttributePrefix),
         (Maybe AttributePrefix, AttributePrefix))])
-> AttributeMap
-> [AttributeParams]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeMap
-> [((Maybe AttributePrefix, AttributePrefix),
     (Maybe AttributePrefix, AttributePrefix))]
forall k v. HashMap k v -> [(k, v)]
M.toList

-- | Pack a list of key-value metadata pairs into a form better optimized for
-- random lookup.
fromAttrList :: [AttributeParams] -> AttributeMap
fromAttrList :: [AttributeParams] -> AttributeMap
fromAttrList = [((Maybe AttributePrefix, AttributePrefix),
  (Maybe AttributePrefix, AttributePrefix))]
-> AttributeMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([((Maybe AttributePrefix, AttributePrefix),
   (Maybe AttributePrefix, AttributePrefix))]
 -> AttributeMap)
-> ([AttributeParams]
    -> [((Maybe AttributePrefix, AttributePrefix),
         (Maybe AttributePrefix, AttributePrefix))])
-> [AttributeParams]
-> AttributeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttributeParams
 -> ((Maybe AttributePrefix, AttributePrefix),
     (Maybe AttributePrefix, AttributePrefix)))
-> [AttributeParams]
-> [((Maybe AttributePrefix, AttributePrefix),
     (Maybe AttributePrefix, AttributePrefix))]
forall a b. (a -> b) -> [a] -> [b]
map AttributeParams
-> ((Maybe AttributePrefix, AttributePrefix),
    (Maybe AttributePrefix, AttributePrefix))
unpackAttr

-- | As 'M.insert', performing the required data reordering for the
-- less-comfortable internal type representation.
insertAttribute :: AttributeParams -> AttributeMap -> AttributeMap
insertAttribute :: AttributeParams -> AttributeMap -> AttributeMap
insertAttribute AttributeParams
d = ((Maybe AttributePrefix, AttributePrefix)
 -> (Maybe AttributePrefix, AttributePrefix)
 -> AttributeMap
 -> AttributeMap)
-> ((Maybe AttributePrefix, AttributePrefix),
    (Maybe AttributePrefix, AttributePrefix))
-> AttributeMap
-> AttributeMap
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe AttributePrefix, AttributePrefix)
-> (Maybe AttributePrefix, AttributePrefix)
-> AttributeMap
-> AttributeMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert (((Maybe AttributePrefix, AttributePrefix),
  (Maybe AttributePrefix, AttributePrefix))
 -> AttributeMap -> AttributeMap)
-> ((Maybe AttributePrefix, AttributePrefix),
    (Maybe AttributePrefix, AttributePrefix))
-> AttributeMap
-> AttributeMap
forall a b. (a -> b) -> a -> b
$ AttributeParams
-> ((Maybe AttributePrefix, AttributePrefix),
    (Maybe AttributePrefix, AttributePrefix))
unpackAttr AttributeParams
d


-- | Type-level clarification for the language used in the document or,
-- equivalently, the name of the root node.
type DoctypeName = T.Text

-- | Type-level clarification for a registered or otherwise globally-unique
-- reference to a description of the language used in the document.
type DoctypePublicId = T.Text

-- | Type-level clarification for a reference to the description of the
-- language used in the document, dependant on the state of the system (and/or
-- the internet).
type DoctypeSystemId = T.Text

-- | __DOM:__
--      @[DocumentType]
--      (https://dom.spec.whatwg.org/#documenttype)@
-- 
-- The collection of metadata representing a document type declaration
-- describing the markup language used in a document; of vestigal use in HTML,
-- but important for related languages.  Values may be easily instantiated as
-- updates to 'emptyDocumentTypeParams'.
data DocumentTypeParams = DocumentTypeParams
    { DocumentTypeParams -> AttributePrefix
documentTypeName :: DoctypeName
        -- ^ The root element of the document, which may also identify the
        -- primary language used.
    , DocumentTypeParams -> AttributePrefix
documentTypePublicId :: DoctypePublicId
        -- ^ A globally-unique reference to the definition of the language.
    , DocumentTypeParams -> AttributePrefix
documentTypeSystemId :: DoctypeSystemId
        -- ^ A system-dependant (but perhaps easier to access) reference to the
        -- definition of the language.
    }
  deriving ( DocumentTypeParams -> DocumentTypeParams -> Bool
(DocumentTypeParams -> DocumentTypeParams -> Bool)
-> (DocumentTypeParams -> DocumentTypeParams -> Bool)
-> Eq DocumentTypeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentTypeParams -> DocumentTypeParams -> Bool
$c/= :: DocumentTypeParams -> DocumentTypeParams -> Bool
== :: DocumentTypeParams -> DocumentTypeParams -> Bool
$c== :: DocumentTypeParams -> DocumentTypeParams -> Bool
Eq, Int -> DocumentTypeParams -> ShowS
[DocumentTypeParams] -> ShowS
DocumentTypeParams -> String
(Int -> DocumentTypeParams -> ShowS)
-> (DocumentTypeParams -> String)
-> ([DocumentTypeParams] -> ShowS)
-> Show DocumentTypeParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentTypeParams] -> ShowS
$cshowList :: [DocumentTypeParams] -> ShowS
show :: DocumentTypeParams -> String
$cshow :: DocumentTypeParams -> String
showsPrec :: Int -> DocumentTypeParams -> ShowS
$cshowsPrec :: Int -> DocumentTypeParams -> ShowS
Show, ReadPrec [DocumentTypeParams]
ReadPrec DocumentTypeParams
Int -> ReadS DocumentTypeParams
ReadS [DocumentTypeParams]
(Int -> ReadS DocumentTypeParams)
-> ReadS [DocumentTypeParams]
-> ReadPrec DocumentTypeParams
-> ReadPrec [DocumentTypeParams]
-> Read DocumentTypeParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentTypeParams]
$creadListPrec :: ReadPrec [DocumentTypeParams]
readPrec :: ReadPrec DocumentTypeParams
$creadPrec :: ReadPrec DocumentTypeParams
readList :: ReadS [DocumentTypeParams]
$creadList :: ReadS [DocumentTypeParams]
readsPrec :: Int -> ReadS DocumentTypeParams
$creadsPrec :: Int -> ReadS DocumentTypeParams
Read )

-- | A sane default collection for easy record initialization; namely,
-- 'T.empty's.
emptyDocumentTypeParams :: DocumentTypeParams
emptyDocumentTypeParams :: DocumentTypeParams
emptyDocumentTypeParams = DocumentTypeParams :: AttributePrefix
-> AttributePrefix -> AttributePrefix -> DocumentTypeParams
DocumentTypeParams
    { documentTypeName :: AttributePrefix
documentTypeName = AttributePrefix
T.empty
    , documentTypePublicId :: AttributePrefix
documentTypePublicId = AttributePrefix
T.empty
    , documentTypeSystemId :: AttributePrefix
documentTypeSystemId = AttributePrefix
T.empty
    }


-- | A simplified view of the 'Node' constructors, for use in testing via
-- 'nodeType'.
data NodeType
    = ElementNode
        -- ^ __DOM:__
        --      @[ELEMENT_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-element_node)@
        -- 
        -- 'Element'
    | AttributeNode
        -- ^ __DOM:__
        --      @[ATTRIBUTE_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-attribute_node)@
        -- 
        -- 'Attribute'
    | TextNode
        -- ^ __DOM:__
        --      @[TEXT_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-text_node)@
        -- 
        -- 'Text'
    | CDataSectionNode
        -- ^ __DOM:__
        --      @[CDATA_SECTION_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-cdata_section_node)@
    | EntityReferenceNode
        -- ^ __DOM:__
        --      @[ENTITY_REFERENCE_NODE]
        --      (https://dom.spec.whatwg.org/#node)@
    | EntityNode
        -- ^ __DOM:__
        --      @[ENTITY_NODE]
        --      (https://dom.spec.whatwg.org/#node)@
    | ProcessingInstructionNode
        -- ^ __DOM:__
        --      @[PROCESSING_INSTRUCTION_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-processing-instruction_node)@
    | CommentNode
        -- ^ __DOM:__
        --      @[COMMENT_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-comment_node)@
        -- 
        -- 'Comment'
    | DocumentNode
        -- ^ __DOM:__
        --      @[DOCUMENT_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-document_node)@
        -- 
        -- 'Document'
    | DocumentTypeNode
        -- ^ __DOM:__
        --      @[DOCUMENT_TYPE_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-document_type_node)@
        -- 
        -- 'DocumentType'
    | DocumentFragmentNode
        -- ^ __DOM:__
        --      @[DOCUMENT_FRAGMENT_NODE]
        --      (https://dom.spec.whatwg.org/#dom-node-document_fragment_node)@
        -- 
        -- 'DocumentFragment'
    | NotationNode
        -- ^ __DOM:__
        --      @[NOTATION_NODE]
        --      (https://dom.spec.whatwg.org/#node)@
  deriving ( NodeType -> NodeType -> Bool
(NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool) -> Eq NodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeType -> NodeType -> Bool
$c/= :: NodeType -> NodeType -> Bool
== :: NodeType -> NodeType -> Bool
$c== :: NodeType -> NodeType -> Bool
Eq, Eq NodeType
Eq NodeType
-> (NodeType -> NodeType -> Ordering)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> NodeType)
-> (NodeType -> NodeType -> NodeType)
-> Ord NodeType
NodeType -> NodeType -> Bool
NodeType -> NodeType -> Ordering
NodeType -> NodeType -> NodeType
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 :: NodeType -> NodeType -> NodeType
$cmin :: NodeType -> NodeType -> NodeType
max :: NodeType -> NodeType -> NodeType
$cmax :: NodeType -> NodeType -> NodeType
>= :: NodeType -> NodeType -> Bool
$c>= :: NodeType -> NodeType -> Bool
> :: NodeType -> NodeType -> Bool
$c> :: NodeType -> NodeType -> Bool
<= :: NodeType -> NodeType -> Bool
$c<= :: NodeType -> NodeType -> Bool
< :: NodeType -> NodeType -> Bool
$c< :: NodeType -> NodeType -> Bool
compare :: NodeType -> NodeType -> Ordering
$ccompare :: NodeType -> NodeType -> Ordering
$cp1Ord :: Eq NodeType
Ord, NodeType
NodeType -> NodeType -> Bounded NodeType
forall a. a -> a -> Bounded a
maxBound :: NodeType
$cmaxBound :: NodeType
minBound :: NodeType
$cminBound :: NodeType
Bounded, Int -> NodeType -> ShowS
[NodeType] -> ShowS
NodeType -> String
(Int -> NodeType -> ShowS)
-> (NodeType -> String) -> ([NodeType] -> ShowS) -> Show NodeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeType] -> ShowS
$cshowList :: [NodeType] -> ShowS
show :: NodeType -> String
$cshow :: NodeType -> String
showsPrec :: Int -> NodeType -> ShowS
$cshowsPrec :: Int -> NodeType -> ShowS
Show, ReadPrec [NodeType]
ReadPrec NodeType
Int -> ReadS NodeType
ReadS [NodeType]
(Int -> ReadS NodeType)
-> ReadS [NodeType]
-> ReadPrec NodeType
-> ReadPrec [NodeType]
-> Read NodeType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeType]
$creadListPrec :: ReadPrec [NodeType]
readPrec :: ReadPrec NodeType
$creadPrec :: ReadPrec NodeType
readList :: ReadS [NodeType]
$creadList :: ReadS [NodeType]
readsPrec :: Int -> ReadS NodeType
$creadsPrec :: Int -> ReadS NodeType
Read )

instance Enum NodeType where
    fromEnum :: NodeType -> Int
fromEnum NodeType
ElementNode = Int
1
    fromEnum NodeType
AttributeNode = Int
2
    fromEnum NodeType
TextNode = Int
3
    fromEnum NodeType
CDataSectionNode = Int
4
    fromEnum NodeType
EntityReferenceNode = Int
5
    fromEnum NodeType
EntityNode = Int
6
    fromEnum NodeType
ProcessingInstructionNode = Int
7
    fromEnum NodeType
CommentNode = Int
8
    fromEnum NodeType
DocumentNode = Int
9
    fromEnum NodeType
DocumentTypeNode = Int
10
    fromEnum NodeType
DocumentFragmentNode = Int
11
    fromEnum NodeType
NotationNode = Int
12
    toEnum :: Int -> NodeType
toEnum Int
1 = NodeType
ElementNode
    toEnum Int
2 = NodeType
AttributeNode
    toEnum Int
3 = NodeType
TextNode
    toEnum Int
4 = NodeType
CDataSectionNode
    toEnum Int
5 = NodeType
EntityReferenceNode
    toEnum Int
6 = NodeType
EntityNode
    toEnum Int
7 = NodeType
ProcessingInstructionNode
    toEnum Int
8 = NodeType
CommentNode
    toEnum Int
9 = NodeType
DocumentNode
    toEnum Int
10 = NodeType
DocumentTypeNode
    toEnum Int
11 = NodeType
DocumentFragmentNode
    toEnum Int
12 = NodeType
NotationNode
    toEnum Int
_ = String -> NodeType
forall a. HasCallStack => String -> a
error String
"Web.Willow.DOM.NodeType.toEnum: invalid index"

{-# DEPRECATED EntityReferenceNode, EntityNode, NotationNode "historical" #-}


-- | __XML-NAMES:__
--      @[XML namespace]
--      (https://www.w3.org/TR/xml-names/#sec-namespaces)@
-- 
-- An identifier (theoretically) pointing to a reference defining a particular
-- element or attribute ---though not necessarily in machine-readable form---
-- and so providing a scope for differentiating multiple elements with the same
-- local name but different semantics.
type Namespace = T.Text

-- | __Infra:__
--      @[HTML namespace]
--      (https://infra.spec.whatwg.org/#html-namespace)@
-- 
-- The canonical scope value for elements and attributes defined by the HTML
-- standard when used in XML or XML-compatible documents.
htmlNamespace :: Namespace
htmlNamespace :: AttributePrefix
htmlNamespace = String -> AttributePrefix
T.pack String
"http://www.w3.org/1999/xhtml"

-- | __Infra:__
--      @[MathML namespace]
--      (https://infra.spec.whatwg.org/#mathml-namespace)@
-- 
-- The canonical scope value for elements and attributes defined by the MathML
-- standard.
mathMLNamespace :: Namespace
mathMLNamespace :: AttributePrefix
mathMLNamespace = String -> AttributePrefix
T.pack String
"http://www.w3.org/1998/Math/MathML"

-- | __Infra:__
--      @[SVG namespace]
--      (https://infra.spec.whatwg.org/#svg-namespace)@
-- 
-- The canonical scope value for elements and attributes defined by the SVG
-- standard.
svgNamespace :: Namespace
svgNamespace :: AttributePrefix
svgNamespace = String -> AttributePrefix
T.pack String
"http://www.w3.org/2000/svg"

-- | __Infra:__
--      @[XLink namespace]
--      (https://infra.spec.whatwg.org/#xlink-namespace)@
-- 
-- The canonical scope value for elements and attributes defined by the XLink
-- standard.
xlinkNamespace :: Namespace
xlinkNamespace :: AttributePrefix
xlinkNamespace = String -> AttributePrefix
T.pack String
"http://www.w3.org/1999/xlink"

-- | __Infra:__
--      @[XML namespace]
--      (https://infra.spec.whatwg.org/#xml-namespace)@
-- 
-- The canonical scope value for elements and attributes defined by the XML
-- standard.
xmlNamespace :: Namespace
xmlNamespace :: AttributePrefix
xmlNamespace = String -> AttributePrefix
T.pack String
"http://www.w3.org/XML/1998/namespace"

-- | __Infra:__
--      @[XMLNS namespace]
--      (https://infra.spec.whatwg.org/#xmlns-namespace)@
-- 
-- The canonical scope value for elements and attributes defined by the XMLNS
-- standard.
xmlnsNamespace :: Namespace
xmlnsNamespace :: AttributePrefix
xmlnsNamespace = String -> AttributePrefix
T.pack String
"http://www.w3.org/2000/xmlns/"