-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.DOM.XmlNode
   Copyright  : Copyright (C) 2008 Uwe Schmidt
   License    : MIT


   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   Interface for XmlArrow to basic data types NTree and XmlTree

   If this module must be used in code working with arrows,
   it should be imported qualified e.g. @as XN@, to prevent name clashes.

   For code working on the \"node and tree level\" this module
   is the interface for writing code without using the
   constructor functions of 'XNode' and 'NTree' directly

-}

-- ------------------------------------------------------------

module Text.XML.HXT.DOM.XmlNode
    ( module Text.XML.HXT.DOM.XmlNode
    , module Data.Tree.NTree.TypeDefs
    )
where

import Control.Monad

import Data.Tree.NTree.TypeDefs

import Data.Maybe

import Text.XML.HXT.DOM.Interface

class XmlNode a where
    -- discriminating predicates

    isText		:: a -> Bool
    isCharRef		:: a -> Bool
    isEntityRef		:: a -> Bool
    isCmt		:: a -> Bool
    isCdata		:: a -> Bool
    isPi		:: a -> Bool
    isElem		:: a -> Bool
    isRoot		:: a -> Bool
    isDTD		:: a -> Bool
    isAttr		:: a -> Bool
    isError		:: a -> Bool

    -- constructor functions for leave nodes

    mkText		:: String -> a
    mkCharRef		:: Int    -> a
    mkEntityRef		:: String -> a
    mkCmt		:: String -> a
    mkCdata		:: String -> a
    mkPi		:: QName  -> XmlTrees -> a
    mkError		:: Int    -> String   -> a

    -- selectors

    getText		:: a -> Maybe String
    getCharRef		:: a -> Maybe Int
    getEntityRef	:: a -> Maybe String
    getCmt		:: a -> Maybe String
    getCdata		:: a -> Maybe String
    getPiName		:: a -> Maybe QName
    getPiContent	:: a -> Maybe XmlTrees
    getElemName		:: a -> Maybe QName
    getAttrl		:: a -> Maybe XmlTrees
    getDTDPart		:: a -> Maybe DTDElem
    getDTDAttrl		:: a -> Maybe Attributes
    getAttrName		:: a -> Maybe QName
    getErrorLevel	:: a -> Maybe Int
    getErrorMsg		:: a -> Maybe String

    -- derived selectors

    getName		:: a -> Maybe QName
    getQualifiedName	:: a -> Maybe String
    getUniversalName	:: a -> Maybe String
    getUniversalUri	:: a -> Maybe String
    getLocalPart	:: a -> Maybe String
    getNamePrefix	:: a -> Maybe String
    getNamespaceUri	:: a -> Maybe String

    -- "modifier" functions

    changeText		:: (String   -> String)   -> a -> a
    changeCmt		:: (String   -> String)   -> a -> a
    changeName		:: (QName    -> QName)    -> a -> a
    changeElemName	:: (QName    -> QName)    -> a -> a
    changeAttrl		:: (XmlTrees -> XmlTrees) -> a -> a
    changeAttrName	:: (QName    -> QName)    -> a -> a
    changePiName	:: (QName    -> QName)    -> a -> a
    changeDTDAttrl	:: (Attributes -> Attributes) -> a -> a

    setText		:: String   -> a -> a
    setCmt		:: String   -> a -> a
    setName		:: QName    -> a -> a
    setElemName		:: QName    -> a -> a
    setElemAttrl	:: XmlTrees -> a -> a
    setAttrName		:: QName    -> a -> a
    setPiName		:: QName    -> a -> a
    setDTDAttrl		:: Attributes -> a -> a

    -- default implementations

    getName n		= getElemName n `mplus` getAttrName n `mplus` getPiName n
    getQualifiedName n	= getName n >>= \ n' -> return (qualifiedName n')
    getUniversalName n	= getName n >>= \ n' -> return (universalName n')
    getUniversalUri n	= getName n >>= \ n' -> return (universalUri n')
    getLocalPart n	= getName n >>= \ n' -> return (localPart n')
    getNamePrefix n	= getName n >>= \ n' -> return (namePrefix n')
    getNamespaceUri n	= getName n >>= \ n' -> return (namespaceUri n')

    setText t		= changeText     (const t)
    setCmt c		= changeCmt      (const c)
    setName n		= changeName     (const n)
    setElemName n	= changeElemName (const n)
    setElemAttrl al	= changeAttrl    (const al)
    setAttrName	n	= changeAttrName (const n)
    setPiName	n	= changePiName   (const n)
    setDTDAttrl	al	= changeDTDAttrl (const al)

