content: {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}
  
  -- ------------------------------------------------------------
  
  {- |
     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.Class
      , module Data.Tree.NTree.TypeDefs
      )
  where
  
  import Control.Monad
  import Control.FlatSeq
  
  import Data.Function            ( on )
  import Data.Maybe               ( fromMaybe
                                  , fromJust
                                  )
  import Data.Tree.Class
  import Data.Tree.NTree.TypeDefs
  
  
  import Text.XML.HXT.DOM.Interface
  
  class XmlNode a where
      -- discriminating predicates
  
      isText              :: a -> Bool
      isBlob              :: 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
      mkBlob              :: Blob   -> 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
      getBlob             :: a -> Maybe Blob
      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
      changeBlob          :: (Blob     -> Blob)     -> 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
      setBlob             :: Blob     -> 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 >>= return . qualifiedName
      getUniversalName n  = getName n >>= return . universalName
      getUniversalUri n   = getName n >>= return . universalUri
      getLocalPart n      = getName n >>= return . localPart
      getNamePrefix n     = getName n >>= return . namePrefix
      getNamespaceUri n   = getName n >>= return . namespaceUri
  
      setText             = changeText     . const
      setBlob             = changeBlob     . const
      setCmt              = changeCmt      . const
      setName             = changeName     . const
      setElemName         = changeElemName . const
      setElemAttrl        = changeAttrl    . const
      setAttrName         = changeAttrName . const
      setPiName           = changePiName   . const
      setDTDAttrl         = changeDTDAttrl . const
  
  -- XNode and XmlTree are instances of XmlNode
  
  instance XmlNode XNode where
      isText (XText _)            = True
      isText (XBlob _)            = True
      isText _                    = False
      {-# INLINE isText #-}
  
      isBlob (XBlob _)            = True
      isBlob _                    = False
      {-# INLINE isBlob #-}
  
      isCharRef (XCharRef _)      = True
      isCharRef _                 = False
      {-# INLINE isCharRef #-}
  
      isEntityRef (XEntityRef _)  = True
      isEntityRef _               = False
      {-# INLINE isEntityRef #-}
  
      isCmt (XCmt _)              = True
      isCmt _                     = False
      {-# INLINE isCmt #-}
  
      isCdata (XCdata _)          = True
      isCdata _                   = False
      {-# INLINE isCdata #-}
  
      isPi (XPi _ _)              = True
      isPi _                      = False
      {-# INLINE isPi #-}
  
      isElem (XTag _ _)           = True
      isElem _                    = False
      {-# INLINE isElem #-}
  
      isRoot t                    = isElem t
                                    &&
                                    fromMaybe "" (getQualifiedName t) == t_root
  
      isDTD (XDTD _ _)            = True
      isDTD _                     = False
      {-# INLINE isDTD #-}
  
      isAttr (XAttr _)            = True
      isAttr _                    = False
      {-# INLINE isAttr #-}
  
      isError (XError _ _)        = True
      isError _                   = False
      {-# INLINE isError #-}
  
  
      mkText                      = XText
      {-# INLINE mkText #-}
      mkBlob                      = XBlob
      {-# INLINE mkBlob #-}
      mkCharRef                   = XCharRef
      {-# INLINE mkCharRef #-}
      mkEntityRef                 = XEntityRef
      {-# INLINE mkEntityRef #-}
      mkCmt                       = XCmt
      {-# INLINE mkCmt #-}
      mkCdata                     = XCdata
      {-# INLINE mkCdata #-}
      mkPi                        = XPi
      {-# INLINE mkPi #-}
  
      mkError                     = XError
      {-# INLINE mkError #-}
  
  
      getText (XText t)           = Just   t
      getText (XBlob b)           = Just . blobToString $ b
      getText _                   = Nothing
      {-# INLINE getText #-}
  
      getBlob (XBlob b)           = Just b
      getBlob _                   = Nothing
      {-# INLINE getBlob #-}
  
      getCharRef (XCharRef c)     = Just c
      getCharRef _                = Nothing
      {-# INLINE getCharRef #-}
  
      getEntityRef (XEntityRef e) = Just e
      getEntityRef _              = Nothing
      {-# INLINE getEntityRef #-}
  
      getCmt (XCmt c)             = Just c
      getCmt _                    = Nothing
      {-# INLINE getCmt #-}
  
      getCdata (XCdata d)         = Just d
      getCdata _                  = Nothing
      {-# INLINE getCdata #-}
  
      getPiName (XPi n _)         = Just n
      getPiName _                 = Nothing
      {-# INLINE getPiName #-}
  
      getPiContent (XPi _ c)      = Just c
      getPiContent _              = Nothing
      {-# INLINE getPiContent #-}
  
      getElemName (XTag n _)      = Just n
      getElemName _               = Nothing
      {-# INLINE getElemName #-}
  
      getAttrl (XTag _ al)        = Just al
      getAttrl (XPi  _ al)        = Just al
      getAttrl _                  = Nothing
      {-# INLINE getAttrl #-}
  
      getDTDPart (XDTD p _)       = Just p
      getDTDPart _                = Nothing
      {-# INLINE getDTDPart #-}
  
      getDTDAttrl (XDTD _ al)     = Just al
      getDTDAttrl _               = Nothing
      {-# INLINE getDTDAttrl #-}
  
      getAttrName (XAttr n)       = Just n
      getAttrName _               = Nothing
      {-# INLINE getAttrName #-}
  
      getErrorLevel (XError l _)  = Just l
      getErrorLevel _             = Nothing
      {-# INLINE getErrorLevel #-}
  
      getErrorMsg (XError _ m)    = Just m
      getErrorMsg _               = Nothing
      {-# INLINE getErrorMsg #-}
  
      changeText cf (XText t)             = XText . cf $ t
      changeText cf (XBlob b)             = XText . cf . blobToString $ b
      changeText _ _                      = error "changeText undefined"
      {-# INLINE changeText #-}
  
      changeBlob cf (XBlob b)             = XBlob . cf $ b
      changeBlob _ _                      = error "changeBlob undefined"
      {-# INLINE changeBlob #-}
  
      changeCmt cf (XCmt c)               = XCmt  . cf $ c
      changeCmt _ _                       = error "changeCmt undefined"
      {-# INLINE changeCmt #-}
  
      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"
      {-# INLINE changeName #-}
  
      changeElemName cf (XTag n al)       = XTag   (cf n) al
      changeElemName _ _                  = error "changeElemName undefined"
      {-# INLINE changeElemName #-}
  
      changeAttrl cf (XTag n al)          = XTag n (cf al)
      changeAttrl cf (XPi  n al)          = XPi  n (cf al)
      changeAttrl _ _                     = error "changeAttrl undefined"
      {-# INLINE changeAttrl #-}
  
      changeAttrName cf (XAttr n)         = XAttr . cf $ n
      changeAttrName _ _                  = error "changeAttrName undefined"
      {-# INLINE changeAttrName #-}
  
      changePiName cf (XPi n al)          = XPi    (cf n) al
      changePiName _ _                    = error "changePiName undefined"
      {-# INLINE changePiName #-}
  
      changeDTDAttrl cf (XDTD p al)       = XDTD p (cf al)
      changeDTDAttrl _ _                  = error "changeDTDAttrl undefined"
      {-# INLINE changeDTDAttrl #-}
  
  mkElementNode   :: QName -> XmlTrees -> XNode
  mkElementNode   = XTag
  {-# INLINE mkElementNode #-}
  
  mkAttrNode      :: QName -> XNode
  mkAttrNode      = XAttr
  {-# INLINE mkAttrNode #-}
  
  mkDTDNode       :: DTDElem -> Attributes -> XNode
  mkDTDNode       = XDTD
  {-# INLINE mkDTDNode #-}
  
  instance (XmlNode a, Tree t) => XmlNode (t a) where
      isText              = isText      . getNode
      {-# INLINE isText #-}
      isBlob              = isBlob      . getNode
      {-# INLINE isBlob #-}
      isCharRef           = isCharRef   . getNode
      {-# INLINE isCharRef #-}
      isEntityRef         = isEntityRef . getNode
      {-# INLINE isEntityRef #-}
      isCmt               = isCmt       . getNode
      {-# INLINE isCmt #-}
      isCdata             = isCdata     . getNode
      {-# INLINE isCdata #-}
      isPi                = isPi        . getNode
      {-# INLINE isPi #-}
      isElem              = isElem      . getNode
      {-# INLINE isElem #-}
      isRoot              = isRoot      . getNode
      {-# INLINE isRoot #-}
      isDTD               = isDTD       . getNode
      {-# INLINE isDTD #-}
      isAttr              = isAttr      . getNode
      {-# INLINE isAttr #-}
      isError             = isError     . getNode
      {-# INLINE isError #-}
  
      mkText              = mkLeaf . mkText
      {-# INLINE mkText #-}
      mkBlob              = mkLeaf . mkBlob
      {-# INLINE mkBlob #-}
      mkCharRef           = mkLeaf . mkCharRef
      {-# INLINE mkCharRef #-}
      mkEntityRef         = mkLeaf . mkEntityRef
      {-# INLINE mkEntityRef #-}
      mkCmt               = mkLeaf . mkCmt
      {-# INLINE mkCmt #-}
      mkCdata             = mkLeaf . mkCdata
      {-# INLINE mkCdata #-}
      mkPi n              = mkLeaf . mkPi n
      {-# INLINE mkPi #-}
      mkError l           = mkLeaf . mkError l
      {-# INLINE mkError #-}
  
      getText             = getText       . getNode
      {-# INLINE getText #-}
      getBlob             = getBlob       . getNode
      {-# INLINE getBlob #-}
      getCharRef          = getCharRef    . getNode
      {-# INLINE getCharRef #-}
      getEntityRef        = getEntityRef  . getNode
      {-# INLINE getEntityRef #-}
      getCmt              = getCmt        . getNode
      {-# INLINE getCmt #-}
      getCdata            = getCdata      . getNode
      {-# INLINE getCdata #-}
      getPiName           = getPiName     . getNode
      {-# INLINE getPiName #-}
      getPiContent        = getPiContent  . getNode
      {-# INLINE getPiContent #-}
      getElemName         = getElemName   . getNode
      {-# INLINE getElemName #-}
      getAttrl            = getAttrl      . getNode
      {-# INLINE getAttrl #-}
      getDTDPart          = getDTDPart    . getNode
      {-# INLINE getDTDPart #-}
      getDTDAttrl         = getDTDAttrl   . getNode
      {-# INLINE getDTDAttrl #-}
      getAttrName         = getAttrName   . getNode
      {-# INLINE getAttrName #-}
      getErrorLevel       = getErrorLevel . getNode
      {-# INLINE getErrorLevel #-}
      getErrorMsg         = getErrorMsg   . getNode
      {-# INLINE getErrorMsg #-}
  
      changeText          = changeNode . changeText
      {-# INLINE changeText #-}
      changeBlob          = changeNode . changeBlob
      {-# INLINE changeBlob #-}
      changeCmt           = changeNode . changeCmt
      {-# INLINE changeCmt #-}
      changeName          = changeNode . changeName
      {-# INLINE changeName #-}
      changeElemName      = changeNode . changeElemName
      {-# INLINE changeElemName #-}
      changeAttrl         = changeNode . changeAttrl
      {-# INLINE changeAttrl #-}
      changeAttrName      = changeNode . changeAttrName
      {-# INLINE changeAttrName #-}
      changePiName        = changeNode . changePiName
      {-# INLINE changePiName #-}
      changeDTDAttrl      = changeNode . changeDTDAttrl
      {-# INLINE changeDTDAttrl #-}
  
  mkElement       :: QName -> XmlTrees -> XmlTrees -> XmlTree
  mkElement n al  = mkTree (mkElementNode n al)
  {-# INLINE mkElement #-}
  
  mkRoot          :: XmlTrees -> XmlTrees -> XmlTree
  mkRoot al       = mkTree (mkElementNode (mkName t_root) al)
  
  mkAttr          :: QName -> XmlTrees -> XmlTree
  mkAttr n        = mkTree (mkAttrNode n)
  {-# INLINE mkAttr #-}
  
  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
  
  -- ------------------------------------------------------------
  
  -- | weak normalform versions of constructors
  
  mkElement'              :: QName -> XmlTrees -> XmlTrees -> XmlTree
  mkElement' n al cl      = id $!! mkElement n al cl
  {-# INLINE mkElement' #-}
  
  mkRoot'                 :: XmlTrees -> XmlTrees -> XmlTree
  mkRoot' al cl           = id $!! mkRoot al cl
  {-# INLINE mkRoot' #-}
  
  mkAttr'                 :: QName -> XmlTrees -> XmlTree
  mkAttr' n av            = id $!! mkAttr n av
  {-# INLINE mkAttr' #-}
  
  mkText'                 :: String -> XmlTree
  mkText' t               = id $!! mkText t
  {-# INLINE mkText' #-}
  
  mkCharRef'              :: Int    -> XmlTree
  mkCharRef' i            = id $!! mkCharRef i
  {-# INLINE mkCharRef' #-}
  
  mkEntityRef'            :: String -> XmlTree
  mkEntityRef' n          = id $!! mkEntityRef n
  {-# INLINE mkEntityRef' #-}
  
  mkCmt'                  :: String -> XmlTree
  mkCmt' c                = id $!! mkCmt c
  {-# INLINE mkCmt' #-}
  
  mkCdata'                :: String -> XmlTree
  mkCdata' d              = id $!! mkCdata d
  {-# INLINE mkCdata' #-}
  
  mkPi'                   :: QName  -> XmlTrees -> XmlTree
  mkPi' n v               = id $!! mkPi n v
  {-# INLINE mkPi' #-}
  
  mkError'                :: Int -> String   -> XmlTree
  mkError' l m            = id $!! mkError l m
  {-# INLINE mkError' #-}
  
  mkDTDElem'              :: DTDElem -> Attributes -> XmlTrees -> XmlTree
  mkDTDElem' e al cl      = id $!! mkDTDElem e al cl
  {-# INLINE mkDTDElem' #-}
  
  -- ------------------------------------------------------------
  
  toText :: XmlTree -> XmlTree
  toText t
      | isCharRef t
          = mkText
            . (:[]) . toEnum
            . fromJust
            . getCharRef
            $ t
      | isCdata t
          = mkText
            . fromJust
            . getCdata
            $ t
      | otherwise
          = t
  
  concText :: XmlTree -> XmlTree -> XmlTrees
  concText t1 t2
      | isText t1 && isText t2
          = (:[]) . mkText $ fromJust (getText t1) ++ fromJust (getText t2)
      | otherwise
          = [t1, t2]
  
  mergeText :: XmlTree -> XmlTree -> XmlTrees
  mergeText
      = concText `on` toText
  
  -- ------------------------------------------------------------
  