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

{- |
   Module     : Text.XML.HXT.RelaxNG.BasicArrows
   Copyright  : Copyright (C) 2005 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable
   Version    : $Id$

   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
    hiding
    ( mkText
    , mkError
    )

hasRngName      :: ArrowXml a => String -> a XmlTree XmlTree
hasRngName s
    = hasName s
      `orElse`
      ( hasLocalPart s >>> hasNamespaceUri relaxNamespace )

checkRngName :: ArrowXml a => [String] -> a XmlTree XmlTree
checkRngName l
    = ( isElem
        >>>
        catA (map hasRngName 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            = isElem >>> hasRngName "anyName"

isRngAttribute          :: ArrowXml a => a XmlTree XmlTree
isRngAttribute          = isElem >>> hasRngName "attribute"

isRngChoice             :: ArrowXml a => a XmlTree XmlTree
isRngChoice             = isElem >>> hasRngName "choice"

isRngCombine            :: ArrowXml a => a XmlTree XmlTree
isRngCombine            = isElem >>> hasRngName "combine"

isRngData               :: ArrowXml a => a XmlTree XmlTree
isRngData               = isElem >>> hasRngName "data"

isRngDefine             :: ArrowXml a => a XmlTree XmlTree
isRngDefine             = isElem >>> hasRngName "define"

isRngDiv                :: ArrowXml a => a XmlTree XmlTree
isRngDiv                = isElem >>> hasRngName "div"

isRngElement            :: ArrowXml a => a XmlTree XmlTree
isRngElement            = isElem >>> hasRngName "element"

isRngEmpty              :: ArrowXml a => a XmlTree XmlTree
isRngEmpty              = isElem >>> hasRngName "empty"

isRngExcept             :: ArrowXml a => a XmlTree XmlTree
isRngExcept             = isElem >>> hasRngName "except"

isRngExternalRef        :: ArrowXml a => a XmlTree XmlTree
isRngExternalRef        = isElem >>> hasRngName "externalRef"

isRngGrammar            :: ArrowXml a => a XmlTree XmlTree
isRngGrammar            = isElem >>> hasRngName "grammar"

isRngGroup              :: ArrowXml a => a XmlTree XmlTree
isRngGroup              = isElem >>> hasRngName "group"

isRngInclude            :: ArrowXml a => a XmlTree XmlTree
isRngInclude            = isElem >>> hasRngName "include"

isRngInterleave         :: ArrowXml a => a XmlTree XmlTree
isRngInterleave         = isElem >>> hasRngName "interleave"

isRngList               :: ArrowXml a => a XmlTree XmlTree
isRngList               = isElem >>> hasRngName "list"

isRngMixed              :: ArrowXml a => a XmlTree XmlTree
isRngMixed              = isElem >>> hasRngName "mixed"

isRngName               :: ArrowXml a => a XmlTree XmlTree
isRngName               = isElem >>> hasRngName "name"

isRngNotAllowed         :: ArrowXml a => a XmlTree XmlTree
isRngNotAllowed         = isElem >>> hasRngName "notAllowed"

isRngNsName             :: ArrowXml a => a XmlTree XmlTree
isRngNsName             = isElem >>> hasRngName "nsName"

isRngOneOrMore          :: ArrowXml a => a XmlTree XmlTree
isRngOneOrMore          = isElem >>> hasRngName "oneOrMore"

isRngOptional           :: ArrowXml a => a XmlTree XmlTree
isRngOptional           = isElem >>> hasRngName "optional"

isRngParam              :: ArrowXml a => a XmlTree XmlTree
isRngParam              = isElem >>> hasRngName "param"

isRngParentRef          :: ArrowXml a => a XmlTree XmlTree
isRngParentRef          = isElem >>> hasRngName "parentRef"

isRngRef                :: ArrowXml a => a XmlTree XmlTree
isRngRef                = isElem >>> hasRngName "ref"

isRngRelaxError         :: ArrowXml a => a XmlTree XmlTree
isRngRelaxError         = isElem >>> hasRngName "relaxError"

isRngStart              :: ArrowXml a => a XmlTree XmlTree
isRngStart              = isElem >>> hasRngName "start"

isRngText               :: ArrowXml a => a XmlTree XmlTree
isRngText               = isElem >>> hasRngName "text"

isRngType               :: ArrowXml a => a XmlTree XmlTree
isRngType               = isElem >>> hasRngName "type"

isRngValue              :: ArrowXml a => a XmlTree XmlTree
isRngValue              = isElem >>> hasRngName "value"

isRngZeroOrMore         :: ArrowXml a => a XmlTree XmlTree
isRngZeroOrMore         = isElem >>> hasRngName "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 -> a n XmlTree -> a n XmlTree
mkRngRelaxError         = mkRngElement "relaxError"

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              = isAttr >>> hasRngName "attribute"

isRngAttrCombine                :: ArrowXml a => a XmlTree XmlTree
isRngAttrCombine                = isAttr >>> hasRngName "combine"

isRngAttrDatatypeLibrary        :: ArrowXml a => a XmlTree XmlTree
isRngAttrDatatypeLibrary        = isAttr >>> hasRngName "datatypeLibrary"

isRngAttrHref                   :: ArrowXml a => a XmlTree XmlTree
isRngAttrHref                   = isAttr >>> hasRngName "href"

isRngAttrName                   :: ArrowXml a => a XmlTree XmlTree
isRngAttrName                   = isAttr >>> hasRngName "name"

isRngAttrNs                     :: ArrowXml a => a XmlTree XmlTree
isRngAttrNs                     = isAttr >>> hasRngName "ns"

isRngAttrType                   :: ArrowXml a => a XmlTree XmlTree
isRngAttrType                   = isAttr >>> hasRngName "type"

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

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"

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