{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- | Defines the HTML DOM types and functions.
module Zenacy.HTML.Internal.DOM
  ( DOM(..)
  , DOMNode(..)
  , DOMAttr(..)
  , DOMType(..)
  , DOMQuirks(..)
  , DOMPos(..)
  , DOMID
  , DOMMap
  , domAttrMake
  , domDefaultDocument
  , domDefaultDoctype
  , domDefaultFragment
  , domDefaultElement
  , domDefaultTemplate
  , domDefaultText
  , domDefaultComment
  , domDefaultType
  , domMakeTypeHTML
  , domMakeTypeMathML
  , domMakeTypeSVG
  , domPos
  , domNull
  , domRoot
  , domRootPos
  , domDocument
  , domQuirksSet
  , domQuirksGet
  , domNewID
  , domGetNode
  , domPutNode
  , domInsert
  , domInsertNew
  , domAppend
  , domAppendNew
  , domElementHasAttr
  , domElementFindAttr
  , domElementAttrValue
  , domAttrMerge
  , domMatch
  , domLastChild
  , domMapID
  , domFindParent
  , domSetParent
  , domMapChild
  , domRemoveChild
  , domRemoveChildren
  , domMove
  , domMoveChildren
  , domChildren
  , domHasChild
  , domNodeID
  , domNodeParent
  , domNodeIsHTML
  , domNodeIsSVG
  , domNodeIsMathML
  , domNodeIsDocument
  , domNodeIsFragment
  , domNodeIsElement
  , domNodeIsTemplate
  , domNodeIsHtmlElement
  , domNodeIsText
  , domNodeElementName
  , domNodeElementNamespace
  , domNodeType
  , domTypesHTML
  , domTypesMathML
  , domTypesSVG
  , domRender
  ) where

import Zenacy.HTML.Internal.BS
import Zenacy.HTML.Internal.Core
import Zenacy.HTML.Internal.Types
import Data.Foldable
  ( toList
  )
import Data.List
  ( find
  )
import Data.Maybe
  ( fromJust
  , listToMaybe
  , isJust
  , mapMaybe
  )
import Data.Monoid
  ( (<>)
  )
import Data.Word
  ( Word8
  )
import Data.Default
  ( Default(..)
  )
import Data.IntMap
  ( IntMap
  )
import qualified Data.IntMap as IntMap
  ( singleton
  , lookup
  , insert
  , keys
  )
import Data.Sequence
  ( Seq(..)
  , ViewL(..)
  , ViewR(..)
  , (<|)
  , (|>)
  , (><)
  )
import qualified Data.Sequence as Seq
  ( breakl
  , empty
  , filter
  , viewl
  , viewr
  )

-- | DOM represents an HTML document while being parsed.
data DOM = DOM
  { DOM -> DOMMap
domNodes  :: !DOMMap
  , DOM -> DOMID
domNextID :: !DOMID
  } deriving (DOM -> DOM -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOM -> DOM -> Bool
$c/= :: DOM -> DOM -> Bool
== :: DOM -> DOM -> Bool
$c== :: DOM -> DOM -> Bool
Eq, Eq DOM
DOM -> DOM -> Bool
DOM -> DOM -> Ordering
DOM -> DOM -> DOM
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 :: DOM -> DOM -> DOM
$cmin :: DOM -> DOM -> DOM
max :: DOM -> DOM -> DOM
$cmax :: DOM -> DOM -> DOM
>= :: DOM -> DOM -> Bool
$c>= :: DOM -> DOM -> Bool
> :: DOM -> DOM -> Bool
$c> :: DOM -> DOM -> Bool
<= :: DOM -> DOM -> Bool
$c<= :: DOM -> DOM -> Bool
< :: DOM -> DOM -> Bool
$c< :: DOM -> DOM -> Bool
compare :: DOM -> DOM -> Ordering
$ccompare :: DOM -> DOM -> Ordering
Ord, DOMID -> DOM -> ShowS
[DOM] -> ShowS
DOM -> String
forall a.
(DOMID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOM] -> ShowS
$cshowList :: [DOM] -> ShowS
show :: DOM -> String
$cshow :: DOM -> String
showsPrec :: DOMID -> DOM -> ShowS
$cshowsPrec :: DOMID -> DOM -> ShowS
Show)

-- | Defines an ID for a node in a document.
type DOMID = Int

-- | Defines a mapping between node references and nodes.
type DOMMap = IntMap DOMNode

-- | Node is the model type for an HTML document.
data DOMNode
  = DOMDocument
    { DOMNode -> DOMID
domDocumentID          :: DOMID
    , DOMNode -> DOMID
domDocumentParent      :: DOMID
    , DOMNode -> BS
domDocumentName        :: BS
    , DOMNode -> Seq DOMID
domDocumentChildren    :: Seq DOMID
    , DOMNode -> DOMQuirks
domDocumentQuirksMode  :: DOMQuirks
    }
  | DOMDoctype
    { DOMNode -> DOMID
domDoctypeID           :: DOMID
    , DOMNode -> DOMID
domDoctypeParent       :: DOMID
    , DOMNode -> BS
domDoctypeName         :: BS
    , DOMNode -> Maybe BS
domDoctypePublicID     :: Maybe BS
    , DOMNode -> Maybe BS
domDoctypeSystemID     :: Maybe BS
    }
  | DOMFragment
    { DOMNode -> DOMID
domFragmentID          :: DOMID
    , DOMNode -> DOMID
domFragmentParent      :: DOMID
    , DOMNode -> BS
domFragmentName        :: BS
    , DOMNode -> Seq DOMID
domFragmentChildren    :: Seq DOMID
    }
  | DOMElement
    { DOMNode -> DOMID
domElementID           :: DOMID
    , DOMNode -> DOMID
domElementParent       :: DOMID
    , DOMNode -> BS
domElementName         :: BS
    , DOMNode -> HTMLNamespace
domElementNamespace    :: HTMLNamespace
    , DOMNode -> Seq DOMAttr
domElementAttributes   :: Seq DOMAttr
    , DOMNode -> Seq DOMID
domElementChildren     :: Seq DOMID
    }
  | DOMTemplate
    { DOMNode -> DOMID
domTemplateID          :: DOMID
    , DOMNode -> DOMID
domTemplateParent      :: DOMID
    , DOMNode -> HTMLNamespace
domTemplateNamespace   :: HTMLNamespace
    , DOMNode -> Seq DOMAttr
domTemplateAttributes  :: Seq DOMAttr
    , DOMNode -> DOMID
domTemplateContents    :: DOMID
    }
  | DOMText
    { DOMNode -> DOMID
domTextID              :: DOMID
    , DOMNode -> DOMID
domTextParent          :: DOMID
    , DOMNode -> BS
domTextData            :: BS
    }
  | DOMComment
    { DOMNode -> DOMID
domCommentID           :: DOMID
    , DOMNode -> DOMID
domCommentParent       :: DOMID
    , DOMNode -> BS
domCommentData         :: BS
    }
    deriving (DOMNode -> DOMNode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMNode -> DOMNode -> Bool
$c/= :: DOMNode -> DOMNode -> Bool
== :: DOMNode -> DOMNode -> Bool
$c== :: DOMNode -> DOMNode -> Bool
Eq, Eq DOMNode
DOMNode -> DOMNode -> Bool
DOMNode -> DOMNode -> Ordering
DOMNode -> DOMNode -> DOMNode
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 :: DOMNode -> DOMNode -> DOMNode
$cmin :: DOMNode -> DOMNode -> DOMNode
max :: DOMNode -> DOMNode -> DOMNode
$cmax :: DOMNode -> DOMNode -> DOMNode
>= :: DOMNode -> DOMNode -> Bool
$c>= :: DOMNode -> DOMNode -> Bool
> :: DOMNode -> DOMNode -> Bool
$c> :: DOMNode -> DOMNode -> Bool
<= :: DOMNode -> DOMNode -> Bool
$c<= :: DOMNode -> DOMNode -> Bool
< :: DOMNode -> DOMNode -> Bool
$c< :: DOMNode -> DOMNode -> Bool
compare :: DOMNode -> DOMNode -> Ordering
$ccompare :: DOMNode -> DOMNode -> Ordering
Ord, DOMID -> DOMNode -> ShowS
[DOMNode] -> ShowS
DOMNode -> String
forall a.
(DOMID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMNode] -> ShowS
$cshowList :: [DOMNode] -> ShowS
show :: DOMNode -> String
$cshow :: DOMNode -> String
showsPrec :: DOMID -> DOMNode -> ShowS
$cshowsPrec :: DOMID -> DOMNode -> ShowS
Show)

-- | An HTML element attribute type.
data DOMAttr = DOMAttr
  { DOMAttr -> BS
domAttrName      :: BS
  , DOMAttr -> BS
domAttrVal       :: BS
  , DOMAttr -> HTMLAttrNamespace
domAttrNamespace :: HTMLAttrNamespace
  } deriving (DOMAttr -> DOMAttr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMAttr -> DOMAttr -> Bool
$c/= :: DOMAttr -> DOMAttr -> Bool
== :: DOMAttr -> DOMAttr -> Bool
$c== :: DOMAttr -> DOMAttr -> Bool
Eq, Eq DOMAttr
DOMAttr -> DOMAttr -> Bool
DOMAttr -> DOMAttr -> Ordering
DOMAttr -> DOMAttr -> DOMAttr
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 :: DOMAttr -> DOMAttr -> DOMAttr
$cmin :: DOMAttr -> DOMAttr -> DOMAttr
max :: DOMAttr -> DOMAttr -> DOMAttr
$cmax :: DOMAttr -> DOMAttr -> DOMAttr
>= :: DOMAttr -> DOMAttr -> Bool
$c>= :: DOMAttr -> DOMAttr -> Bool
> :: DOMAttr -> DOMAttr -> Bool
$c> :: DOMAttr -> DOMAttr -> Bool
<= :: DOMAttr -> DOMAttr -> Bool
$c<= :: DOMAttr -> DOMAttr -> Bool
< :: DOMAttr -> DOMAttr -> Bool
$c< :: DOMAttr -> DOMAttr -> Bool
compare :: DOMAttr -> DOMAttr -> Ordering
$ccompare :: DOMAttr -> DOMAttr -> Ordering
Ord, DOMID -> DOMAttr -> ShowS
[DOMAttr] -> ShowS
DOMAttr -> String
forall a.
(DOMID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMAttr] -> ShowS
$cshowList :: [DOMAttr] -> ShowS
show :: DOMAttr -> String
$cshow :: DOMAttr -> String
showsPrec :: DOMID -> DOMAttr -> ShowS
$cshowsPrec :: DOMID -> DOMAttr -> ShowS
Show)


-- | Identifies the type of an element.
data DOMType = DOMType
  { DOMType -> BS
domTypeName      :: BS
  , DOMType -> HTMLNamespace
domTypeNamespace :: HTMLNamespace
  } deriving (DOMType -> DOMType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMType -> DOMType -> Bool
$c/= :: DOMType -> DOMType -> Bool
== :: DOMType -> DOMType -> Bool
$c== :: DOMType -> DOMType -> Bool
Eq, Eq DOMType
DOMType -> DOMType -> Bool
DOMType -> DOMType -> Ordering
DOMType -> DOMType -> DOMType
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 :: DOMType -> DOMType -> DOMType
$cmin :: DOMType -> DOMType -> DOMType
max :: DOMType -> DOMType -> DOMType
$cmax :: DOMType -> DOMType -> DOMType
>= :: DOMType -> DOMType -> Bool
$c>= :: DOMType -> DOMType -> Bool
> :: DOMType -> DOMType -> Bool
$c> :: DOMType -> DOMType -> Bool
<= :: DOMType -> DOMType -> Bool
$c<= :: DOMType -> DOMType -> Bool
< :: DOMType -> DOMType -> Bool
$c< :: DOMType -> DOMType -> Bool
compare :: DOMType -> DOMType -> Ordering
$ccompare :: DOMType -> DOMType -> Ordering
Ord, DOMID -> DOMType -> ShowS
[DOMType] -> ShowS
DOMType -> String
forall a.
(DOMID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMType] -> ShowS
$cshowList :: [DOMType] -> ShowS
show :: DOMType -> String
$cshow :: DOMType -> String
showsPrec :: DOMID -> DOMType -> ShowS
$cshowsPrec :: DOMID -> DOMType -> ShowS
Show)

-- | Indentifies the quirks mode.
data DOMQuirks
  = DOMQuirksNone
  | DOMQuirksMode
  | DOMQuirksLimited
    deriving (DOMQuirks -> DOMQuirks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMQuirks -> DOMQuirks -> Bool
$c/= :: DOMQuirks -> DOMQuirks -> Bool
== :: DOMQuirks -> DOMQuirks -> Bool
$c== :: DOMQuirks -> DOMQuirks -> Bool
Eq, Eq DOMQuirks
DOMQuirks -> DOMQuirks -> Bool
DOMQuirks -> DOMQuirks -> Ordering
DOMQuirks -> DOMQuirks -> DOMQuirks
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 :: DOMQuirks -> DOMQuirks -> DOMQuirks
$cmin :: DOMQuirks -> DOMQuirks -> DOMQuirks
max :: DOMQuirks -> DOMQuirks -> DOMQuirks
$cmax :: DOMQuirks -> DOMQuirks -> DOMQuirks
>= :: DOMQuirks -> DOMQuirks -> Bool
$c>= :: DOMQuirks -> DOMQuirks -> Bool
> :: DOMQuirks -> DOMQuirks -> Bool
$c> :: DOMQuirks -> DOMQuirks -> Bool
<= :: DOMQuirks -> DOMQuirks -> Bool
$c<= :: DOMQuirks -> DOMQuirks -> Bool
< :: DOMQuirks -> DOMQuirks -> Bool
$c< :: DOMQuirks -> DOMQuirks -> Bool
compare :: DOMQuirks -> DOMQuirks -> Ordering
$ccompare :: DOMQuirks -> DOMQuirks -> Ordering
Ord, DOMID -> DOMQuirks -> ShowS
[DOMQuirks] -> ShowS
DOMQuirks -> String
forall a.
(DOMID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMQuirks] -> ShowS
$cshowList :: [DOMQuirks] -> ShowS
show :: DOMQuirks -> String
$cshow :: DOMQuirks -> String
showsPrec :: DOMID -> DOMQuirks -> ShowS
$cshowsPrec :: DOMID -> DOMQuirks -> ShowS
Show)

-- | Defines a position in the DOM.
data DOMPos = DOMPos
  { DOMPos -> DOMID
domPosParent :: DOMID
  , DOMPos -> Maybe DOMID
domPosChild  :: Maybe DOMID
  } deriving (DOMPos -> DOMPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMPos -> DOMPos -> Bool
$c/= :: DOMPos -> DOMPos -> Bool
== :: DOMPos -> DOMPos -> Bool
$c== :: DOMPos -> DOMPos -> Bool
Eq, Eq DOMPos
DOMPos -> DOMPos -> Bool
DOMPos -> DOMPos -> Ordering
DOMPos -> DOMPos -> DOMPos
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 :: DOMPos -> DOMPos -> DOMPos
$cmin :: DOMPos -> DOMPos -> DOMPos
max :: DOMPos -> DOMPos -> DOMPos
$cmax :: DOMPos -> DOMPos -> DOMPos
>= :: DOMPos -> DOMPos -> Bool
$c>= :: DOMPos -> DOMPos -> Bool
> :: DOMPos -> DOMPos -> Bool
$c> :: DOMPos -> DOMPos -> Bool
<= :: DOMPos -> DOMPos -> Bool
$c<= :: DOMPos -> DOMPos -> Bool
< :: DOMPos -> DOMPos -> Bool
$c< :: DOMPos -> DOMPos -> Bool
compare :: DOMPos -> DOMPos -> Ordering
$ccompare :: DOMPos -> DOMPos -> Ordering
Ord, DOMID -> DOMPos -> ShowS
[DOMPos] -> ShowS
DOMPos -> String
forall a.
(DOMID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMPos] -> ShowS
$cshowList :: [DOMPos] -> ShowS
show :: DOMPos -> String
$cshow :: DOMPos -> String
showsPrec :: DOMID -> DOMPos -> ShowS
$cshowsPrec :: DOMID -> DOMPos -> ShowS
Show)

-- | Defines a default DOM.
instance Default DOM where
  def :: DOM
def = DOM
    { domNodes :: DOMMap
domNodes = forall a. DOMID -> a -> IntMap a
IntMap.singleton DOMID
domRoot DOMNode
domDefaultDocument
    , domNextID :: DOMID
domNextID = DOMID
domRoot forall a. Num a => a -> a -> a
+ DOMID
1
    }

-- | Defines a default attribute.
instance Default DOMAttr where
  def :: DOMAttr
def = DOMAttr
    { domAttrName :: BS
domAttrName      = BS
bsEmpty
    , domAttrVal :: BS
domAttrVal       = BS
bsEmpty
    , domAttrNamespace :: HTMLAttrNamespace
domAttrNamespace = forall a. Default a => a
def
    }

-- | Makes an attribute.
domAttrMake :: BS -> BS -> DOMAttr
domAttrMake :: BS -> BS -> DOMAttr
domAttrMake BS
n BS
v = BS -> BS -> HTMLAttrNamespace -> DOMAttr
DOMAttr BS
n BS
v forall a. Default a => a
def

-- | Defines a default document.
domDefaultDocument :: DOMNode
domDefaultDocument :: DOMNode
domDefaultDocument =
  DOMDocument
  { domDocumentID :: DOMID
domDocumentID         = DOMID
domNull
  , domDocumentName :: BS
domDocumentName       = BS
bsEmpty
  , domDocumentChildren :: Seq DOMID
domDocumentChildren   = forall a. Seq a
Seq.empty
  , domDocumentQuirksMode :: DOMQuirks
domDocumentQuirksMode = DOMQuirks
DOMQuirksNone
  , domDocumentParent :: DOMID
domDocumentParent     = DOMID
domNull
  }

-- | Defines a default document type.
domDefaultDoctype :: DOMNode
domDefaultDoctype :: DOMNode
domDefaultDoctype =
  DOMDoctype
  { domDoctypeID :: DOMID
domDoctypeID       = DOMID
domNull
  , domDoctypeName :: BS
domDoctypeName     = BS
bsEmpty
  , domDoctypePublicID :: Maybe BS
domDoctypePublicID = forall a. Maybe a
Nothing
  , domDoctypeSystemID :: Maybe BS
domDoctypeSystemID = forall a. Maybe a
Nothing
  , domDoctypeParent :: DOMID
domDoctypeParent   = DOMID
domNull
  }

-- | Defines a default document fragment.
domDefaultFragment :: DOMNode
domDefaultFragment :: DOMNode
domDefaultFragment =
  DOMFragment
  { domFragmentID :: DOMID
domFragmentID       = DOMID
domNull
  , domFragmentName :: BS
domFragmentName     = BS
bsEmpty
  , domFragmentChildren :: Seq DOMID
domFragmentChildren = forall a. Seq a
Seq.empty
  , domFragmentParent :: DOMID
domFragmentParent   = DOMID
domNull
  }

-- | Defines a default element.
domDefaultElement :: DOMNode
domDefaultElement :: DOMNode
domDefaultElement =
  DOMElement
  { domElementID :: DOMID
domElementID         = DOMID
domNull
  , domElementName :: BS
domElementName       = BS
bsEmpty
  , domElementNamespace :: HTMLNamespace
domElementNamespace  = HTMLNamespace
HTMLNamespaceHTML
  , domElementAttributes :: Seq DOMAttr
domElementAttributes = forall a. Seq a
Seq.empty
  , domElementChildren :: Seq DOMID
domElementChildren   = forall a. Seq a
Seq.empty
  , domElementParent :: DOMID
domElementParent     = DOMID
domNull
  }

-- | Defines a default template.
domDefaultTemplate :: DOMNode
domDefaultTemplate :: DOMNode
domDefaultTemplate =
  DOMTemplate
  { domTemplateID :: DOMID
domTemplateID         = DOMID
domNull
  , domTemplateNamespace :: HTMLNamespace
domTemplateNamespace  = HTMLNamespace
HTMLNamespaceHTML
  , domTemplateAttributes :: Seq DOMAttr
domTemplateAttributes = forall a. Seq a
Seq.empty
  , domTemplateContents :: DOMID
domTemplateContents   = DOMID
domNull
  , domTemplateParent :: DOMID
domTemplateParent     = DOMID
domNull
  }

-- | Defines a default text.
domDefaultText :: DOMNode
domDefaultText :: DOMNode
domDefaultText =
  DOMText
  { domTextID :: DOMID
domTextID     = DOMID
domNull
  , domTextData :: BS
domTextData   = BS
bsEmpty
  , domTextParent :: DOMID
domTextParent = DOMID
domNull
  }

-- | Defines a default comment.
domDefaultComment :: DOMNode
domDefaultComment :: DOMNode
domDefaultComment =
  DOMComment
  { domCommentID :: DOMID
domCommentID     = DOMID
domNull
  , domCommentData :: BS
domCommentData   = BS
bsEmpty
  , domCommentParent :: DOMID
domCommentParent = DOMID
domNull
  }

-- | Defines a default type.
domDefaultType :: DOMType
domDefaultType :: DOMType
domDefaultType = BS -> DOMType
domMakeTypeHTML BS
bsEmpty

-- | Makes a new HTML element type.
domMakeTypeHTML :: BS -> DOMType
domMakeTypeHTML :: BS -> DOMType
domMakeTypeHTML = forall a b c. (a -> b -> c) -> b -> a -> c
flip BS -> HTMLNamespace -> DOMType
DOMType HTMLNamespace
HTMLNamespaceHTML

-- | Makes a new MathML element type.
domMakeTypeMathML :: BS -> DOMType
domMakeTypeMathML :: BS -> DOMType
domMakeTypeMathML = forall a b c. (a -> b -> c) -> b -> a -> c
flip BS -> HTMLNamespace -> DOMType
DOMType HTMLNamespace
HTMLNamespaceMathML

-- | Makes a new SVG element type.
domMakeTypeSVG :: BS -> DOMType
domMakeTypeSVG :: BS -> DOMType
domMakeTypeSVG = forall a b c. (a -> b -> c) -> b -> a -> c
flip BS -> HTMLNamespace -> DOMType
DOMType HTMLNamespace
HTMLNamespaceSVG

-- | Makes a new position.
domPos :: DOMID -> DOMPos
domPos :: DOMID -> DOMPos
domPos DOMID
x = DOMID -> Maybe DOMID -> DOMPos
DOMPos DOMID
x forall a. Maybe a
Nothing

-- | The null node ID.
domNull :: DOMID
domNull :: DOMID
domNull = DOMID
0

-- | The root document node ID.
domRoot :: DOMID
domRoot :: DOMID
domRoot = DOMID
1

-- | Defines an appending position in a document node.
domRootPos :: DOMPos
domRootPos :: DOMPos
domRootPos = DOMID -> DOMPos
domPos DOMID
domRoot

-- | Gets the document node for a DOM.
domDocument :: DOM -> DOMNode
domDocument :: DOM -> DOMNode
domDocument DOM
d = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. DOMID -> IntMap a -> Maybe a
IntMap.lookup DOMID
domRoot forall a b. (a -> b) -> a -> b
$ DOM -> DOMMap
domNodes DOM
d

-- | Sets the quirks mode for a document.
domQuirksSet :: DOMQuirks -> DOM -> DOM
domQuirksSet :: DOMQuirks -> DOM -> DOM
domQuirksSet DOMQuirks
x DOM
d =
  case (DOM -> DOMNode
domDocument DOM
d) of
    y :: DOMNode
y@DOMDocument {} ->
      let
        y' :: DOMNode
y' = DOMNode
y { domDocumentQuirksMode :: DOMQuirks
domDocumentQuirksMode = DOMQuirks
x }
      in
        DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
domRoot DOMNode
y' DOM
d
    DOMNode
_otherwise ->
      DOM
d

-- | Gets the quirks mode for a document.
domQuirksGet :: DOM -> DOMQuirks
domQuirksGet :: DOM -> DOMQuirks
domQuirksGet = DOMNode -> DOMQuirks
domDocumentQuirksMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. DOM -> DOMNode
domDocument

-- | Adds a new node to a DOM.
domNewID :: DOM -> DOMNode -> (DOM, DOMID)
domNewID :: DOM -> DOMNode -> (DOM, DOMID)
domNewID DOM
d DOMNode
n = (DOM
d', DOMID
i)
  where
    i :: DOMID
i = DOM -> DOMID
domNextID DOM
d
    n' :: DOMNode
n' = DOMNode -> DOMID -> DOMNode
domSetID DOMNode
n DOMID
i
    d' :: DOM
d' = DOM
d { domNodes :: DOMMap
domNodes = forall a. DOMID -> a -> IntMap a -> IntMap a
IntMap.insert DOMID
i DOMNode
n' forall a b. (a -> b) -> a -> b
$ DOM -> DOMMap
domNodes DOM
d
           , domNextID :: DOMID
domNextID = DOMID
i forall a. Num a => a -> a -> a
+ DOMID
1
           }

-- | Sets the ID for a node.
domSetID :: DOMNode -> DOMID -> DOMNode
domSetID :: DOMNode -> DOMID -> DOMNode
domSetID DOMNode
x DOMID
y =
  case DOMNode
x of
    DOMDocument{} -> DOMNode
x { domDocumentID :: DOMID
domDocumentID = DOMID
y }
    DOMDoctype{}  -> DOMNode
x { domDoctypeID :: DOMID
domDoctypeID = DOMID
y }
    DOMFragment{} -> DOMNode
x { domFragmentID :: DOMID
domFragmentID = DOMID
y }
    DOMElement{}  -> DOMNode
x { domElementID :: DOMID
domElementID = DOMID
y }
    DOMTemplate{} -> DOMNode
x { domTemplateID :: DOMID
domTemplateID = DOMID
y }
    DOMText{}     -> DOMNode
x { domTextID :: DOMID
domTextID = DOMID
y }
    DOMComment{}  -> DOMNode
x { domCommentID :: DOMID
domCommentID = DOMID
y }

-- | Gets a node for a node ID.
domGetNode :: DOM -> DOMID -> Maybe DOMNode
domGetNode :: DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
x = forall a. DOMID -> IntMap a -> Maybe a
IntMap.lookup DOMID
x forall a b. (a -> b) -> a -> b
$ DOM -> DOMMap
domNodes DOM
d

-- | Updates a node in the DOM.
domPutNode :: DOMID -> DOMNode -> DOM -> DOM
domPutNode :: DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
x DOMNode
n DOM
d = DOM
d { domNodes :: DOMMap
domNodes = forall a. DOMID -> a -> IntMap a -> IntMap a
IntMap.insert DOMID
x DOMNode
n forall a b. (a -> b) -> a -> b
$ DOM -> DOMMap
domNodes DOM
d }

-- | Inserts a node at a position.
domInsert :: DOMPos -> DOMID -> DOM -> DOM
domInsert :: DOMPos -> DOMID -> DOM -> DOM
domInsert p :: DOMPos
p@(DOMPos DOMID
r Maybe DOMID
c) DOMID
x DOM
d =
  case DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
r of
    Just n :: DOMNode
n@(DOMDocument { domDocumentChildren :: DOMNode -> Seq DOMID
domDocumentChildren = Seq DOMID
a }) ->
      DOMNode -> DOM
f forall a b. (a -> b) -> a -> b
$ DOMNode
n { domDocumentChildren :: Seq DOMID
domDocumentChildren = Seq DOMID -> Seq DOMID
g Seq DOMID
a }
    Just n :: DOMNode
n@(DOMElement { domElementChildren :: DOMNode -> Seq DOMID
domElementChildren = Seq DOMID
a }) ->
      DOMNode -> DOM
f forall a b. (a -> b) -> a -> b
$ DOMNode
n { domElementChildren :: Seq DOMID
domElementChildren = Seq DOMID -> Seq DOMID
g Seq DOMID
a }
    Just n :: DOMNode
n@(DOMFragment { domFragmentChildren :: DOMNode -> Seq DOMID
domFragmentChildren = Seq DOMID
a }) ->
      DOMNode -> DOM
f forall a b. (a -> b) -> a -> b
$ DOMNode
n { domFragmentChildren :: Seq DOMID
domFragmentChildren = Seq DOMID -> Seq DOMID
g Seq DOMID
a }
    Just n :: DOMNode
n@(DOMTemplate { domTemplateContents :: DOMNode -> DOMID
domTemplateContents = DOMID
a }) ->
      DOMPos -> DOMID -> DOM -> DOM
domInsert (DOMID -> Maybe DOMID -> DOMPos
DOMPos DOMID
a Maybe DOMID
c) DOMID
x DOM
d
    Maybe DOMNode
_otherwise -> DOM
d
  where
    f :: DOMNode -> DOM
f DOMNode
a = DOMID -> DOMID -> DOM -> DOM
domSetParent DOMID
x DOMID
r (DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
r DOMNode
a DOM
d)
    g :: Seq DOMID -> Seq DOMID
g = DOMPos -> DOMID -> Seq DOMID -> Seq DOMID
domInsertChild DOMPos
p DOMID
x

-- | Inserts a node at a position.
domInsertNew :: DOMPos -> DOMNode -> DOM -> (DOM, DOMID)
domInsertNew :: DOMPos -> DOMNode -> DOM -> (DOM, DOMID)
domInsertNew DOMPos
p DOMNode
x DOM
d =
  (DOMPos -> DOMID -> DOM -> DOM
domInsert DOMPos
p DOMID
i DOM
d', DOMID
i)
  where
    (DOM
d', DOMID
i) = DOM -> DOMNode -> (DOM, DOMID)
domNewID DOM
d DOMNode
x

-- | Inserts a child in a list of children.
domInsertChild :: DOMPos -> DOMID -> Seq DOMID -> Seq DOMID
domInsertChild :: DOMPos -> DOMID -> Seq DOMID -> Seq DOMID
domInsertChild (DOMPos DOMID
_ Maybe DOMID
Nothing) DOMID
x = (forall a. Seq a -> a -> Seq a
|> DOMID
x)
domInsertChild (DOMPos DOMID
_ (Just DOMID
a)) DOMID
x = forall a. (a -> Bool) -> a -> Seq a -> Seq a
seqInsertBefore (forall a. Eq a => a -> a -> Bool
==DOMID
a) DOMID
x

-- | Appends a node ID to a node.
domAppend :: DOMID -> DOMID -> DOM -> DOM
domAppend :: DOMID -> DOMID -> DOM -> DOM
domAppend DOMID
x DOMID
y DOM
d =
  case DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
x of
    Just (DOMDocument DOMID
i DOMID
p BS
n Seq DOMID
c DOMQuirks
q) ->
      DOMNode -> DOM
f forall a b. (a -> b) -> a -> b
$ DOMID -> DOMID -> BS -> Seq DOMID -> DOMQuirks -> DOMNode
DOMDocument DOMID
i DOMID
p BS
n (Seq DOMID
c forall a. Seq a -> a -> Seq a
|> DOMID
y) DOMQuirks
q
    Just (DOMElement DOMID
i DOMID
p BS
n HTMLNamespace
s Seq DOMAttr
a Seq DOMID
c) ->
      DOMNode -> DOM
f forall a b. (a -> b) -> a -> b
$ DOMID
-> DOMID
-> BS
-> HTMLNamespace
-> Seq DOMAttr
-> Seq DOMID
-> DOMNode
DOMElement DOMID
i DOMID
p BS
n HTMLNamespace
s Seq DOMAttr
a (Seq DOMID
c forall a. Seq a -> a -> Seq a
|> DOMID
y)
    Just (DOMFragment DOMID
i DOMID
p BS
n Seq DOMID
c) ->
      DOMNode -> DOM
f forall a b. (a -> b) -> a -> b
$ DOMID -> DOMID -> BS -> Seq DOMID -> DOMNode
DOMFragment DOMID
i DOMID
p BS
n (Seq DOMID
c forall a. Seq a -> a -> Seq a
|> DOMID
y)
    Just (DOMTemplate DOMID
_ DOMID
_ HTMLNamespace
_ Seq DOMAttr
_ DOMID
c) ->
      DOMID -> DOMID -> DOM -> DOM
domAppend DOMID
c DOMID
y DOM
d
    Maybe DOMNode
_otherwise -> DOM
d
  where
    f :: DOMNode -> DOM
f DOMNode
a = DOMID -> DOMID -> DOM -> DOM
domSetParent DOMID
y DOMID
x (DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
x DOMNode
a DOM
d)

-- | Appends a node to a node.
domAppendNew :: DOMID -> DOMNode -> DOM -> DOM
domAppendNew :: DOMID -> DOMNode -> DOM -> DOM
domAppendNew DOMID
x DOMNode
y DOM
d = DOMID -> DOMID -> DOM -> DOM
domAppend DOMID
x DOMID
i DOM
d'
  where (DOM
d', DOMID
i) = DOM -> DOMNode -> (DOM, DOMID)
domNewID DOM
d DOMNode
y

-- | Finds an attribute for an element.
domElementFindAttr :: DOMNode -> BS -> Maybe DOMAttr
domElementFindAttr :: DOMNode -> BS -> Maybe DOMAttr
domElementFindAttr DOMNode
node BS
name = case DOMNode
node of
  DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..} -> Seq DOMAttr -> Maybe DOMAttr
