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

    {- |
       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

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