content: -- ------------------------------------------------------------
  
  {- |
     Module     : Text.XML.HXT.RelaxNG.BasicArrows
     Copyright  : Copyright (C) 2011 Uwe Schmidt
     License    : MIT
  
     Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
     Stability  : experimental
     Portability: portable
  
     Constants and basic arrows for Relax NG
  
  -}
  
  -- ------------------------------------------------------------
  
  module Text.XML.HXT.RelaxNG.BasicArrows
  where
  
  import Control.Arrow.ListArrows
  
  import Text.XML.HXT.DOM.Interface
  import Text.XML.HXT.Arrow.XmlArrow
  
  import Text.XML.HXT.RelaxNG.DataTypes
      ( a_relaxSimplificationChanges
      , defineOrigName
      , contextBaseAttr
      )
  
  -- ------------------------------------------------------------
  
  hasRngAttName           :: ArrowXml a => String -> a XmlTree XmlTree
  hasRngAttName s
      = isAttr
        >>>
        hasLocalPart s
        >>>
        hasNamespaceUri ""
  
  hasRngElemName          :: ArrowXml a => String -> a XmlTree XmlTree
  hasRngElemName s
      = isElem
        >>>
        hasLocalPart s
        >>>
        hasNamespaceUri relaxNamespace
  
  checkRngName :: ArrowXml a => [String] -> a XmlTree XmlTree
  checkRngName l
      = catA (map hasRngElemName l)
        `guards`
        this
  
  noOfChildren    :: ArrowXml a => (Int -> Bool) -> a XmlTree XmlTree
  noOfChildren p
      = getChildren
        >>.
        (\ l -> if p (length l) then l else [])
  
  -- ------------------------------------------------------------
  
  isAttributeRef  :: ArrowXml a => a XmlTree XmlTree
  isAttributeRef
      = checkRngName ["attribute", "ref"]
  
  isAttributeRefTextListGroupInterleaveOneOrMoreEmpty     :: ArrowXml a => a XmlTree XmlTree
  isAttributeRefTextListGroupInterleaveOneOrMoreEmpty
      = checkRngName ["attribute", "ref", "text", "list", "group", "interleave", "oneOrMore", "empty"]
  
  isAttributeRefTextListInterleave        :: ArrowXml a => a XmlTree XmlTree
  isAttributeRefTextListInterleave
      = checkRngName ["attribute", "ref", "text", "list", "interleave"]
  
  isAttributeListGroupInterleaveOneOrMore :: ArrowXml a => a XmlTree XmlTree
  isAttributeListGroupInterleaveOneOrMore
      = checkRngName ["attribute", "list", "group", "interleave", "oneOrMore"]
  
  isExternalRefInclude    :: ArrowXml a => a XmlTree XmlTree
  isExternalRefInclude
      = checkRngName ["externalRef", "include"]
  
  isNameNsNameValue       :: ArrowXml a => a XmlTree XmlTree
  isNameNsNameValue
      = checkRngName ["name", "nsName", "value"]
  
  isNameNsName    :: ArrowXml a => a XmlTree XmlTree
  isNameNsName
      = checkRngName ["name", "nsName"]
  
  isNameAnyNameNsName     :: ArrowXml a => a XmlTree XmlTree
  isNameAnyNameNsName
      = checkRngName ["name", "anyName", "nsName"]
  
  isDefineOneOrMoreZeroOrMoreOptionalListMixed    :: ArrowXml a => a XmlTree XmlTree
  isDefineOneOrMoreZeroOrMoreOptionalListMixed
      = checkRngName ["define", "oneOrMore", "zeroOrMore", "optional", "list", "mixed"]
  
  isChoiceGroupInterleave :: ArrowXml a => a XmlTree XmlTree
  isChoiceGroupInterleave
      = checkRngName ["choice", "group", "interleave"]
  
  isChoiceGroupInterleaveOneOrMore        :: ArrowXml a => a XmlTree XmlTree
  isChoiceGroupInterleaveOneOrMore
      = checkRngName ["choice", "group", "interleave", "oneOrMore"]
  
  isGroupInterleave       :: ArrowXml a => a XmlTree XmlTree
  isGroupInterleave
      = checkRngName ["group", "interleave"]
  
  -- ------------------------------------------------------------
  
  isRngAnyName            :: ArrowXml a => a XmlTree XmlTree
  isRngAnyName            = hasRngElemName "anyName"
  
  isRngAttribute          :: ArrowXml a => a XmlTree XmlTree
  isRngAttribute          = hasRngElemName "attribute"
  
  isRngChoice             :: ArrowXml a => a XmlTree XmlTree
  isRngChoice             = hasRngElemName "choice"
  
  isRngCombine            :: ArrowXml a => a XmlTree XmlTree
  isRngCombine            = hasRngElemName "combine"
  
  isRngData               :: ArrowXml a => a XmlTree XmlTree
  isRngData               = hasRngElemName "data"
  
  isRngDefine             :: ArrowXml a => a XmlTree XmlTree
  isRngDefine             = hasRngElemName "define"
  
  isRngDiv                :: ArrowXml a => a XmlTree XmlTree
  isRngDiv                = hasRngElemName "div"
  
  isRngElement            :: ArrowXml a => a XmlTree XmlTree
  isRngElement            = hasRngElemName "element"
  
  isRngEmpty              :: ArrowXml a => a XmlTree XmlTree
  isRngEmpty              = hasRngElemName "empty"
  
  isRngExcept             :: ArrowXml a => a XmlTree XmlTree
  isRngExcept             = hasRngElemName "except"
  
  isRngExternalRef        :: ArrowXml a => a XmlTree XmlTree
  isRngExternalRef        = hasRngElemName "externalRef"
  
  isRngGrammar            :: ArrowXml a => a XmlTree XmlTree
  isRngGrammar            = hasRngElemName "grammar"
  
  isRngGroup              :: ArrowXml a => a XmlTree XmlTree
  isRngGroup              = hasRngElemName "group"
  
  isRngInclude            :: ArrowXml a => a XmlTree XmlTree
  isRngInclude            = hasRngElemName "include"
  
  isRngInterleave         :: ArrowXml a => a XmlTree XmlTree
  isRngInterleave         = hasRngElemName "interleave"
  
  isRngList               :: ArrowXml a => a XmlTree XmlTree
  isRngList               = hasRngElemName "list"
  
  isRngMixed              :: ArrowXml a => a XmlTree XmlTree
  isRngMixed              = hasRngElemName "mixed"
  
  isRngName               :: ArrowXml a => a XmlTree XmlTree
  isRngName               = hasRngElemName "name"
  
  isRngNotAllowed         :: ArrowXml a => a XmlTree XmlTree
  isRngNotAllowed         = hasRngElemName "notAllowed"
  
  isRngNsName             :: ArrowXml a => a XmlTree XmlTree
  isRngNsName             = hasRngElemName "nsName"
  
  isRngOneOrMore          :: ArrowXml a => a XmlTree XmlTree
  isRngOneOrMore          = hasRngElemName "oneOrMore"
  
  isRngOptional           :: ArrowXml a => a XmlTree XmlTree
  isRngOptional           = hasRngElemName "optional"
  
  isRngParam              :: ArrowXml a => a XmlTree XmlTree
  isRngParam              = hasRngElemName "param"
  
  isRngParentRef          :: ArrowXml a => a XmlTree XmlTree
  isRngParentRef          = hasRngElemName "parentRef"
  
  isRngRef                :: ArrowXml a => a XmlTree XmlTree
  isRngRef                = hasRngElemName "ref"
  
  isRngRelaxError         :: ArrowXml a => a XmlTree XmlTree
  isRngRelaxError         = hasRngElemName "relaxError"
  
  isRngStart              :: ArrowXml a => a XmlTree XmlTree
  isRngStart              = hasRngElemName "start"
  
  isRngText               :: ArrowXml a => a XmlTree XmlTree
  isRngText               = hasRngElemName "text"
  
  isRngType               :: ArrowXml a => a XmlTree XmlTree
  isRngType               = hasRngElemName "type"
  
  isRngValue              :: ArrowXml a => a XmlTree XmlTree
  isRngValue              = hasRngElemName "value"
  
  isRngZeroOrMore         :: ArrowXml a => a XmlTree XmlTree
  isRngZeroOrMore         = hasRngElemName "zeroOrMore"
  
  -- ------------------------------------------------------------
  
  mkRngElement            :: ArrowXml a => String -> a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngElement n          = mkElement (mkQName "" n relaxNamespace)
  
  mkRngChoice             :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngChoice             = mkRngElement "choice"
  
  mkRngDefine             :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngDefine             = mkRngElement "define"
  
  mkRngEmpty              :: ArrowXml a => a n XmlTree -> a n XmlTree
  mkRngEmpty a            = mkRngElement "empty" a none
  
  mkRngGrammar            :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngGrammar            = mkRngElement "grammar"
  
  mkRngGroup              :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngGroup              = mkRngElement "group"
  
  mkRngInterleave         :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngInterleave         = mkRngElement "interleave"
  
  mkRngName               :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngName               = mkRngElement "name"
  
  mkRngNotAllowed         :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngNotAllowed         = mkRngElement "notAllowed"
  
  mkRngOneOrMore          :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngOneOrMore          = mkRngElement "oneOrMore"
  
  mkRngRef                :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngRef                = mkRngElement "ref"
  
  mkRngRelaxError         :: ArrowXml a => a n XmlTree
  mkRngRelaxError         = mkRngElement "relaxError" none none
  
  mkRngStart              :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
  mkRngStart              = mkRngElement "start"
  
  mkRngText               :: ArrowXml a => a n XmlTree -> a n XmlTree
  mkRngText a             = mkRngElement "text" a none
  
  -- ------------------------------------------------------------
  
  setRngName              :: ArrowXml a => String -> a XmlTree XmlTree
  setRngName n            = setElemName (mkQName "" n relaxNamespace)
  
  setRngNameDiv           :: ArrowXml a => a XmlTree XmlTree
  setRngNameDiv           = setRngName "div"
  
  setRngNameRef           :: ArrowXml a => a XmlTree XmlTree
  setRngNameRef           = setRngName "ref"
  
  -- ------------------------------------------------------------
  
  -- Attributes
  
  isRngAttrAttribute              :: ArrowXml a => a XmlTree XmlTree
  isRngAttrAttribute              = hasRngAttName "attribute"
  
  isRngAttrCombine                :: ArrowXml a => a XmlTree XmlTree
  isRngAttrCombine                = hasRngAttName "combine"
  
  isRngAttrDatatypeLibrary        :: ArrowXml a => a XmlTree XmlTree
  isRngAttrDatatypeLibrary        = hasRngAttName "datatypeLibrary"
  
  isRngAttrHref                   :: ArrowXml a => a XmlTree XmlTree
  isRngAttrHref                   = hasRngAttName "href"
  
  isRngAttrName                   :: ArrowXml a => a XmlTree XmlTree
  isRngAttrName                   = hasRngAttName "name"
  
  isRngAttrNs                     :: ArrowXml a => a XmlTree XmlTree
  isRngAttrNs                     = hasRngAttName "ns"
  
  isRngAttrType                   :: ArrowXml a => a XmlTree XmlTree
  isRngAttrType                   = hasRngAttName "type"
  
  isRngAttrRelaxSimplificationChanges     :: ArrowXml a => a XmlTree XmlTree
  isRngAttrRelaxSimplificationChanges     = hasRngAttName a_relaxSimplificationChanges
  
  -- ------------------------------------------------------------
  
  mkRngAttr                       :: ArrowXml a => String -> a b String -> a b XmlTree
  mkRngAttr name value            = mkAttr (mkName name) (value >>> mkText)
  
  mkRngAttrName                   :: ArrowXml a => String -> a b XmlTree
  mkRngAttrName value             = mkRngAttr "name" (constA value)
  
  mkRngAttrRelaxSimplificationChanges     :: ArrowXml a => String -> a b XmlTree
  mkRngAttrRelaxSimplificationChanges value
                                  = mkRngAttr a_relaxSimplificationChanges (constA value)
  
  mkRngAttrDefineOrigName         :: ArrowXml a => String -> a b XmlTree
  mkRngAttrDefineOrigName value   = mkRngAttr defineOrigName (constA value)
  
  mkRngAttrContextBase            :: ArrowXml a => a b String -> a b XmlTree
  mkRngAttrContextBase            = mkRngAttr contextBaseAttr
  
  addRngAttrName                  :: ArrowXml a => String -> a XmlTree XmlTree
  addRngAttrName value            = addAttr "name" value
  
  addRngAttrDescr                 :: ArrowXml a => String -> a XmlTree XmlTree
  addRngAttrDescr                 = addAttr "descr"
  
  addRngAttrChanges               :: ArrowXml a => String -> a XmlTree XmlTree
  addRngAttrChanges               = addAttr "changes"
  
  addRngAttrNs                    :: ArrowXml a => String -> a XmlTree XmlTree
  addRngAttrNs                    = addAttr "ns"
  
  rmRngAttrNs                     :: ArrowXml a => a XmlTree XmlTree
  rmRngAttrNs                     = removeAttr "ns"
  
  -- ------------------------------------------------------------
  
  hasRngAttrRelaxSimplificationChanges             :: ArrowXml a => a XmlTree XmlTree
  hasRngAttrRelaxSimplificationChanges             = hasAttr a_relaxSimplificationChanges
  
  hasRngAttrAttribute             :: ArrowXml a => a XmlTree XmlTree
  hasRngAttrAttribute             = hasAttr "attribute"
  
  hasRngAttrCombine               :: ArrowXml a => a XmlTree XmlTree
  hasRngAttrCombine               = hasAttr "combine"
  
  hasRngAttrDatatypeLibrary       :: ArrowXml a => a XmlTree XmlTree
  hasRngAttrDatatypeLibrary       = hasAttr "datatypeLibrary"
  
  hasRngAttrHref                  :: ArrowXml a => a XmlTree XmlTree
  hasRngAttrHref                  = hasAttr "href"
  
  hasRngAttrName                  :: ArrowXml a => a XmlTree XmlTree
  hasRngAttrName                  = hasAttr "name"
  
  hasRngAttrNs                    :: ArrowXml a => a XmlTree XmlTree
  hasRngAttrNs                    = hasAttr "ns"
  
  hasRngAttrType                  :: ArrowXml a => a XmlTree XmlTree
  hasRngAttrType                  = hasAttr "type"
  
  -- ------------------------------------------------------------
  
  getRngAttrAttribute             :: ArrowXml a => a XmlTree String
  getRngAttrAttribute             = getAttrValue "attribute"
  
  getRngAttrCombine               :: ArrowXml a => a XmlTree String
  getRngAttrCombine               = getAttrValue "combine"
  
  getRngAttrDatatypeLibrary       :: ArrowXml a => a XmlTree String
  getRngAttrDatatypeLibrary       = getAttrValue "datatypeLibrary"
  
  getRngAttrDescr                 :: ArrowXml a => a XmlTree String
  getRngAttrDescr                 = getAttrValue "descr"
  
  getRngAttrHref                  :: ArrowXml a => a XmlTree String
  getRngAttrHref                  = getAttrValue "href"
  
  getRngAttrName                  :: ArrowXml a => a XmlTree String
  getRngAttrName                  = getAttrValue "name"
  
  getRngAttrNs                    :: ArrowXml a => a XmlTree String
  getRngAttrNs                    = getAttrValue "ns"
  
  getRngAttrType                  :: ArrowXml a => a XmlTree String
  getRngAttrType                  = getAttrValue "type"
  
  -- ------------------------------------------------------------
  
  