f Seq DOMAttr
domElementAttributes
  DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} -> Seq DOMAttr -> Maybe DOMAttr
f Seq DOMAttr
domTemplateAttributes
  DOMNode
_otherwise -> forall a. Maybe a
Nothing
  where
    f :: Seq DOMAttr -> Maybe DOMAttr
f = forall a. (a -> Bool) -> Seq a -> Maybe a
seqFind (\DOMAttr{BS
HTMLAttrNamespace
domAttrNamespace :: HTMLAttrNamespace
domAttrVal :: BS
domAttrName :: BS
domAttrNamespace :: DOMAttr -> HTMLAttrNamespace
domAttrVal :: DOMAttr -> BS
domAttrName :: DOMAttr -> BS
..} -> BS
domAttrName forall a. Eq a => a -> a -> Bool
== BS
name)

-- | Gets the last element in a sequence if it exists.
seqLast :: Seq a -> Maybe a
seqLast :: forall a. Seq a -> Maybe a
seqLast (forall a. Seq a -> ViewR a
Seq.viewr -> ViewR a
EmptyR) = forall a. Maybe a
Nothing
seqLast (forall a. Seq a -> ViewR a
Seq.viewr -> Seq a
_ :> a
a) = forall a. a -> Maybe a
Just a
a

-- | Finds an element in a sequence.
seqFind :: (a -> Bool) -> Seq a -> Maybe a
seqFind :: forall a. (a -> Bool) -> Seq a -> Maybe a
seqFind a -> Bool
f Seq a
x = Seq a -> Maybe a
go Seq a
x
  where
    go :: Seq a -> Maybe a