-- XNode and XmlTree are instances of XmlNode

instance XmlNode XNode where
    isText (XText _)		= True
    isText _			= False

    isCharRef (XCharRef _)	= True
    isCharRef _			= False

    isEntityRef (XEntityRef _)	= True
    isEntityRef _		= False

    isCmt (XCmt _)		= True
    isCmt _			= False

    isCdata (XCdata _)		= True
    isCdata _			= False

    isPi (XPi _ _)		= True
    isPi _			= False

    isElem (XTag _ _)		= True
    isElem _			= False

    isRoot t                    = isElem t
				  &&
				  fromMaybe "" (getQualifiedName t) == t_root

    isDTD (XDTD _ _)		= True
    isDTD _			= False

    isAttr (XAttr _)		= True
    isAttr _			= False

    isError (XError _ _)	= True
    isError _			= False


    mkText t			= XText t
    mkCharRef c			= XCharRef c
    mkEntityRef e		= XEntityRef e
    mkCmt c			= XCmt c
    mkCdata d			= XCdata d
    mkPi n c			= XPi n (if null c then [] else [mkAttr (mkName a_value) c])
    mkError l msg		= XError l msg


    getText (XText t)		= Just t
    getText _			= Nothing

    getCharRef (XCharRef c)	= Just c
    getCharRef _		= Nothing

    getEntityRef (XEntityRef e)	= Just e
    getEntityRef _		= Nothing

    getCmt (XCmt c)		= Just c
    getCmt _			= Nothing

    getCdata (XCdata d)		= Just d
    getCdata _			= Nothing

    getPiName (XPi n _)		= Just n
    getPiName _			= Nothing

    getPiContent (XPi _ c)	= Just c
    getPiContent _		= Nothing

    getElemName (XTag n _)	= Just n
    getElemName _		= Nothing

    getAttrl (XTag _ al)	= Just al
    getAttrl (XPi  _ al)	= Just al
    getAttrl _			= Nothing

    getDTDPart (XDTD p _)	= Just p
    getDTDPart _		= Nothing

    getDTDAttrl (XDTD _ al)	= Just al
    getDTDAttrl _		= Nothing

    getAttrName (XAttr n)	= Just n
    getAttrName _		= Nothing

    getErrorLevel (XError l _)	= Just l
    getErrorLevel _		= Nothing

    getErrorMsg (XError _ m)	= Just m
    getErrorMsg _		= Nothing

    changeText cf (XText t)		= XText (cf t)
    changeText _ _			= error "changeText undefined"

    changeCmt cf (XCmt c)		= XCmt (cf c)
    changeCmt _ _			= error "changeCmt undefined"

    changeName cf (XTag n al)		= XTag (cf n) al
    changeName cf (XAttr n)		= XAttr (cf n)
    changeName cf (XPi n al)		= XPi (cf n) al
    changeName _ _			= error "changeName undefined"

    changeElemName cf (XTag n al)	= XTag (cf n) al
    changeElemName _ _			= error "changeElemName undefined"

    changeAttrl cf (XTag n al)		= XTag n (cf al)
    changeAttrl cf (XPi  n al)		= XPi  n (cf al)
    changeAttrl _ _			= error "changeAttrl undefined"

    changeAttrName cf (XAttr n)		= XAttr (cf n)
    changeAttrName _ _			= error "changeAttrName undefined"

    changePiName cf (XPi n al)		= XPi (cf n) al
    changePiName _ _			= error "changeAttrName undefined"

    changeDTDAttrl cf (XDTD p al)	= XDTD p (cf al)
    changeDTDAttrl _ _			= error "changeDTDAttrl undefined"

