{-#LANGUAGE GeneralizedNewtypeDeriving #-}
{-#LANGUAGE StandaloneDeriving #-}
module Text.Tamper.DOM
( module Text.Tamper.DOM.AttribList
, NodeList
, nodeList, unNodeList
, singletonNodeList
, ElementClosingStyle (..)
, Node (..)
, documentNode
, elementNode
, textNode
, cdataNode
, commentNode
, rawHtmlNode
, setAttr
, getAttr, getAttrDef
, appendChildren, appendChild
)
where

import Data.Monoid
import Data.Maybe
import Safe
import Text.Tamper.DOM.AttribList

-- | A list of DOM nodes.
newtype NodeList t = NodeList { unNodeList :: [Node t] }
    deriving (Monoid)

deriving instance (Show t) => Show (NodeList t)
deriving instance (Eq t) => Eq (NodeList t)
deriving instance (Ord t) => Ord (NodeList t)

singletonNodeList :: Node t -> NodeList t
singletonNodeList node = NodeList [node]

nodeList :: [Node t] -> NodeList t
nodeList = NodeList

data ElementClosingStyle
        = SingletonElement -- ^ Always self-close
        | ElaborateElement -- ^ Never self-close
        | AutoClosingElement -- ^ Self-close if no content
    deriving (Ord, Eq, Enum, Show)

data Node t = Document (NodeList t)
            | Element { elementName :: t, attribs :: AttribList t, elementContent :: NodeList t, elementClosingStyle :: ElementClosingStyle }
            | TextNode { textContent :: t }
            | CDataSection { cdataContent :: t }
            | Comment { commentText :: t }
            | RawHtml { htmlContent :: t }

deriving instance (Show t) => Show (Node t)
deriving instance (Eq t) => Eq (Node t)
deriving instance (Ord t) => Ord (Node t)

documentNode :: (Ord t) => Node t
documentNode = Document mempty

elementNode :: (Ord t) => t -> ElementClosingStyle -> Node t
elementNode tn cs = Element tn mempty mempty cs

textNode :: t -> Node t
textNode = TextNode

cdataNode :: t -> Node t
cdataNode = CDataSection

commentNode :: t -> Node t
commentNode = Comment

rawHtmlNode :: t -> Node t
rawHtmlNode = RawHtml

setAttr :: (Ord t) => t -> t -> Node t -> Node t
setAttr name value (elem@Element { attribs = a }) =
    elem { attribs = attribInsert name value a }
setAttr _ _ x = x -- If it's not an Element, we can't set any attributes

getAttr :: (Ord t) => t -> Node t -> Maybe t
getAttr name (Element { attribs = a }) =
    attribLookup name a
getAttr _ _ = Nothing

getAttrDef :: (Ord t) => t -> t -> Node t -> t
getAttrDef name def e = fromMaybe def $ getAttr name e

appendChildren :: NodeList t -> Node t -> Node t
appendChildren appendees (Document children) = Document $ children <> appendees
appendChildren appendees (elem@Element { elementContent = children }) = elem { elementContent = children <> appendees }
appendChildren _ n = n

appendChild :: Node t -> Node t -> Node t
appendChild child = appendChildren (NodeList [child])