go (forall a. Seq a -> ViewL a
Seq.viewl -> ViewL a
EmptyL) = forall a. Maybe a
Nothing
    go (forall a. Seq a -> ViewL a
Seq.viewl -> a
a :< Seq a
b) = if a -> Bool
f a
a then forall a. a -> Maybe a
Just a
a else Seq a -> Maybe a
go Seq a
b

-- | Inserts an element into a sequence before the element satisfying a predicate.
seqInsertBefore :: (a -> Bool) -> a -> Seq a -> Seq a
seqInsertBefore :: forall a. (a -> Bool) -> a -> Seq a -> Seq a
seqInsertBefore a -> Bool
f a
x Seq a
y =
  (Seq a
a forall a. Seq a -> a -> Seq a
|> a
x) forall a. Semigroup a => a -> a -> a
<> Seq a
b
  where
    (Seq a
a, Seq a
b) = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl a -> Bool
f Seq a
y

-- | Finds an attribute value for an element.
domElementAttrValue :: DOMNode -> BS -> Maybe BS
domElementAttrValue :: DOMNode -> BS -> Maybe BS
domElementAttrValue DOMNode
x BS
n = DOMAttr -> BS
domAttrVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMNode -> BS -> Maybe DOMAttr
domElementFindAttr DOMNode
x BS
n