mkElementNode	:: QName -> XmlTrees -> XNode
mkElementNode	= XTag

mkAttrNode	:: QName -> XNode
mkAttrNode	= XAttr

mkDTDNode	:: DTDElem -> Attributes -> XNode
mkDTDNode	= XDTD

instance XmlNode a => XmlNode (NTree a) where
    isText		= isText      . getNode
    isCharRef		= isCharRef   . getNode
    isEntityRef		= isEntityRef . getNode
    isCmt		= isCmt       . getNode
    isCdata		= isCdata     . getNode
    isPi		= isPi        . getNode
    isElem		= isElem      . getNode
    isRoot		= isRoot      . getNode
    isDTD		= isDTD       . getNode
    isAttr		= isAttr      . getNode
    isError		= isError     . getNode

    mkText		= mkLeaf . mkText
    mkCharRef		= mkLeaf . mkCharRef
    mkEntityRef		= mkLeaf . mkEntityRef
    mkCmt		= mkLeaf . mkCmt
    mkCdata		= mkLeaf . mkCdata
    mkPi n		= mkLeaf . mkPi n
    mkError l		= mkLeaf . mkError l

    getText		= getText       . getNode
    getCharRef		= getCharRef    . getNode
    getEntityRef	= getEntityRef  . getNode
    getCmt		= getCmt        . getNode
    getCdata		= getCdata      . getNode
    getPiName		= getPiName     . getNode
    getPiContent	= getPiContent  . getNode
    getElemName		= getElemName   . getNode
    getAttrl		= getAttrl      . getNode
    getDTDPart		= getDTDPart    . getNode
    getDTDAttrl		= getDTDAttrl   . getNode
    getAttrName		= getAttrName   . getNode
    getErrorLevel	= getErrorLevel . getNode
    getErrorMsg		= getErrorMsg   . getNode

    changeText cf	= changeNode (changeText cf)
    changeCmt cf	= changeNode (changeCmt  cf)
    changeName cf	= changeNode (changeName cf)
    changeElemName cf	= changeNode (changeElemName cf)
    changeAttrl cf	= changeNode (changeAttrl cf)
    changeAttrName cf	= changeNode (changeAttrName cf)
    changePiName cf	= changeNode (changePiName cf)
    changeDTDAttrl cf	= changeNode (changeDTDAttrl cf)

mkElement	:: QName -> XmlTrees -> XmlTrees -> XmlTree
mkElement n al	= mkTree (mkElementNode n al)

mkRoot		:: XmlTrees -> XmlTrees -> XmlTree
mkRoot al	= mkTree (mkElementNode (mkName t_root) al)

mkAttr		:: QName -> XmlTrees -> XmlTree
mkAttr n	= mkTree (mkAttrNode n)

mkDTDElem	:: DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem e al	= mkTree (mkDTDNode e al)

addAttr		:: XmlTree -> XmlTrees -> XmlTrees
addAttr a al
    | isAttr a	= add al
    | otherwise	= al
    where
    an = (qualifiedName . fromJust . getAttrName) a
    add []
	= [a]
    add (a1:al1)
	| isAttr a1
	  &&
	  (qualifiedName . fromJust . getAttrName) a1 == an
	    = a : al1
	| otherwise
	    = a1 : add al1

mergeAttrl	:: XmlTrees -> XmlTrees -> XmlTrees
mergeAttrl 	= foldr addAttr

-- ------------------------------------------------------------