content: -- ------------------------------------------------------------
  
  {- |
     Module     : Text.XML.HXT.Arrow.XmlArrow
     Copyright  : Copyright (C) 2011 Uwe Schmidt
     License    : MIT
  
     Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
     Stability  : experimental
     Portability: portable
  
     Basic arrows for processing XML documents
  
     All arrows use IO and a global state for options, errorhandling, ...
  
  -}
  
  -- ------------------------------------------------------------
  
  module Text.XML.HXT.Arrow.XmlArrow
      ( module Text.XML.HXT.Arrow.XmlArrow )
  where
  
  import           Control.Arrow                  -- classes
  import           Control.Arrow.ArrowList
  import           Control.Arrow.ArrowIf
  import           Control.Arrow.ArrowTree
  
  import           Control.Arrow.ListArrow                -- arrow types
  import           Control.Arrow.StateListArrow
  import           Control.Arrow.IOListArrow
  import           Control.Arrow.IOStateListArrow
  
  import           Data.Char.Properties.XMLCharProps        ( isXmlSpaceChar )
  import           Data.Maybe
  
  import           Text.XML.HXT.DOM.Interface
  import qualified Text.XML.HXT.DOM.XmlNode as XN
  import qualified Text.XML.HXT.DOM.ShowXml as XS
  
  -- ------------------------------------------------------------
  
  {- | Arrows for processing 'Text.XML.HXT.DOM.TypeDefs.XmlTree's
  
  These arrows can be grouped into predicates, selectors, constructors, and transformers.
  
  All predicates (tests) act like 'Control.Arrow.ArrowIf.none' for failure and 'Control.Arrow.ArrowIf.this' for success.
  A logical and can be formed by @ a1 >>> a2 @, a locical or by @ a1 \<+\> a2 @.
  
  Selector arrows will fail, when applied to wrong input, e.g. selecting the text of a node with 'getText'
  will fail when applied to a none text node.
  
  Edit arrows will remain the input unchanged, when applied to wrong argument, e.g. editing the content of a text node
  with 'changeText' applied to an element node will return the unchanged element node.
  -}
  
  infixl 7 +=
  
  class (Arrow a, ArrowList a, ArrowTree a) => ArrowXml a where
  
      -- discriminating predicates
  
      -- | test for text nodes
      isText              :: a XmlTree XmlTree
      isText              = isA XN.isText
      {-# INLINE isText #-}
  
      isBlob              :: a XmlTree XmlTree
      isBlob              = isA XN.isBlob
      {-# INLINE isBlob #-}
  
      -- | test for char reference, used during parsing
      isCharRef           :: a XmlTree XmlTree
      isCharRef           = isA XN.isCharRef
      {-# INLINE isCharRef #-}
  
      -- | test for entity reference, used during parsing
      isEntityRef         :: a XmlTree XmlTree
      isEntityRef         = isA XN.isEntityRef
      {-# INLINE isEntityRef #-}
  
      -- | test for comment
      isCmt               :: a XmlTree XmlTree
      isCmt               = isA XN.isCmt
      {-# INLINE isCmt #-}
  
      -- | test for CDATA section, used during parsing
      isCdata             :: a XmlTree XmlTree
      isCdata             = isA XN.isCdata
      {-# INLINE isCdata #-}
  
      -- | test for processing instruction
      isPi                :: a XmlTree XmlTree
      isPi                = isA XN.isPi
      {-# INLINE isPi #-}
  
      -- | test for processing instruction \<?xml ...\>
      isXmlPi             :: a XmlTree XmlTree
      isXmlPi             = isPi >>> hasName "xml"
  
      -- | test for element
      isElem              :: a XmlTree XmlTree
      isElem              = isA XN.isElem
      {-# INLINE isElem #-}
  
      -- | test for DTD part, used during parsing
      isDTD               :: a XmlTree XmlTree
      isDTD               = isA XN.isDTD
      {-# INLINE isDTD #-}
  
      -- | test for attribute tree
      isAttr              :: a XmlTree XmlTree
      isAttr              = isA XN.isAttr
      {-# INLINE isAttr #-}
  
      -- | test for error message
      isError             :: a XmlTree XmlTree
      isError             = isA XN.isError
      {-# INLINE isError #-}
  
      -- | test for root node (element with name \"\/\")
      isRoot              :: a XmlTree XmlTree
      isRoot              = isA XN.isRoot
      {-# INLINE isRoot #-}
  
      -- | test for text nodes with text, for which a predicate holds
      --
      -- example: @hasText (all (\`elem\` \" \\t\\n\"))@ check for text nodes with only whitespace content
  
      hasText             :: (String -> Bool) -> a XmlTree XmlTree
      hasText p           = (isText >>> getText >>> isA p) `guards` this
  
      -- | test for text nodes with only white space
      --
      -- implemented with 'hasTest'
  
      isWhiteSpace        :: a XmlTree XmlTree
      isWhiteSpace        = hasText (all isXmlSpaceChar)
      {-# INLINE isWhiteSpace #-}
  
      -- |
      -- test whether a node (element, attribute, pi) has a name with a special property
  
      hasNameWith         :: (QName  -> Bool) -> a XmlTree XmlTree
      hasNameWith p       = (getQName        >>> isA p) `guards` this
      {-# INLINE hasNameWith #-}
  
      -- |
      -- test whether a node (element, attribute, pi) has a specific qualified name
      -- useful only after namespace propagation
      hasQName            :: QName  -> a XmlTree XmlTree
      hasQName n          = (getQName        >>> isA (== n)) `guards` this
      {-# INLINE hasQName #-}
  
      -- |
      -- test whether a node has a specific name (prefix:localPart or localPart),
      -- generally useful, even without namespace handling
      hasName             :: String -> a XmlTree XmlTree
      hasName n           = (getName         >>> isA (== n)) `guards` this
      {-# INLINE hasName #-}
  
      -- |
      -- test whether a node has a specific name as local part,
      -- useful only after namespace propagation
      hasLocalPart        :: String -> a XmlTree XmlTree
      hasLocalPart n      = (getLocalPart    >>> isA (== n)) `guards` this
      {-# INLINE hasLocalPart #-}
  
      -- |
      -- test whether a node has a specific name prefix,
      -- useful only after namespace propagation
      hasNamePrefix       :: String -> a XmlTree XmlTree
      hasNamePrefix n     = (getNamePrefix   >>> isA (== n)) `guards` this
      {-# INLINE hasNamePrefix #-}
  
      -- |
      -- test whether a node has a specific namespace URI
      -- useful only after namespace propagation
      hasNamespaceUri     :: String -> a XmlTree XmlTree
      hasNamespaceUri n   = (getNamespaceUri >>> isA (== n)) `guards` this
      {-# INLINE hasNamespaceUri #-}
  
      -- |
      -- test whether an element node has an attribute node with a specific name
      hasAttr             :: String -> a XmlTree XmlTree
      hasAttr n           = (getAttrl        >>> hasName n)  `guards` this
      {-# INLINE hasAttr #-}
  
      -- |
      -- test whether an element node has an attribute node with a specific qualified name
      hasQAttr            :: QName -> a XmlTree XmlTree
      hasQAttr n          = (getAttrl        >>> hasQName n)  `guards` this
      {-# INLINE hasQAttr #-}
  
      -- |
      -- test whether an element node has an attribute with a specific value
      hasAttrValue        :: String -> (String -> Bool) -> a XmlTree XmlTree
      hasAttrValue n p    = (getAttrl >>> hasName n >>> xshow getChildren >>> isA p)  `guards` this
  
      -- |
      -- test whether an element node has an attribute with a qualified name and a specific value
      hasQAttrValue       :: QName -> (String -> Bool) -> a XmlTree XmlTree
      hasQAttrValue n p   = (getAttrl >>> hasQName n >>> xshow getChildren >>> isA p)  `guards` this
  
      -- constructor arrows ------------------------------------------------------------
  
      -- | text node construction arrow
      mkText              :: a String XmlTree
      mkText              = arr  XN.mkText
      {-# INLINE mkText #-}
  
      -- | blob node construction arrow
      mkBlob              :: a Blob XmlTree
      mkBlob              = arr  XN.mkBlob
      {-# INLINE mkBlob #-}
  
      -- | char reference construction arrow, useful for document output
      mkCharRef           :: a Int    XmlTree
      mkCharRef           = arr  XN.mkCharRef
      {-# INLINE mkCharRef #-}
  
      -- | entity reference construction arrow, useful for document output
      mkEntityRef         :: a String XmlTree
      mkEntityRef         = arr  XN.mkEntityRef
      {-# INLINE mkEntityRef #-}
  
      -- | comment node construction, useful for document output
      mkCmt               :: a String XmlTree
      mkCmt               = arr  XN.mkCmt
      {-# INLINE mkCmt #-}
  
      -- | CDATA construction, useful for document output
      mkCdata             :: a String XmlTree
      mkCdata             = arr  XN.mkCdata
      {-# INLINE mkCdata #-}
  
      -- | error node construction, useful only internally
      mkError             :: Int -> a String XmlTree
      mkError level       = arr (XN.mkError level)
  
      -- | element construction:
      -- | the attributes and the content of the element are computed by applying arrows
      -- to the input
      mkElement           :: QName -> a n XmlTree -> a n XmlTree -> a n XmlTree
      mkElement n af cf   = (listA af &&& listA cf)
                            >>>
                            arr2 (\ al cl -> XN.mkElement n al cl)
  
      -- | attribute node construction:
      -- | the attribute value is computed by applying an arrow to the input
      mkAttr              :: QName -> a n XmlTree -> a n XmlTree
      mkAttr qn f         = listA f >>> arr (XN.mkAttr qn)
  
      -- | processing instruction construction:
      -- | the content of the processing instruction is computed by applying an arrow to the input
      mkPi                :: QName -> a n XmlTree -> a n XmlTree
      mkPi qn f           = listA f >>> arr (XN.mkPi   qn)
  
      -- convenient arrows for constructors --------------------------------------------------
  
      -- | convenient arrow for element construction, more comfortable variant of 'mkElement'
      --
      -- example for simplifying 'mkElement' :
      --
      -- > mkElement qn (a1 <+> ... <+> ai) (c1 <+> ... <+> cj)
      --
      -- equals
      --
      -- > mkqelem qn [a1,...,ai] [c1,...,cj]
  
      mkqelem             :: QName -> [a n XmlTree] -> [a n XmlTree] -> a n XmlTree
      mkqelem  n afs cfs  = mkElement n (catA afs) (catA cfs)
      {-# INLINE mkqelem #-}
  
      -- | convenient arrow for element construction with strings instead of qualified names as element names, see also 'mkElement' and 'mkelem'
      mkelem              :: String -> [a n XmlTree] -> [a n XmlTree] -> a n XmlTree
      mkelem  n afs cfs   = mkElement (mkName n) (catA afs) (catA cfs)
      {-# INLINE mkelem #-}
  
      -- | convenient arrow for element construction with attributes but without content, simple variant of 'mkelem' and 'mkElement'
      aelem               :: String -> [a n XmlTree]                  -> a n XmlTree
      aelem n afs         = catA afs >. \ al -> XN.mkElement (mkName n) al []
      {-# INLINE aelem #-}
  
      -- | convenient arrow for simple element construction without attributes, simple variant of 'mkelem' and 'mkElement'
      selem               :: String                  -> [a n XmlTree] -> a n XmlTree
      selem n cfs         = catA cfs >.         XN.mkElement (mkName n) []
      {-# INLINE selem #-}
  
      -- | convenient arrow for construction of empty elements without attributes, simple variant of 'mkelem' and 'mkElement'
      eelem               :: String                                   -> a n XmlTree
      eelem n             = constA      (XN.mkElement (mkName n) [] [])
      {-# INLINE eelem #-}
  
      -- | construction of an element node with name \"\/\" for document roots
      root                ::           [a n XmlTree] -> [a n XmlTree] -> a n XmlTree
      root                = mkelem t_root
      {-# INLINE root #-}
  
      -- | alias for 'mkAttr'
      qattr               :: QName -> a n XmlTree -> a n XmlTree
      qattr               = mkAttr
      {-# INLINE qattr #-}
  
      -- | convenient arrow for attribute construction, simple variant of 'mkAttr'
      attr                :: String -> a n XmlTree -> a n XmlTree
      attr                = mkAttr . mkName
      {-# INLINE attr #-}
  
      -- constant arrows (ignoring the input) for tree construction ------------------------------
  
      -- | constant arrow for text nodes
      txt                 :: String -> a n XmlTree
      txt                 = constA .  XN.mkText
      {-# INLINE txt #-}
  
      -- | constant arrow for blob nodes
      blb                 :: Blob -> a n XmlTree
      blb                 = constA .  XN.mkBlob
      {-# INLINE blb #-}
  
      -- | constant arrow for char reference nodes
      charRef             :: Int    -> a n XmlTree
      charRef             = constA .  XN.mkCharRef
      {-# INLINE charRef #-}
  
      -- | constant arrow for entity reference nodes
      entityRef           :: String -> a n XmlTree
      entityRef           = constA .  XN.mkEntityRef
      {-# INLINE entityRef #-}
  
      -- | constant arrow for comment
      cmt                 :: String -> a n XmlTree
      cmt                 = constA .  XN.mkCmt
      {-# INLINE cmt #-}
  
      -- | constant arrow for warning
      warn                :: String -> a n XmlTree
      warn                = constA . (XN.mkError c_warn)
      {-# INLINE warn #-}
  
      -- | constant arrow for errors
      err                 :: String -> a n XmlTree
      err                 = constA . (XN.mkError c_err)
      {-# INLINE err #-}
  
      -- | constant arrow for fatal errors
      fatal               :: String -> a n XmlTree
      fatal               = constA . (XN.mkError c_fatal)
      {-# INLINE fatal #-}
  
      -- | constant arrow for simple processing instructions, see 'mkPi'
      spi                 :: String -> String -> a n XmlTree
      spi piName piCont   = constA (XN.mkPi (mkName piName) [XN.mkAttr (mkName a_value) [XN.mkText piCont]])
      {-# INLINE spi #-}
  
      -- | constant arrow for attribute nodes, attribute name is a qualified name and value is a text,
      -- | see also 'mkAttr', 'qattr', 'attr'
      sqattr              :: QName -> String -> a n XmlTree
      sqattr an av        = constA (XN.mkAttr an                 [XN.mkText av])
      {-# INLINE sqattr #-}
  
      -- | constant arrow for attribute nodes, attribute name and value are
      -- | given by parameters, see 'mkAttr'
      sattr               :: String -> String -> a n XmlTree
      sattr an av         = constA (XN.mkAttr (mkName an)     [XN.mkText av])
      {-# INLINE sattr #-}
  
      -- selector arrows --------------------------------------------------
  
      -- | select the text of a text node
      getText             :: a XmlTree String
      getText             = arrL (maybeToList  . XN.getText)
      {-# INLINE getText #-}
  
      -- | select the value of a char reference
      getCharRef          :: a XmlTree Int
      getCharRef          = arrL (maybeToList  . XN.getCharRef)
      {-# INLINE getCharRef #-}
  
      -- | select the name of a entity reference node
      getEntityRef        :: a XmlTree String
      getEntityRef        = arrL (maybeToList  . XN.getEntityRef)
      {-# INLINE getEntityRef #-}
  
      -- | select the comment of a comment node
      getCmt              :: a XmlTree String
      getCmt              = arrL (maybeToList  . XN.getCmt)
      {-# INLINE getCmt #-}
  
      -- | select the content of a CDATA node
      getCdata            :: a XmlTree String
      getCdata            = arrL (maybeToList  . XN.getCdata)
      {-# INLINE getCdata #-}
  
      -- | select the name of a processing instruction
      getPiName           :: a XmlTree QName
      getPiName           = arrL (maybeToList  . XN.getPiName)
      {-# INLINE getPiName #-}
  
      -- | select the content of a processing instruction
      getPiContent        :: a XmlTree XmlTree
      getPiContent        = arrL (fromMaybe [] . XN.getPiContent)
      {-# INLINE getPiContent #-}
  
      -- | select the name of an element node
      getElemName         :: a XmlTree QName
      getElemName         = arrL (maybeToList  . XN.getElemName)
      {-# INLINE getElemName #-}
  
      -- | select the attribute list of an element node
      getAttrl            :: a XmlTree XmlTree
      getAttrl            = arrL (fromMaybe [] . XN.getAttrl)
      {-# INLINE getAttrl #-}
  
      -- | select the DTD type of a DTD node
      getDTDPart          :: a XmlTree DTDElem
      getDTDPart          = arrL (maybeToList  . XN.getDTDPart)
      {-# INLINE getDTDPart #-}
  
      -- | select the DTD attributes of a DTD node
      getDTDAttrl         :: a XmlTree Attributes
      getDTDAttrl         = arrL (maybeToList  . XN.getDTDAttrl)
      {-# INLINE getDTDAttrl #-}
  
      -- | select the name of an attribute
      getAttrName         :: a XmlTree QName
      getAttrName         = arrL (maybeToList  . XN.getAttrName)
      {-# INLINE getAttrName #-}
  
      -- | select the error level (c_warn, c_err, c_fatal) from an error node
      getErrorLevel       :: a XmlTree Int
      getErrorLevel       = arrL (maybeToList  . XN.getErrorLevel)
      {-# INLINE getErrorLevel #-}
  
      -- | select the error message from an error node
      getErrorMsg         :: a XmlTree String
      getErrorMsg         = arrL (maybeToList  . XN.getErrorMsg)
      {-# INLINE getErrorMsg #-}
  
      -- | select the qualified name from an element, attribute or pi
      getQName            :: a XmlTree QName
      getQName            = arrL (maybeToList  . XN.getName)
      {-# INLINE getQName #-}
  
      -- | select the prefix:localPart or localPart from an element, attribute or pi
      getName             :: a XmlTree String
      getName             = arrL (maybeToList  . XN.getQualifiedName)
      {-# INLINE getName #-}
  
      -- | select the univeral name ({namespace URI} ++ localPart)
      getUniversalName    :: a XmlTree String
      getUniversalName    = arrL (maybeToList  . XN.getUniversalName)
      {-# INLINE getUniversalName #-}
  
      -- | select the univeral name (namespace URI ++ localPart)
      getUniversalUri     :: a XmlTree String
      getUniversalUri     = arrL (maybeToList  . XN.getUniversalUri)
      {-# INLINE getUniversalUri #-}
  
      -- | select the local part
      getLocalPart        :: a XmlTree String
      getLocalPart        = arrL (maybeToList  . XN.getLocalPart)
      {-# INLINE getLocalPart #-}
  
      -- | select the name prefix
      getNamePrefix       :: a XmlTree String
      getNamePrefix       = arrL (maybeToList  . XN.getNamePrefix)
      {-# INLINE getNamePrefix #-}
  
      -- | select the namespace URI
      getNamespaceUri     :: a XmlTree String
      getNamespaceUri     = arrL (maybeToList  . XN.getNamespaceUri)
      {-# INLINE getNamespaceUri #-}
  
      -- | select the value of an attribute of an element node,
      -- always succeeds with empty string as default value \"\"
      getAttrValue        :: String -> a XmlTree String
      getAttrValue n      = xshow (getAttrl >>> hasName n >>> getChildren)
  
      -- | like 'getAttrValue', but fails if the attribute does not exist
      getAttrValue0       :: String -> a XmlTree String
      getAttrValue0 n     = getAttrl >>> hasName n >>> xshow getChildren
  
      -- | like 'getAttrValue', but select the value of an attribute given by a qualified name,
      -- always succeeds with empty string as default value \"\"
      getQAttrValue       :: QName -> a XmlTree String
      getQAttrValue n     = xshow (getAttrl >>> hasQName n >>> getChildren)
  
      -- | like 'getQAttrValue', but fails if attribute does not exist
      getQAttrValue0      :: QName -> a XmlTree String
      getQAttrValue0 n    = getAttrl >>> hasQName n >>> xshow getChildren
  
      -- edit arrows --------------------------------------------------
  
      -- | edit the string of a text node
      changeText          :: (String -> String) -> a XmlTree XmlTree
      changeText cf       = arr (XN.changeText     cf) `when` isText
  
      -- | edit the blob of a blob node
      changeBlob          :: (Blob -> Blob) -> a XmlTree XmlTree
      changeBlob cf       = arr (XN.changeBlob     cf) `when` isBlob
  
      -- | edit the comment string of a comment node
      changeCmt           :: (String -> String) -> a XmlTree XmlTree
      changeCmt  cf       = arr (XN.changeCmt      cf) `when` isCmt
  
      -- | edit an element-, attribute- or pi- name
      changeQName         :: (QName  -> QName) -> a XmlTree XmlTree
      changeQName cf      = arr (XN.changeName  cf) `when` getQName
  
      -- | edit an element name
      changeElemName      :: (QName  -> QName) -> a XmlTree XmlTree
      changeElemName cf   = arr (XN.changeElemName  cf) `when` isElem
  
      -- | edit an attribute name
      changeAttrName      :: (QName  -> QName) -> a XmlTree XmlTree
      changeAttrName cf   = arr (XN.changeAttrName cf) `when` isAttr
  
      -- | edit a pi name
      changePiName        :: (QName  -> QName) -> a XmlTree XmlTree
      changePiName cf     = arr (XN.changePiName  cf) `when` isPi
  
      -- | edit an attribute value
      changeAttrValue     :: (String -> String) -> a XmlTree XmlTree
      changeAttrValue cf  = replaceChildren ( xshow getChildren
                                              >>> arr cf
                                              >>> mkText
                                            )
                            `when` isAttr
  
  
      -- | edit an attribute list of an element node
      changeAttrl         :: (XmlTrees -> XmlTrees -> XmlTrees) -> a XmlTree XmlTree -> a XmlTree XmlTree
      changeAttrl cf f    = ( ( listA f &&& this )
                              >>>
                              arr2 changeAL
                            )
                            `when`
                            ( isElem <+> isPi )
                          where
                          changeAL as x = XN.changeAttrl (\ xs -> cf xs as) x
  
      -- | replace an element, attribute or pi name
      setQName            :: QName -> a XmlTree XmlTree
      setQName  n         = changeQName  (const n)
      {-# INLINE setQName #-}
  
      -- | replace an element name
      setElemName         :: QName -> a XmlTree XmlTree
      setElemName  n      = changeElemName  (const n)
      {-# INLINE setElemName #-}
  
      -- | replace an attribute name
      setAttrName         :: QName -> a XmlTree XmlTree
      setAttrName n       = changeAttrName (const n)
      {-# INLINE setAttrName #-}
  
      -- | replace an element name
      setPiName           :: QName -> a XmlTree XmlTree
      setPiName  n        = changePiName  (const n)
      {-# INLINE setPiName #-}
  
      -- | replace an atribute list of an element node
      setAttrl            :: a XmlTree XmlTree -> a XmlTree XmlTree
      setAttrl            = changeAttrl (const id)                -- (\ x y -> y)
      {-# INLINE setAttrl #-}
  
      -- | add a list of attributes to an element
      addAttrl            :: a XmlTree XmlTree -> a XmlTree XmlTree
      addAttrl            = changeAttrl (XN.mergeAttrl)
      {-# INLINE addAttrl #-}
  
      -- | add (or replace) an attribute
      addAttr             :: String -> String  -> a XmlTree XmlTree
      addAttr an av       = addAttrl (sattr an av)
      {-# INLINE addAttr #-}
  
      -- | remove an attribute
      removeAttr          :: String  -> a XmlTree XmlTree
      removeAttr an       = processAttrl (none `when` hasName an)
  
      -- | remove an attribute with a qualified name
      removeQAttr         :: QName  -> a XmlTree XmlTree
      removeQAttr an      = processAttrl (none `when` hasQName an)
  
      -- | process the attributes of an element node with an arrow
      processAttrl        :: a XmlTree XmlTree -> a XmlTree XmlTree
      processAttrl f      = setAttrl (getAttrl >>> f)
  
      -- | process a whole tree inclusive attribute list of element nodes
      -- see also: 'Control.Arrow.ArrowTree.processTopDown'
  
      processTopDownWithAttrl     :: a XmlTree XmlTree -> a XmlTree XmlTree
      processTopDownWithAttrl f   = processTopDown ( f >>> ( processAttrl (processTopDown f) `when` isElem))
  
      -- | convenient op for adding attributes or children to a node
      --
      -- usage: @ tf += cf @
      --
      -- the @tf@ arrow computes an element node, and all trees computed by @cf@ are
      -- added to this node, if a tree is an attribute, it is inserted in the attribute list
      -- else it is appended to the content list.
      --
      -- attention: do not build long content list this way because '+=' is implemented by ++
      --
      -- examples:
      --
      -- > eelem "a"
      -- >   += sattr "href" "page.html"
      -- >   += sattr "name" "here"
      -- >   += txt "look here"
      --
      -- is the same as
      --
      -- > mkelem [ sattr "href" "page.html"
      -- >        , sattr "name" "here"
      -- >        ]
      -- >        [ txt "look here" ]
      --
      -- and results in the XML fragment: \<a href=\"page.html\" name=\"here\"\>look here\<\/a\>
      --
      -- advantage of the '+=' operator is, that attributes and content can be added
      -- any time step by step.
      -- if @tf@ computes a whole list of trees, e.g. a list of \"td\" or \"tr\" elements,
      -- the attributes or content is added to all trees. useful for adding \"class\" or \"style\" attributes
      -- to table elements.
  
      (+=)                :: a b XmlTree -> a b XmlTree -> a b XmlTree
      tf += cf            = (tf &&& listA cf) >>> arr2 addChildren
                          where
                          addChildren     :: XmlTree -> XmlTrees -> XmlTree
                          addChildren t cs
                              = foldl addChild t cs
                          addChild        :: XmlTree -> XmlTree -> XmlTree
                          addChild t c
                              | not (XN.isElem t)
                                  = t
                              | XN.isAttr c
                                  = XN.changeAttrl (XN.addAttr c) t
                              | otherwise
                                  = XN.changeChildren (++ [c]) t
  
  
      -- | apply an arrow to the input and convert the resulting XML trees into a string representation
  
      xshow               :: a n XmlTree -> a n String
      xshow f             = f >. XS.xshow
      {-# INLINE xshow #-}
  
  
      -- | apply an arrow to the input and convert the resulting XML trees into a string representation
  
      xshowBlob           :: a n XmlTree -> a n Blob
      xshowBlob f         = f >. XS.xshowBlob
      {-# INLINE xshowBlob #-}
  
  
  {- | Document Type Definition arrows
  
  These are separated, because they are not needed for document processing,
  only when processing the DTD, e.g. for generating access funtions for the toolbox
  from a DTD (se example DTDtoHaskell in the examples directory)
  -}
  
  
  class (ArrowXml a) => ArrowDTD a where
      isDTDDoctype        :: a XmlTree XmlTree
      isDTDDoctype        = isA (maybe False (== DOCTYPE ) . XN.getDTDPart)
  
      isDTDElement        :: a XmlTree XmlTree
      isDTDElement        = isA (maybe False (== ELEMENT ) . XN.getDTDPart)
  
      isDTDContent        :: a XmlTree XmlTree
      isDTDContent        = isA (maybe False (== CONTENT ) . XN.getDTDPart)
  
      isDTDAttlist        :: a XmlTree XmlTree
      isDTDAttlist        = isA (maybe False (== ATTLIST ) . XN.getDTDPart)
  
      isDTDEntity         :: a XmlTree XmlTree
      isDTDEntity         = isA (maybe False (== ENTITY  ) . XN.getDTDPart)
  
      isDTDPEntity        :: a XmlTree XmlTree
      isDTDPEntity        = isA (maybe False (== PENTITY ) . XN.getDTDPart)
  
      isDTDNotation       :: a XmlTree XmlTree
      isDTDNotation       = isA (maybe False (== NOTATION) . XN.getDTDPart)
  
      isDTDCondSect       :: a XmlTree XmlTree
      isDTDCondSect       = isA (maybe False (== CONDSECT) . XN.getDTDPart)
  
      isDTDName           :: a XmlTree XmlTree
      isDTDName           = isA (maybe False (== NAME    ) . XN.getDTDPart)
  
      isDTDPERef          :: a XmlTree XmlTree
      isDTDPERef          = isA (maybe False (== PEREF   ) . XN.getDTDPart)
  
      hasDTDAttr          :: String -> a XmlTree XmlTree
      hasDTDAttr n        = isA (isJust . lookup n . fromMaybe [] . XN.getDTDAttrl)
  
      getDTDAttrValue     :: String -> a XmlTree String
      getDTDAttrValue n   = arrL (maybeToList . lookup n . fromMaybe [] . XN.getDTDAttrl)
  
      setDTDAttrValue     :: String -> String -> a XmlTree XmlTree
      setDTDAttrValue n v = arr (XN.changeDTDAttrl (addEntry n v)) `when` isDTD
  
      mkDTDElem           :: DTDElem -> Attributes -> a n XmlTree -> a n XmlTree
      mkDTDElem e al cf   = listA cf >>> arr (XN.mkDTDElem e al)
  
      mkDTDDoctype        :: Attributes -> a n XmlTree -> a n XmlTree
      mkDTDDoctype        = mkDTDElem DOCTYPE
  
      mkDTDElement        :: Attributes -> a n XmlTree
      mkDTDElement al     = mkDTDElem ELEMENT al none
  
      mkDTDEntity         :: Attributes -> a n XmlTree
      mkDTDEntity al      = mkDTDElem ENTITY al none
  
      mkDTDPEntity        :: Attributes -> a n XmlTree
      mkDTDPEntity al     = mkDTDElem PENTITY al none
  
  instance ArrowXml LA
  instance ArrowXml (SLA s)
  instance ArrowXml IOLA
  instance ArrowXml (IOSLA s)
  
  instance ArrowDTD LA
  instance ArrowDTD (SLA s)
  instance ArrowDTD IOLA
  instance ArrowDTD (IOSLA s)
  
  -- ------------------------------------------------------------
  