-- | Determines if a node has a named attribute.
domElementHasAttr  :: DOMNode -> BS -> Bool
domElementHasAttr :: DOMNode -> BS -> Bool
domElementHasAttr DOMNode
x = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. DOMNode -> BS -> Maybe DOMAttr
domElementFindAttr DOMNode
x

-- | Merges attributes into an existing node.
domAttrMerge :: DOMID -> Seq DOMAttr -> DOM -> DOM
domAttrMerge :: DOMID -> Seq DOMAttr -> DOM -> DOM
domAttrMerge DOMID
x Seq DOMAttr
y DOM
d =
  case DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
x of
    Just n :: DOMNode
n@(DOMElement { domElementAttributes :: DOMNode -> Seq DOMAttr
domElementAttributes = Seq DOMAttr
a }) ->
      DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
x (DOMNode
n { domElementAttributes :: Seq DOMAttr
domElementAttributes = Seq DOMAttr
a forall a. Semigroup a => a -> a -> a
<> DOMNode -> Seq DOMAttr -> Seq DOMAttr
f DOMNode
n Seq DOMAttr
y }) DOM
d
    Just n :: DOMNode
n@(DOMTemplate { domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateAttributes = Seq DOMAttr
a }) ->
      DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
x (DOMNode
n { domTemplateAttributes :: Seq DOMAttr
domTemplateAttributes = Seq DOMAttr
a forall a. Semigroup a => a -> a -> a
<> DOMNode -> Seq DOMAttr -> Seq DOMAttr
f DOMNode
n Seq DOMAttr
y }) DOM
d
    Maybe DOMNode
