content: -- ------------------------------------------------------------
  
  {- |
     Module     : Text.XML.HXT.DOM.XmlTreeFunctions
     Copyright  : Copyright (C) 2008 Uwe Schmidt
     License    : MIT
  
     Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
     Stability  : stable
     Portability: portable
  
     Basic XmlTree functions
  
  -}
  
  -- ------------------------------------------------------------
  
  module Text.XML.HXT.DOM.XmlTreeFunctions
      ( module Text.XML.HXT.DOM.XmlTreeFunctions
      , module Text.XML.HXT.DOM.ShowXml
      )
  where
  
  import Text.XML.HXT.DOM.XmlTreeTypes
  import Text.XML.HXT.DOM.XmlKeywords
  import Text.XML.HXT.DOM.ShowXml
  
  import Data.Maybe
  
  -- -----------------------------------------------------------------------------
  --
  -- XNode Predicates
  --
  
  isXCdataNode                    :: XNode -> Bool
  isXCdataNode (XCdata _)         = True
  isXCdataNode _                  = False
  
  isXCharRefNode                  :: XNode -> Bool
  isXCharRefNode (XCharRef _)     = True
  isXCharRefNode _                = False
  
  isXCmtNode                      :: XNode -> Bool
  isXCmtNode (XCmt _)             = True
  isXCmtNode _                    = False
  
  isXDTDNode                      :: XNode -> Bool
  isXDTDNode (XDTD _ _)           = True
  isXDTDNode _                    = False
  
  isXAttrNode                     :: XNode -> Bool
  isXAttrNode (XAttr _)           = True
  isXAttrNode _                   = False
  
  isXEntityRefNode                :: XNode -> Bool
  isXEntityRefNode (XEntityRef _) = True
  isXEntityRefNode _              = False
  
  isXErrorNode                    :: XNode -> Bool
  isXErrorNode (XError _ _)       = True
  isXErrorNode _                  = False
  
  isXPiNode                       :: XNode -> Bool
  isXPiNode (XPi _ _)             = True
  isXPiNode _                     = False
  
  isXTagNode                      :: XNode -> Bool
  isXTagNode  (XTag _ _)          = True
  isXTagNode _                    = False
  
  isXTextNode                     :: XNode -> Bool
  isXTextNode (XText _)           = True
  isXTextNode _                   = False
  
  -- -----------------------------------------------------------------------------
  
  isRootNode                      :: XNode -> Bool
  isRootNode                      = isTagNode t_root
  
  isTagNode                       :: String -> XNode -> Bool
  isTagNode n                     = isOfTagNode ((== n) . qualifiedName)
  
  isOfTagNode                     :: (TagName -> Bool) -> XNode -> Bool
  isOfTagNode p (XTag n _)        = p n
  isOfTagNode _ _                 = False
  
  isAttrNode                      :: String -> XNode -> Bool
  isAttrNode n                    = isOfAttrNode ((== n) . qualifiedName)
  
  isOfAttrNode                    :: (AttrName -> Bool) -> XNode -> Bool
  isOfAttrNode p (XAttr n)        = p n
  isOfAttrNode _ _                = False
  
  isTextNode                      :: String -> XNode -> Bool
  isTextNode t                    = isOfTextNode (== t)
  
  isOfTextNode                    :: (String -> Bool) -> XNode -> Bool
  isOfTextNode p (XText t)        = p t
  isOfTextNode _ _                = False
  
  isPiNode                        :: String -> XNode -> Bool
  isPiNode n                      = isOfPiNode ((== n) . qualifiedName)
  
  isOfPiNode                      :: (TagName -> Bool) -> XNode -> Bool
  isOfPiNode p (XPi n _)          = p n
  isOfPiNode _ _                  = False
  
  isDTDElemNode                   :: DTDElem -> XNode -> Bool
  isDTDElemNode e (XDTD n _)      = n == e
  isDTDElemNode _ _               = False
  
  isErrorNode                     :: Int -> XNode -> Bool
  isErrorNode l (XError l'  _)    = l == l'
  isErrorNode _ _  = False
  
  -- -----------------------------------------------------------------------------
  
  textOfXNode                     :: XNode -> String
  textOfXNode (XText t)           = t
  textOfXNode _                   = ""
  
  -- -----------------------------------------------------------------------------
  --
  -- XmlTree constructors
  
  -- |
  -- Create a tree with a tag node.
  --
  --    * 1.parameter n :  the name of the tag
  --
  --    - 2.parameter al :  the tag attribte list
  --
  --    - 3.parameter cs :  the list of children
  --
  --    - returns : the new tree
  
  mkXTagTree              :: String -> XmlTrees -> XmlTrees -> XmlTree
  mkXTagTree n al cs      = mkNode (XTag (mkName n) al) cs
  
  -- | Version with qualified name of 'mkXTagTree'
  
  mkQTagTree              :: QName -> XmlTrees -> XmlTrees -> XmlTree
  mkQTagTree q al cs      = mkNode (XTag q al) cs
  
  -- |
  -- create a tree with a namespace aware tag node.
  --
  --    * 1.parameter n :  the prefix:localpart of the tag
  --
  --    - 2.parameter ns:  the namespace uri
  --
  --    - 3.parameter al :  the tag attribte list
  --
  --    - 4.parameter cs :  the list of children
  --
  --    - returns : the new tree
  --
  -- see also: 'mkXTagTree'
  
  mkXNsTagTree            :: String -> String -> XmlTrees -> XmlTrees -> XmlTree
  mkXNsTagTree n ns al cs = mkNode (XTag (mkNsName n ns) al) cs
  
  -- |
  -- creates a new document tree with empty contents.
  --
  --   * 1.parameter al : the attribute list for the root node
  --
  -- returns a single node tree with tag name \"\/\" indicating a root and
  -- with empty list of children
  --
  -- see also : 'emptyRoot'
  
  newRoot                 :: XmlTrees -> XmlTree
  newRoot al              = mkXTagTree t_root al []
  
  -- | the empty document tree
  --
  -- see also : 'newRoot'
  
  emptyRoot               :: XmlTree
  emptyRoot               = newRoot []
  
  -- |
  -- create a new empty document with source name as parameter
  
  newDocument             :: String -> XmlTree
  newDocument n
      = newDocument' [(a_source, n), (a_status, show c_ok)]
  
  -- |
  -- create a new empty document with a list of attributes for source location and options
  --
  -- see also : 'newDocument'
  
  newDocument'            :: Attributes -> XmlTree
  newDocument' al
      = newRoot (fromAttrl al)
  
  -- |
  -- create a document root tree.
  --
  --    * 1.parameter al :  the attribute list for the root. This list must contain at
  --                least an attribute \"source\" that contains the URI of the document to be processed
  --
  --    - 2.parameter cs :  the list for the document content
  --
  --    - returns : the document root
  
  mkRootTree              :: XmlTrees -> XmlTrees -> XmlTree
  mkRootTree al cs        = mkXTagTree t_root al cs
  
  -- |
  -- create a leaf for a text element.
  --
  --    * 1.parameter txt :  the text
  --
  --    - returns : the tree with the single node containing the text
  
  mkXTextTree             :: String -> XmlTree
  mkXTextTree s           = mkLeaf (XText s)
  
  -- |
  -- create a leaf for a char reference.
  --
  --    * 1.parameter i :  the integer representing the Unicode char
  --
  --    - returns : the tree with the single node containing the char reference
  
  mkXCharRefTree          :: Int -> XmlTree
  mkXCharRefTree s        = mkLeaf (XCharRef s)
  
  -- |
  -- create a leaf for an entity reference.
  --
  --    * 1.parameter n :  the name of the entity reference
  --
  --    - returns : the tree with the single node containing the entity reference
  
  mkXEntityRefTree        :: String -> XmlTree
  mkXEntityRefTree s      = mkLeaf (XEntityRef s)
  
  -- |
  -- create a leaf for a comment,
  --
  --    * 1.parameter c :  the comment text
  --
  --    - returns : the tree with the single node containing the comment
  
  mkXCmtTree              :: String -> XmlTree
  mkXCmtTree c            = mkLeaf (XCmt c)
  
  -- |
  -- create a tree for a part of a DTD
  --
  --    * 1.parameter d :  the type of the DTD part
  --
  --    - 2.parameter al :  the attribute list for the DTD part
  --
  --    - 3.parameter ds :  the possibly empty list of components for the DTD part
  --
  --    - returns : the tree with the composed DTD part
  
  mkXDTDTree              :: DTDElem -> Attributes -> XmlTrees -> XmlTree
  mkXDTDTree d al ds      = mkNode (XDTD d al) ds
  
  
  -- |
  -- create an attribute tree as part of a tag attribute list of tag nodes
  --
  --    * 1.parameter al : the attribute name
  --
  --    - 2.parameter av : the attribute value as tree list, usually containing a single text node
  
  mkXAttrTree             :: String -> XmlTrees -> XmlTree
  mkXAttrTree an av       = mkNode (XAttr (mkName an)) av
  
  -- | Qualified version of 'mkXAttrTree'
  
  mkQAttrTree             :: QName -> XmlTrees -> XmlTree
  mkQAttrTree aq av       = mkNode (XAttr aq) av
  
  
  -- |
  -- create an attribute tree with a namespace
  --
  --    * 1.parameter al : the attribute name
  --
  --    - 2.parameter ns : namespace uri
  --
  --    - 3.parameter av : the attribute value as tree list, usually containing a single text node
  --
  -- see also: 'mkXAttrTree', 'mkXNsTagTree'
  
  mkXNsAttrTree           :: String -> String -> XmlTrees -> XmlTree
  mkXNsAttrTree an ns av  = mkNode (XAttr (mkNsName an ns)) av
  
  -- |
  -- create a parameter entity reference DTD part.
  --
  --    * 1.parameter ref :  the name of the reference
  --
  --    - returns : the DTD part for a PERef
  
  mkXPERefTree            :: String -> XmlTree
  mkXPERefTree ref        = mkLeaf (XDTD PEREF [(a_peref, ref)])
  
  -- |
  -- create a processing instruction tree.
  --
  --    * 1.parameter n :  the name of the PI
  --
  --    - 2.parameter str :  the content of a PI
  --
  --    - returns : the processing instruction tree with a single attribute \"value\"
  --      with the str parameter as attribute value, with @valueOf a_value@ applied to the result tree
  --      the content of the PI can be selected
  
  mkXPiTree       :: String -> String -> XmlTree
  mkXPiTree n str = mkLeaf (XPi (mkName n) (xattr a_value str))
  
  -- |
  -- create xml declaration
  
  mkXmlDeclTree   :: XmlTrees -> XmlTree
  mkXmlDeclTree al = mkLeaf (XPi (mkName t_xml) al)
  
  -- |
  -- create a CDATA section tree.
  --
  --    * 1.parameter s :  the content of the CDATA section
  --
  --    - returns : the tree for the CDATA section
  
  mkXCdataTree            :: String -> XmlTree
  mkXCdataTree s          = mkLeaf (XCdata s)
  
  -- |
  -- create an error tree.
  --
  --    * 1.parameter l :  the level of the error (warning, error fatal)
  --
  --    - 2.parameter msg :  the error message
  --
  --    - 3.parameter cs :  the context, where the error was detected
  
  mkXErrorTree            :: Int -> String -> XmlTrees -> XmlTree
  mkXErrorTree l s cs     = mkNode (XError l s) cs
  
  maybeString2XText       :: Maybe String -> XmlTrees
  maybeString2XText       = map mkXTextTree . maybeToList
  
  -- ------------------------------------------------------------
  --
  -- text selection
  
  showXText       :: XmlTrees -> String
  showXText
      = concatMap showT
        where
        showT (NTree (XText      t) _) = t
        showT _                        = ""
  
  showXCharRef    :: XmlTrees -> String
  showXCharRef
      = concatMap showT
        where
        showT (NTree (XCharRef   r) _) = "&#" ++ show r ++ ";"
        showT _                        = ""
  
  showXEntityRef  :: XmlTrees -> String
  showXEntityRef
      = concatMap showT
        where
        showT (NTree (XEntityRef r) _) = "&" ++ r ++ ";"
        showT _                        = ""
  
  showXErrors     :: XmlTrees -> String
  showXErrors
      = concatMap showE
        where
        showE (NTree (XError level str) _) = msg level ++ ": " ++ str ++ "\n"
        showE _                            = ""
  
        msg :: Int -> String
        msg l
            | l == c_warn = "Warning"
            | l == c_err  = "Error"
            | otherwise   = "Fatal error"
  
  -- ------------------------------------------------------------
  --
  -- the toString conversion functions
  
  -- |
  -- old name for 'xshow' (deprecated)
  
  xmlTreesToString        :: XmlTrees -> String
  xmlTreesToString        = xshow
  
  -- |
  -- conversion of a filter result into a text node
  --
  -- see also : 'xshow'
  
  xmlTreesToText          :: XmlSFilter
  xmlTreesToText ts@[(NTree (XText _) _)] = ts            -- special case optimisation
  xmlTreesToText ts@[]                    = ts
  xmlTreesToText ts                       = xtext . xshow $ ts
  
  -- ------------------------------------------------------------
  
  xmlContentModelToString :: XmlTree -> String
  xmlContentModelToString (NTree (XDTD ELEMENT al) cs)
      = showElemType (lookup1 a_type al) cs ""
  
  xmlContentModelToString _
      = ""
  
  -- -----------------------------------------------------------------------------
  --
  -- string access functions
  
  -- |
  -- select the name of a node. For tags, attributes and pi\'s the name string
  -- is returned, else the empty string.
  
  nameOf                          :: XmlTree -> String
  nameOf
      = selName . getNode
        where
        selName (XTag  n _)       = qualifiedName n
        selName (XAttr n  )       = qualifiedName n
        selName (XPi   n _)       = qualifiedName n
        selName _                 = ""
  
  -- |
  -- select the local part of a name of a node. For tags, attributes the name string
  -- is returned, for pi's the whole name, else the empty string.
  
  localPartOf                             :: XmlTree -> String
  localPartOf
      = selName . getNode
        where
        selName (XTag  n _)       = localPart n
        selName (XAttr n  )       = localPart n
        selName (XPi   n _)       = qualifiedName n
        selName _                 = ""
  
  -- |
  -- select the namespace URI of a tag or an attribute tree, else the empty string is returned
  -- see also : 'nameOf'
  
  namespaceOf                             :: XmlTree -> String
  namespaceOf
      = selName . getNode
        where
        selName (XTag n _)        = namespaceUri n
        selName (XAttr n )        = namespaceUri n
        selName _                 = ""
  
  -- |
  -- select the namespace prefix of a tag or an attribute tree, else the empty string is returned
  -- see also : 'nameOf', 'localPartOf'
  
  prefixOf                                :: XmlTree -> String
  prefixOf
      = selName . getNode
        where
        selName (XTag n _)        = namePrefix n
        selName (XAttr n )        = namePrefix n
        selName _                 = ""
  
  -- |
  -- select the universal name (namespace uri ++ localPart) of a tag or an attribute tree, else the empty string is returned
  -- see also : 'nameOf', 'namespaceOf'
  
  universalNameOf                         :: XmlTree -> String
  universalNameOf
      = selName . getNode
        where
        selName (XTag n _)        = universalName n
        selName (XAttr n )        = universalName n
        selName _                 = ""
  
  -- |
  -- select the attributes of a dtd tree
  
  attrlOfDTD                              :: XmlTree -> Attributes
  attrlOfDTD (NTree (XDTD _ al) _)        = al
  attrlOfDTD _                            = []
  
  
  -- |
  -- select a special attribute of a DTD part
  
  valueOfDTD              :: String -> XmlTree -> String
  valueOfDTD n            = lookup1 n . attrlOfDTD
  
  -- |
  -- test an attribute of a DTD part
  
  ofDTDequals     :: String -> String -> XmlTree -> Bool
  ofDTDequals n v = (== v) . valueOfDTD n
  
  -- -----------------------------------------------------------------------------
  --
  -- convenient functions
  
  xcmt            :: String -> XmlTrees
  xcmt cmt        = [ mkXCmtTree cmt ]
  
  xerr            :: String -> XmlTrees
  xerr msg        = [ mkXErrorTree c_err msg []]
  
  xwarn           :: String -> XmlTrees
  xwarn msg       = [ mkXErrorTree c_warn msg []]
  
  xtext           :: String -> XmlTrees
  xtext t         = [ mkXTextTree t]
  
  xtag            :: String -> XmlTrees -> XmlTrees -> XmlTrees
  xtag t al cl    = [ mkXTagTree t al cl ]
  
  xattr           :: String -> String -> XmlTrees
  xattr n v       = [ mkXAttrTree n (xtext v) ]
  
  -- -----------------------------------------------------------------------------
  --
  -- conversion functions: XmlTrees <-> Attributes
  
  toTreel         :: XmlTrees -> AssocList String XmlTrees
  toTreel
      = concatMap toTree
        where
        toTree (NTree (XAttr n) cs) = [(qualifiedName n, cs)]
        toTree _                    = []
  
  toAttrl         :: XmlTrees -> Attributes
  toAttrl
      = map (\ (k,tl) -> (k, xshow tl)) . toTreel
  
  
  fromTreel       :: AssocList String XmlTrees -> XmlTrees
  fromTreel
      = map (\ (k,tl) -> mkXAttrTree k tl)
  
  fromAttrl       :: Attributes -> XmlTrees
  fromAttrl
      = fromTreel . map (\ (k,v) -> (k, xtext v))
  
  -- -----------------------------------------------------------------------------
  