_otherwise -> DOM
d
  where
    f :: DOMNode -> Seq DOMAttr -> Seq DOMAttr
f DOMNode
n = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. DOMNode -> BS -> Bool
domElementHasAttr DOMNode
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. DOMAttr -> BS
domAttrName)

-- | Detmermines if two elements match.
domMatch :: DOM -> DOMID -> DOMID -> Bool
domMatch :: DOM -> DOMID -> DOMID -> Bool
domMatch DOM
d DOMID
i DOMID
j =
  case (DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
i, DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
j) of
    (Just (DOMElement DOMID
_ DOMID
_ BS
n1 HTMLNamespace
s1 Seq DOMAttr
a1 Seq DOMID
_), Just (DOMElement DOMID
_ DOMID
_ BS
n2 HTMLNamespace
s2 Seq DOMAttr
a2 Seq DOMID
_)) ->
      BS
n1 forall a. Eq a => a -> a -> Bool
== BS
n2 Bool -> Bool -> Bool
&& HTMLNamespace
s1 forall a. Eq a => a -> a -> Bool
== HTMLNamespace
s2 Bool -> Bool -> Bool
&& Seq DOMAttr
a1 forall a. Eq a => a -> a -> Bool
== Seq DOMAttr
a1
    (Just (DOMTemplate DOMID
_ DOMID
_ HTMLNamespace
s1 Seq DOMAttr
a1 DOMID
_ ), Just (DOMTemplate DOMID
_ DOMID
_ HTMLNamespace
s2 Seq DOMAttr
a2 DOMID
_)) ->
      HTMLNamespace
s1 forall a. Eq a => a -> a -> Bool
== HTMLNamespace
s2 Bool -> Bool -> Bool
&& Seq DOMAttr
a1 forall a. Eq a => a -> a -> Bool
== Seq DOMAttr
a1
    (Maybe DOMNode, Maybe DOMNode)
_otherwise ->
      Bool
False

-- | Returns the last child of a node if it exists.
domLastChild :: DOM -> DOMID -> Maybe DOMID
domLastChild :: DOM -> DOMID -> Maybe DOMID
domLastChild DOM
d DOMID
x =
  DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    DOMDocument{DOMID
BS
Seq DOMID
DOMQuirks
domDocumentQuirksMode :: DOMQuirks
domDocumentChildren :: Seq DOMID
domDocumentName :: BS
domDocumentParent :: DOMID
domDocumentID :: DOMID
domDocumentQuirksMode :: DOMNode -> DOMQuirks
domDocumentChildren :: DOMNode -> Seq DOMID
domDocumentName :: DOMNode -> BS
domDocumentParent :: DOMNode -> DOMID
domDocumentID :: DOMNode -> DOMID
..} -> forall a. Seq a -> Maybe a
seqLast Seq DOMID
domDocumentChildren
    DOMFragment{DOMID
BS
Seq DOMID
domFragmentChildren :: Seq DOMID
domFragmentName :: BS
domFragmentParent :: DOMID
domFragmentID :: DOMID
domFragmentChildren :: DOMNode -> Seq DOMID
domFragmentName :: DOMNode -> BS
domFragmentParent :: DOMNode -> DOMID
domFragmentID :: DOMNode -> DOMID
..} -> forall a. Seq a -> Maybe a
seqLast Seq DOMID
domFragmentChildren
    DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..}  -> forall a. Seq a -> Maybe a
seqLast Seq DOMID
domElementChildren
    DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} -> DOM -> DOMID -> Maybe DOMID
domLastChild DOM
d DOMID
domTemplateContents
    DOMNode
_otherwise -> forall a. Maybe a
Nothing

-- | Converts a list of node IDs to nodes.
domMapID :: DOM -> [DOMID] -> [DOMNode]
domMapID :: DOM -> [DOMID] -> [DOMNode]
domMapID DOM
d = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a -> b) -> a -> b
$ DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d

-- | Finds the parent node for a node.
domFindParent :: DOM -> DOMID -> Maybe DOMID
domFindParent :: DOM -> DOMID -> Maybe DOMID
domFindParent DOM
d DOMID
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (DOM -> DOMID -> DOMID -> Bool
domHasChild DOM
d DOMID
x) forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [DOMID]
IntMap.keys forall a b. (a -> b) -> a -> b
$ DOM -> DOMMap
domNodes DOM
d

-- | Sets the parent for a node.
domSetParent :: DOMID -> DOMID -> DOM -> DOM
domSetParent :: DOMID -> DOMID -> DOM -> DOM
domSetParent DOMID
x DOMID
y DOM
d =
  case DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
x of
    Just DOMNode
a -> case DOMNode
a of
      DOMDocument{} -> DOMNode -> DOM
f DOMNode
a { domDocumentParent :: DOMID
domDocumentParent = DOMID
y }
      DOMDoctype{}  -> DOMNode -> DOM
f DOMNode
a { domDoctypeParent :: DOMID
domDoctypeParent = DOMID
y }
      DOMFragment{} -> DOMNode -> DOM
f DOMNode
a { domFragmentParent :: DOMID
domFragmentParent = DOMID
y }
      DOMElement{}  -> DOMNode -> DOM
f DOMNode
a { domElementParent :: DOMID
domElementParent = DOMID
y }
      DOMTemplate{} -> DOMNode -> DOM
f DOMNode
a { domTemplateParent :: DOMID
domTemplateParent = DOMID
y }
      DOMText{}     -> DOMNode -> DOM
f DOMNode
a { domTextParent :: DOMID
domTextParent = DOMID
y }
      DOMComment{}  -> DOMNode -> DOM
f DOMNode
a { domCommentParent :: DOMID
domCommentParent = DOMID
y }
    Maybe DOMNode
Nothing -> DOM
d
  where
    f :: DOMNode -> DOM
f DOMNode
z = DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
x DOMNode
z DOM
d

-- | Maps a function over children of a node.
domMapChild :: DOMID -> (Seq DOMID -> Seq DOMID)-> DOM -> DOM
domMapChild :: DOMID -> (Seq DOMID -> Seq DOMID) -> DOM -> DOM
domMapChild DOMID
x Seq DOMID -> Seq DOMID
f DOM
d =
  case DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
x of
    Just DOMNode
a -> case DOMNode
a of
      DOMDocument { domDocumentChildren :: DOMNode -> Seq DOMID
domDocumentChildren = Seq DOMID
c } ->
        DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
x DOMNode
a { domDocumentChildren :: Seq DOMID
domDocumentChildren = Seq DOMID -> Seq DOMID
f Seq DOMID
c } DOM
d
      DOMFragment { domFragmentChildren :: DOMNode -> Seq DOMID
domFragmentChildren = Seq DOMID
c } ->
        DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
x DOMNode
a { domFragmentChildren :: Seq DOMID
domFragmentChildren = Seq DOMID -> Seq DOMID
f Seq DOMID
c } DOM
d
      DOMElement { domElementChildren :: DOMNode -> Seq DOMID
domElementChildren = Seq DOMID
c } ->
        DOMID -> DOMNode -> DOM -> DOM
domPutNode DOMID
x DOMNode
a { domElementChildren :: Seq DOMID
domElementChildren = Seq DOMID -> Seq DOMID
f Seq DOMID
c } DOM
d
      DOMTemplate { domTemplateContents :: DOMNode -> DOMID
domTemplateContents = DOMID
c } ->
        DOMID -> (Seq DOMID -> Seq DOMID) -> DOM -> DOM
domMapChild DOMID
c Seq DOMID -> Seq DOMID
f DOM
d
      DOMNode
_otherwise -> DOM
d
    Maybe DOMNode
Nothing -> DOM
d

-- | Removes a child from a node.
domRemoveChild :: DOMID -> DOMID -> DOM -> DOM
domRemoveChild :: DOMID -> DOMID -> DOM -> DOM
domRemoveChild DOMID
parent DOMID
child = DOMID -> (Seq DOMID -> Seq DOMID) -> DOM -> DOM
domMapChild DOMID
parent forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall a. Eq a => a -> a -> Bool
/=DOMID
child)

-- | Removes all the children from a node.
domRemoveChildren :: DOMID -> DOM -> DOM
domRemoveChildren :: DOMID -> DOM -> DOM
domRemoveChildren DOMID
x = DOMID -> (Seq DOMID -> Seq DOMID) -> DOM -> DOM
domMapChild DOMID
x forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. Seq a
Seq.empty

-- | Moves a node to another parent.
domMove :: DOMID -> DOMID -> DOM -> DOM
domMove :: DOMID -> DOMID -> DOM -> DOM
domMove DOMID
x DOMID
newParent DOM
d =
  case DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
x of
    Just DOMNode
a ->
      let d' :: DOM
d' = DOMID -> DOMID -> DOM -> DOM
domRemoveChild (DOMNode -> DOMID
domNodeParent DOMNode
a) DOMID
x DOM
d
      in DOMID -> DOMID -> DOM -> DOM
domAppend DOMID
newParent DOMID
x DOM
d'
    Maybe DOMNode
Nothing -> DOM
d

-- | Moves the children of a node to another node.
domMoveChildren :: DOMID -> DOMID -> DOM -> DOM
domMoveChildren :: DOMID -> DOMID -> DOM -> DOM
domMoveChildren DOMID
x DOMID
y DOM
d =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\DOM
d' DOMID
c -> DOMID -> DOMID -> DOM -> DOM
domAppend DOMID
y DOMID
c DOM
d') (DOMID -> DOM -> DOM
domRemoveChildren DOMID
x DOM
d) forall a b. (a -> b) -> a -> b
$ DOM -> DOMID -> Seq DOMID
domChildren DOM
d DOMID
x

-- | Gets the children of a node.
domChildren :: DOM -> DOMID -> Seq DOMID
domChildren :: DOM -> DOMID -> Seq DOMID
domChildren DOM
d DOMID
x =
  case DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
x of
    Just (DOMDocument{DOMID
BS
Seq DOMID
DOMQuirks
domDocumentQuirksMode :: DOMQuirks
domDocumentChildren :: Seq DOMID
domDocumentName :: BS
domDocumentParent :: DOMID
domDocumentID :: DOMID
domDocumentQuirksMode :: DOMNode -> DOMQuirks
domDocumentChildren :: DOMNode -> Seq DOMID
domDocumentName :: DOMNode -> BS
domDocumentParent :: DOMNode -> DOMID
domDocumentID :: DOMNode -> DOMID
..}) -> Seq DOMID
domDocumentChildren
    Just (DOMFragment{DOMID
BS
Seq DOMID
domFragmentChildren :: Seq DOMID
domFragmentName :: BS
domFragmentParent :: DOMID
domFragmentID :: DOMID
domFragmentChildren :: DOMNode -> Seq DOMID
domFragmentName :: DOMNode -> BS
domFragmentParent :: DOMNode -> DOMID
domFragmentID :: DOMNode -> DOMID
..}) -> Seq DOMID
domFragmentChildren
    Just (DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..})  -> Seq DOMID
domElementChildren
    Just (DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..}) -> DOM -> DOMID -> Seq DOMID
domChildren DOM
d DOMID
domTemplateContents
    Maybe DOMNode
_otherwise             -> forall a. Seq a
Seq.empty

-- | Determines if a node has a specific child.
domHasChild :: DOM -> DOMID -> DOMID -> Bool
domHasChild :: DOM -> DOMID -> DOMID -> Bool
domHasChild DOM
d DOMID
x DOMID
z = DOMID
z forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DOM -> DOMID -> Seq DOMID
domChildren DOM
d DOMID
x

-- | Gets the id for a node.
domNodeID :: DOMNode -> DOMID
domNodeID :: DOMNode -> DOMID
domNodeID = \case
  DOMDocument{DOMID
BS
Seq DOMID
DOMQuirks
domDocumentQuirksMode :: DOMQuirks
domDocumentChildren :: Seq DOMID
domDocumentName :: BS
domDocumentParent :: DOMID
domDocumentID :: DOMID
domDocumentQuirksMode :: DOMNode -> DOMQuirks
domDocumentChildren :: DOMNode -> Seq DOMID
domDocumentName :: DOMNode -> BS
domDocumentParent :: DOMNode -> DOMID
domDocumentID :: DOMNode -> DOMID
..} -> DOMID
domDocumentID
  DOMDoctype{DOMID
Maybe BS
BS
domDoctypeSystemID :: Maybe BS
domDoctypePublicID :: Maybe BS
domDoctypeName :: BS
domDoctypeParent :: DOMID
domDoctypeID :: DOMID
domDoctypeSystemID :: DOMNode -> Maybe BS
domDoctypePublicID :: DOMNode -> Maybe BS
domDoctypeName :: DOMNode -> BS
domDoctypeParent :: DOMNode -> DOMID
domDoctypeID :: DOMNode -> DOMID
..}  -> DOMID
domDoctypeID
  DOMFragment{DOMID
BS
Seq DOMID
domFragmentChildren :: Seq DOMID
domFragmentName :: BS
domFragmentParent :: DOMID
domFragmentID :: DOMID
domFragmentChildren :: DOMNode -> Seq DOMID
domFragmentName :: DOMNode -> BS
domFragmentParent :: DOMNode -> DOMID
domFragmentID :: DOMNode -> DOMID
..} -> DOMID
domFragmentID
  DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..}  -> DOMID
domElementID
  DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} -> DOMID
domTemplateID
  DOMText{DOMID
BS
domTextData :: BS
domTextParent :: DOMID
domTextID :: DOMID
domTextData :: DOMNode -> BS
domTextParent :: DOMNode -> DOMID
domTextID :: DOMNode -> DOMID
..}     -> DOMID
domTextID
  DOMComment{DOMID
BS
domCommentData :: BS
domCommentParent :: DOMID
domCommentID :: DOMID
domCommentData :: DOMNode -> BS
domCommentParent :: DOMNode -> DOMID
domCommentID :: DOMNode -> DOMID
..}  -> DOMID
domCommentID

-- | Gets the parent for a node.
domNodeParent :: DOMNode -> DOMID
domNodeParent :: DOMNode -> DOMID
domNodeParent = \case
  DOMDocument{DOMID
BS
Seq DOMID
DOMQuirks
domDocumentQuirksMode :: DOMQuirks
domDocumentChildren :: Seq DOMID
domDocumentName :: BS
domDocumentParent :: DOMID
domDocumentID :: DOMID
domDocumentQuirksMode :: DOMNode -> DOMQuirks
domDocumentChildren :: DOMNode -> Seq DOMID
domDocumentName :: DOMNode -> BS
domDocumentParent :: DOMNode -> DOMID
domDocumentID :: DOMNode -> DOMID
..} -> DOMID
domDocumentParent
  DOMDoctype{DOMID
Maybe BS
BS
domDoctypeSystemID :: Maybe BS
domDoctypePublicID :: Maybe BS
domDoctypeName :: BS
domDoctypeParent :: DOMID
domDoctypeID :: DOMID
domDoctypeSystemID :: DOMNode -> Maybe BS
domDoctypePublicID :: DOMNode -> Maybe BS
domDoctypeName :: DOMNode -> BS
domDoctypeParent :: DOMNode -> DOMID
domDoctypeID :: DOMNode -> DOMID
..}  -> DOMID
domDoctypeParent
  DOMFragment{DOMID
BS
Seq DOMID
domFragmentChildren :: Seq DOMID
domFragmentName :: BS
domFragmentParent :: DOMID
domFragmentID :: DOMID
domFragmentChildren :: DOMNode -> Seq DOMID
domFragmentName :: DOMNode -> BS
domFragmentParent :: DOMNode -> DOMID
domFragmentID :: DOMNode -> DOMID
..} -> DOMID
domFragmentParent
  DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..}  -> DOMID
domElementParent
  DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} -> DOMID
domTemplateParent
  DOMText{DOMID
BS
domTextData :: BS
domTextParent :: DOMID
domTextID :: DOMID
domTextData :: DOMNode -> BS
domTextParent :: DOMNode -> DOMID
domTextID :: DOMNode -> DOMID
..}     -> DOMID
domTextParent
  DOMComment{DOMID
BS
domCommentData :: BS
domCommentParent :: DOMID
domCommentID :: DOMID
domCommentData :: DOMNode -> BS
domCommentParent :: DOMNode -> DOMID
domCommentID :: DOMNode -> DOMID
..}  -> DOMID
domCommentParent

-- | Detmermines if a node is in the HTML namespace.
domNodeIsHTML :: DOMNode -> Bool
domNodeIsHTML :: DOMNode -> Bool
domNodeIsHTML = \case
  DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..}  -> HTMLNamespace
domElementNamespace forall a. Eq a => a -> a -> Bool
== HTMLNamespace
HTMLNamespaceHTML
  DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} -> HTMLNamespace
domTemplateNamespace forall a. Eq a => a -> a -> Bool
== HTMLNamespace
HTMLNamespaceHTML
  DOMNode
_otherwise      -> Bool
False

-- | Detmermines if a node is in the SVG namespace.
domNodeIsSVG :: DOMNode -> Bool
domNodeIsSVG :: DOMNode -> Bool
domNodeIsSVG = \case
  DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..}  -> HTMLNamespace
domElementNamespace forall a. Eq a => a -> a -> Bool
== HTMLNamespace
HTMLNamespaceSVG
  DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} -> HTMLNamespace
domTemplateNamespace forall a. Eq a => a -> a -> Bool
== HTMLNamespace
HTMLNamespaceSVG
  DOMNode
_otherwise      -> Bool
False

-- | Detmermines if a node is in the MathML namespace.
domNodeIsMathML :: DOMNode -> Bool
domNodeIsMathML :: DOMNode -> Bool
domNodeIsMathML = \case
  DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..}  -> HTMLNamespace
domElementNamespace forall a. Eq a => a -> a -> Bool
== HTMLNamespace
HTMLNamespaceMathML
  DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} -> HTMLNamespace
domTemplateNamespace forall a. Eq a => a -> a -> Bool
== HTMLNamespace
HTMLNamespaceMathML
  DOMNode
_otherwise      -> Bool
False

-- | Detmermines if a node is a document node.
domNodeIsDocument :: DOMNode -> Bool
domNodeIsDocument :: DOMNode -> Bool
domNodeIsDocument DOMDocument{} = Bool
True
domNodeIsDocument DOMNode
_ = Bool
False

-- | Detmermines if a node is a document fragment node.
domNodeIsFragment :: DOMNode -> Bool
domNodeIsFragment :: DOMNode -> Bool
domNodeIsFragment DOMFragment{} = Bool
True
domNodeIsFragment DOMNode
_ = Bool
False

-- | Detmermines if a node is an element node.
domNodeIsElement :: DOMNode -> Bool
domNodeIsElement :: DOMNode -> Bool
domNodeIsElement DOMElement{} = Bool
True
domNodeIsElement DOMNode
_ = Bool
False

-- | Detmermines if a node is a template node.
domNodeIsTemplate :: DOMNode -> Bool
domNodeIsTemplate :: DOMNode -> Bool
domNodeIsTemplate DOMTemplate{} = Bool
True
domNodeIsTemplate DOMNode
_ = Bool
False

-- | Detmermines if a node is an HTML element node.
domNodeIsHtmlElement :: DOMNode -> Bool
domNodeIsHtmlElement :: DOMNode -> Bool
domNodeIsHtmlElement DOMNode
x = DOMNode -> Bool
domNodeIsElement DOMNode
x Bool -> Bool -> Bool
&& DOMNode -> Bool
domNodeIsHTML DOMNode
x

-- | Detmermines if a node is a text node.
domNodeIsText :: DOMNode -> Bool
domNodeIsText :: DOMNode -> Bool
domNodeIsText DOMText{} = Bool
True
domNodeIsText DOMNode
_ = Bool
False

-- | Gets the name for an element node.
domNodeElementName :: DOMNode -> BS
domNodeElementName :: DOMNode -> BS
domNodeElementName DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..} = BS
domElementName
domNodeElementName DOMTemplate{} = BS
"template"
domNodeElementName DOMNode
_ = BS
""

-- | Gets the name for an element node.
domNodeElementNamespace :: DOMNode -> HTMLNamespace
domNodeElementNamespace :: DOMNode -> HTMLNamespace
domNodeElementNamespace DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..} = HTMLNamespace
domElementNamespace
domNodeElementNamespace DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} = HTMLNamespace
domTemplateNamespace
domNodeElementNamespace DOMNode
_ = HTMLNamespace
HTMLNamespaceHTML

-- | Gets the type for an element node.
domNodeType :: DOMNode -> DOMType
domNodeType :: DOMNode -> DOMType
domNodeType DOMNode
x = BS -> HTMLNamespace -> DOMType
DOMType (DOMNode -> BS
domNodeElementName DOMNode
x) (DOMNode -> HTMLNamespace
domNodeElementNamespace DOMNode
x)

-- | Gets a list of HTML types for element names.
domTypesHTML :: [BS] -> [DOMType]
domTypesHTML :: [BS] -> [DOMType]
domTypesHTML = forall a b. (a -> b) -> [a] -> [b]
map BS -> DOMType
domMakeTypeHTML

-- | Gets a list of MathML types for element names.
domTypesMathML :: [BS] -> [DOMType]
domTypesMathML :: [BS] -> [DOMType]
domTypesMathML = forall a b. (a -> b) -> [a] -> [b]
map BS -> DOMType
domMakeTypeMathML

-- | Gets a list of SVG types for element names.
domTypesSVG :: [BS] -> [DOMType]
domTypesSVG :: [BS] -> [DOMType]
domTypesSVG = forall a b. (a -> b) -> [a] -> [b]
map BS -> DOMType
domMakeTypeSVG

-- | Renders the DOM.
domRender :: DOM -> BS
domRender :: DOM -> BS
domRender DOM
d = DOM -> DOMID -> DOMID -> BS
domRenderIndent DOM
d DOMID
0 DOMID
domRoot

-- | Renders the DOM with indentaion.
domRenderIndent :: DOM -> Int -> DOMID -> BS
domRenderIndent :: DOM -> DOMID -> DOMID -> BS
domRenderIndent DOM
d DOMID
x DOMID
y =
  case forall a. HasCallStack => Maybe a -> a
fromJust (DOM -> DOMID -> Maybe DOMNode
domGetNode DOM
d DOMID
y) of
    DOMDocument{DOMID
BS
Seq DOMID
DOMQuirks
domDocumentQuirksMode :: DOMQuirks
domDocumentChildren :: Seq DOMID
domDocumentName :: BS
domDocumentParent :: DOMID
domDocumentID :: DOMID
domDocumentQuirksMode :: DOMNode -> DOMQuirks
domDocumentChildren :: DOMNode -> Seq DOMID
domDocumentName :: DOMNode -> BS
domDocumentParent :: DOMNode -> DOMID
domDocumentID :: DOMNode -> DOMID
..} ->
      [BS] -> BS
bsConcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (DOM -> DOMID -> DOMID -> BS
domRenderIndent DOM
d DOMID
x) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq DOMID
domDocumentChildren
    DOMDoctype{} ->
      BS
bsEmpty
    DOMFragment{DOMID
BS
Seq DOMID
domFragmentChildren :: Seq DOMID
domFragmentName :: BS
domFragmentParent :: DOMID
domFragmentID :: DOMID
domFragmentChildren :: DOMNode -> Seq DOMID
domFragmentName :: DOMNode -> BS
domFragmentParent :: DOMNode -> DOMID
domFragmentID :: DOMNode -> DOMID
..} ->
      [BS] -> BS
bsConcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (DOM -> DOMID -> DOMID -> BS
domRenderIndent DOM
d DOMID
x) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq DOMID
domFragmentChildren
    DOMElement{DOMID
BS
Seq DOMID
Seq DOMAttr
HTMLNamespace
domElementChildren :: Seq DOMID
domElementAttributes :: Seq DOMAttr
domElementNamespace :: HTMLNamespace
domElementName :: BS
domElementParent :: DOMID
domElementID :: DOMID
domElementChildren :: DOMNode -> Seq DOMID
domElementAttributes :: DOMNode -> Seq DOMAttr
domElementNamespace :: DOMNode -> HTMLNamespace
domElementName :: DOMNode -> BS
domElementParent :: DOMNode -> DOMID
domElementID :: DOMNode -> DOMID
..} ->
      [BS] -> BS
bsConcat
        [ BS
indent
        , BS
domElementName
        , BS
"\n"
        , [BS] -> BS
bsConcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (DOM -> DOMID -> DOMID -> BS
domRenderIndent DOM
d forall a b. (a -> b) -> a -> b
$ DOMID
x forall a. Num a => a -> a -> a
+ DOMID
1) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq DOMID
domElementChildren
        ]
    DOMTemplate{DOMID
Seq DOMAttr
HTMLNamespace
domTemplateContents :: DOMID
domTemplateAttributes :: Seq DOMAttr
domTemplateNamespace :: HTMLNamespace
domTemplateParent :: DOMID
domTemplateID :: DOMID
domTemplateContents :: DOMNode -> DOMID
domTemplateAttributes :: DOMNode -> Seq DOMAttr
domTemplateNamespace :: DOMNode -> HTMLNamespace
domTemplateParent :: DOMNode -> DOMID
domTemplateID :: DOMNode -> DOMID
..} ->
      [BS] -> BS
bsConcat
        [ BS
indent
        , BS
"template"
        , BS
"\n"
        , DOM -> DOMID -> DOMID -> BS
domRenderIndent DOM
d (DOMID
x forall a. Num a => a -> a -> a
+ DOMID
1) DOMID
domTemplateContents
        ]
    DOMText{DOMID
BS
domTextData :: BS
domTextParent :: DOMID
domTextID :: DOMID
domTextData :: DOMNode -> BS
domTextParent :: DOMNode -> DOMID
domTextID :: DOMNode -> DOMID
..} ->
      [BS] -> BS
bsConcat
        [ BS
indent
        , BS
domTextData
        , BS
"\n"
        ]
    DOMComment{} ->
      BS
bsEmpty
  where
    indent :: BS
indent = [Word8] -> BS
bsPack forall a b. (a -> b) -> a -> b
$ forall a. DOMID -> [a] -> [a]
take DOMID
x forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat Word8
0x20