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

{- |
   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 :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
s
    = a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttr
      a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasLocalPart String
s
      a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasNamespaceUri String
""

hasRngElemName          :: ArrowXml a => String -> a XmlTree XmlTree
hasRngElemName :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
s
    = a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem
      a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasLocalPart String
s
      a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasNamespaceUri String
relaxNamespace

checkRngName :: ArrowXml a => [String] -> a XmlTree XmlTree
checkRngName :: forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String]
l
    = [a XmlTree XmlTree] -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA ((String -> a XmlTree XmlTree) -> [String] -> [a XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName [String]
l)
      a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
      a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

noOfChildren    :: ArrowXml a => (Int -> Bool) -> a XmlTree XmlTree
noOfChildren :: forall (a :: * -> * -> *).
ArrowXml a =>
(Int -> Bool) -> a XmlTree XmlTree
noOfChildren Int -> Bool
p
    = a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
      a XmlTree XmlTree -> ([XmlTree] -> [XmlTree]) -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
      (\ [XmlTree]
l -> if Int -> Bool
p ([XmlTree] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XmlTree]
l) then [XmlTree]
l else [])

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

isAttributeRef  :: ArrowXml a => a XmlTree XmlTree
isAttributeRef :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRef
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"attribute", String
"ref"]

isAttributeRefTextListGroupInterleaveOneOrMoreEmpty     :: ArrowXml a => a XmlTree XmlTree
isAttributeRefTextListGroupInterleaveOneOrMoreEmpty :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRefTextListGroupInterleaveOneOrMoreEmpty
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"attribute", String
"ref", String
"text", String
"list", String
"group", String
"interleave", String
"oneOrMore", String
"empty"]

isAttributeRefTextListInterleave        :: ArrowXml a => a XmlTree XmlTree
isAttributeRefTextListInterleave :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRefTextListInterleave
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"attribute", String
"ref", String
"text", String
"list", String
"interleave"]

isAttributeListGroupInterleaveOneOrMore :: ArrowXml a => a XmlTree XmlTree
isAttributeListGroupInterleaveOneOrMore :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeListGroupInterleaveOneOrMore
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"attribute", String
"list", String
"group", String
"interleave", String
"oneOrMore"]

isExternalRefInclude    :: ArrowXml a => a XmlTree XmlTree
isExternalRefInclude :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isExternalRefInclude
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"externalRef", String
"include"]

isNameNsNameValue       :: ArrowXml a => a XmlTree XmlTree
isNameNsNameValue :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isNameNsNameValue
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"name", String
"nsName", String
"value"]

isNameNsName    :: ArrowXml a => a XmlTree XmlTree
isNameNsName :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isNameNsName
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"name", String
"nsName"]

isNameAnyNameNsName     :: ArrowXml a => a XmlTree XmlTree
isNameAnyNameNsName :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isNameAnyNameNsName
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"name", String
"anyName", String
"nsName"]

isDefineOneOrMoreZeroOrMoreOptionalListMixed    :: ArrowXml a => a XmlTree XmlTree
isDefineOneOrMoreZeroOrMoreOptionalListMixed :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isDefineOneOrMoreZeroOrMoreOptionalListMixed
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"define", String
"oneOrMore", String
"zeroOrMore", String
"optional", String
"list", String
"mixed"]

isChoiceGroupInterleave :: ArrowXml a => a XmlTree XmlTree
isChoiceGroupInterleave :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isChoiceGroupInterleave
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"choice", String
"group", String
"interleave"]

isChoiceGroupInterleaveOneOrMore        :: ArrowXml a => a XmlTree XmlTree
isChoiceGroupInterleaveOneOrMore :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isChoiceGroupInterleaveOneOrMore
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"choice", String
"group", String
"interleave", String
"oneOrMore"]

isGroupInterleave       :: ArrowXml a => a XmlTree XmlTree
isGroupInterleave :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isGroupInterleave
    = [String] -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[String] -> a XmlTree XmlTree
checkRngName [String
"group", String
"interleave"]

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

isRngAnyName            :: ArrowXml a => a XmlTree XmlTree
isRngAnyName :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAnyName            = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"anyName"

isRngAttribute          :: ArrowXml a => a XmlTree XmlTree
isRngAttribute :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute          = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"attribute"

isRngChoice             :: ArrowXml a => a XmlTree XmlTree
isRngChoice :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngChoice             = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"choice"

isRngCombine            :: ArrowXml a => a XmlTree XmlTree
isRngCombine :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngCombine            = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"combine"

isRngData               :: ArrowXml a => a XmlTree XmlTree
isRngData :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngData               = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"data"

isRngDefine             :: ArrowXml a => a XmlTree XmlTree
isRngDefine :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine             = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"define"

isRngDiv                :: ArrowXml a => a XmlTree XmlTree
isRngDiv :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDiv                = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"div"

isRngElement            :: ArrowXml a => a XmlTree XmlTree
isRngElement :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement            = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"element"

isRngEmpty              :: ArrowXml a => a XmlTree XmlTree
isRngEmpty :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty              = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"empty"

isRngExcept             :: ArrowXml a => a XmlTree XmlTree
isRngExcept :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExcept             = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"except"

isRngExternalRef        :: ArrowXml a => a XmlTree XmlTree
isRngExternalRef :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExternalRef        = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"externalRef"

isRngGrammar            :: ArrowXml a => a XmlTree XmlTree
isRngGrammar :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar            = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"grammar"

isRngGroup              :: ArrowXml a => a XmlTree XmlTree
isRngGroup :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGroup              = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"group"

isRngInclude            :: ArrowXml a => a XmlTree XmlTree
isRngInclude :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngInclude            = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"include"

isRngInterleave         :: ArrowXml a => a XmlTree XmlTree
isRngInterleave :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngInterleave         = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"interleave"

isRngList               :: ArrowXml a => a XmlTree XmlTree
isRngList :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngList               = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"list"

isRngMixed              :: ArrowXml a => a XmlTree XmlTree
isRngMixed :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngMixed              = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"mixed"

isRngName               :: ArrowXml a => a XmlTree XmlTree
isRngName :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngName               = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"name"

isRngNotAllowed         :: ArrowXml a => a XmlTree XmlTree
isRngNotAllowed :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNotAllowed         = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"notAllowed"

isRngNsName             :: ArrowXml a => a XmlTree XmlTree
isRngNsName :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNsName             = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"nsName"

isRngOneOrMore          :: ArrowXml a => a XmlTree XmlTree
isRngOneOrMore :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngOneOrMore          = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"oneOrMore"

isRngOptional           :: ArrowXml a => a XmlTree XmlTree
isRngOptional :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngOptional           = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"optional"

isRngParam              :: ArrowXml a => a XmlTree XmlTree
isRngParam :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngParam              = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"param"

isRngParentRef          :: ArrowXml a => a XmlTree XmlTree
isRngParentRef :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngParentRef          = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"parentRef"

isRngRef                :: ArrowXml a => a XmlTree XmlTree
isRngRef :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRef                = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"ref"

isRngRelaxError         :: ArrowXml a => a XmlTree XmlTree
isRngRelaxError :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError         = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"relaxError"

isRngStart              :: ArrowXml a => a XmlTree XmlTree
isRngStart :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngStart              = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"start"

isRngText               :: ArrowXml a => a XmlTree XmlTree
isRngText :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngText               = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"text"

isRngType               :: ArrowXml a => a XmlTree XmlTree
isRngType :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngType               = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"type"

isRngValue              :: ArrowXml a => a XmlTree XmlTree
isRngValue :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue              = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"value"

isRngZeroOrMore         :: ArrowXml a => a XmlTree XmlTree
isRngZeroOrMore :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngZeroOrMore         = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
"zeroOrMore"

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

mkRngElement            :: ArrowXml a => String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement :: forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
n          = QName -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
QName -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkElement (String -> String -> String -> QName
mkQName String
"" String
n String
relaxNamespace)

mkRngChoice             :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngChoice :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngChoice             = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"choice"

mkRngDefine             :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngDefine :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngDefine             = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"define"

mkRngEmpty              :: ArrowXml a => a n XmlTree -> a n XmlTree
mkRngEmpty :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngEmpty a n XmlTree
a            = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"empty" a n XmlTree
a a n XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none

mkRngGrammar            :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngGrammar :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngGrammar            = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"grammar"

mkRngGroup              :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngGroup :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngGroup              = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"group"

mkRngInterleave         :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngInterleave :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngInterleave         = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"interleave"

mkRngName               :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngName :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngName               = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"name"

mkRngNotAllowed         :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngNotAllowed :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngNotAllowed         = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"notAllowed"

mkRngOneOrMore          :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngOneOrMore :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngOneOrMore          = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"oneOrMore"

mkRngRef                :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngRef :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngRef                = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"ref"

mkRngRelaxError         :: ArrowXml a => a n XmlTree
mkRngRelaxError :: forall (a :: * -> * -> *) n. ArrowXml a => a n XmlTree
mkRngRelaxError         = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"relaxError" a n XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none a n XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none

mkRngStart              :: ArrowXml a => a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngStart :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngStart              = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"start"

mkRngText               :: ArrowXml a => a n XmlTree -> a n XmlTree
mkRngText :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngText a n XmlTree
a             = String -> a n XmlTree -> a n XmlTree -> a n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
"text" a n XmlTree
a a n XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none

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

setRngName              :: ArrowXml a => String -> a XmlTree XmlTree
setRngName :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
setRngName String
n            = QName -> a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => QName -> a XmlTree XmlTree
setElemName (String -> String -> String -> QName
mkQName String
"" String
n String
relaxNamespace)

setRngNameDiv           :: ArrowXml a => a XmlTree XmlTree
setRngNameDiv :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
setRngNameDiv           = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
setRngName String
"div"

setRngNameRef           :: ArrowXml a => a XmlTree XmlTree
setRngNameRef :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
setRngNameRef           = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
setRngName String
"ref"

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

-- Attributes

isRngAttrAttribute              :: ArrowXml a => a XmlTree XmlTree
isRngAttrAttribute :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrAttribute              = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
"attribute"

isRngAttrCombine                :: ArrowXml a => a XmlTree XmlTree
isRngAttrCombine :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrCombine                = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
"combine"

isRngAttrDatatypeLibrary        :: ArrowXml a => a XmlTree XmlTree
isRngAttrDatatypeLibrary :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrDatatypeLibrary        = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
"datatypeLibrary"

isRngAttrHref                   :: ArrowXml a => a XmlTree XmlTree
isRngAttrHref :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrHref                   = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
"href"

isRngAttrName                   :: ArrowXml a => a XmlTree XmlTree
isRngAttrName :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrName                   = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
"name"

isRngAttrNs                     :: ArrowXml a => a XmlTree XmlTree
isRngAttrNs :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrNs                     = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
"ns"

isRngAttrType                   :: ArrowXml a => a XmlTree XmlTree
isRngAttrType :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrType                   = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
"type"

isRngAttrRelaxSimplificationChanges     :: ArrowXml a => a XmlTree XmlTree
isRngAttrRelaxSimplificationChanges :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrRelaxSimplificationChanges     = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngAttName String
a_relaxSimplificationChanges

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

mkRngAttr                       :: ArrowXml a => String -> a b String -> a b XmlTree
mkRngAttr :: forall (a :: * -> * -> *) b.
ArrowXml a =>
String -> a b String -> a b XmlTree
mkRngAttr String
name a b String
value            = QName -> a b XmlTree -> a b XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
QName -> a n XmlTree -> a n XmlTree
mkAttr (String -> QName
mkName String
name) (a b String
value a b String -> a String XmlTree -> a b XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a String XmlTree
forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText)

mkRngAttrName                   :: ArrowXml a => String -> a b XmlTree
mkRngAttrName :: forall (a :: * -> * -> *) b. ArrowXml a => String -> a b XmlTree
mkRngAttrName String
value             = String -> a b String -> a b XmlTree
forall (a :: * -> * -> *) b.
ArrowXml a =>
String -> a b String -> a b XmlTree
mkRngAttr String
"name" (String -> a b String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
value)

mkRngAttrRelaxSimplificationChanges     :: ArrowXml a => String -> a b XmlTree
mkRngAttrRelaxSimplificationChanges :: forall (a :: * -> * -> *) b. ArrowXml a => String -> a b XmlTree
mkRngAttrRelaxSimplificationChanges String
value
                                = String -> a b String -> a b XmlTree
forall (a :: * -> * -> *) b.
ArrowXml a =>
String -> a b String -> a b XmlTree
mkRngAttr String
a_relaxSimplificationChanges (String -> a b String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
value)

mkRngAttrDefineOrigName         :: ArrowXml a => String -> a b XmlTree
mkRngAttrDefineOrigName :: forall (a :: * -> * -> *) b. ArrowXml a => String -> a b XmlTree
mkRngAttrDefineOrigName String
value   = String -> a b String -> a b XmlTree
forall (a :: * -> * -> *) b.
ArrowXml a =>
String -> a b String -> a b XmlTree
mkRngAttr String
defineOrigName (String -> a b String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
value)

mkRngAttrContextBase            :: ArrowXml a => a b String -> a b XmlTree
mkRngAttrContextBase :: forall (a :: * -> * -> *) b.
ArrowXml a =>
a b String -> a b XmlTree
mkRngAttrContextBase            = String -> a b String -> a b XmlTree
forall (a :: * -> * -> *) b.
ArrowXml a =>
String -> a b String -> a b XmlTree
mkRngAttr String
contextBaseAttr

addRngAttrName                  :: ArrowXml a => String -> a XmlTree XmlTree
addRngAttrName :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrName String
value            = String -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"name" String
value

addRngAttrDescr                 :: ArrowXml a => String -> a XmlTree XmlTree
addRngAttrDescr :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrDescr                 = String -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"descr"

addRngAttrChanges               :: ArrowXml a => String -> a XmlTree XmlTree
addRngAttrChanges :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrChanges               = String -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"changes"

addRngAttrNs                    :: ArrowXml a => String -> a XmlTree XmlTree
addRngAttrNs :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrNs                    = String -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"ns"

rmRngAttrNs                     :: ArrowXml a => a XmlTree XmlTree
rmRngAttrNs :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
rmRngAttrNs                     = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
removeAttr String
"ns"

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

hasRngAttrRelaxSimplificationChanges             :: ArrowXml a => a XmlTree XmlTree
hasRngAttrRelaxSimplificationChanges :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrRelaxSimplificationChanges             = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
a_relaxSimplificationChanges

hasRngAttrAttribute             :: ArrowXml a => a XmlTree XmlTree
hasRngAttrAttribute :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrAttribute             = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
"attribute"

hasRngAttrCombine               :: ArrowXml a => a XmlTree XmlTree
hasRngAttrCombine :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrCombine               = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
"combine"

hasRngAttrDatatypeLibrary       :: ArrowXml a => a XmlTree XmlTree
hasRngAttrDatatypeLibrary :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrDatatypeLibrary       = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
"datatypeLibrary"

hasRngAttrHref                  :: ArrowXml a => a XmlTree XmlTree
hasRngAttrHref :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrHref                  = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
"href"

hasRngAttrName                  :: ArrowXml a => a XmlTree XmlTree
hasRngAttrName :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrName                  = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
"name"

hasRngAttrNs                    :: ArrowXml a => a XmlTree XmlTree
hasRngAttrNs :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrNs                    = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
"ns"

hasRngAttrType                  :: ArrowXml a => a XmlTree XmlTree
hasRngAttrType :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrType                  = String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
"type"

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

getRngAttrAttribute             :: ArrowXml a => a XmlTree String
getRngAttrAttribute :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrAttribute             = String -> a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"attribute"

getRngAttrCombine               :: ArrowXml a => a XmlTree String
getRngAttrCombine :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrCombine               = String -> a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"combine"

getRngAttrDatatypeLibrary       :: ArrowXml a => a XmlTree String
getRngAttrDatatypeLibrary :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrDatatypeLibrary       = String -> a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"datatypeLibrary"

getRngAttrDescr                 :: ArrowXml a => a XmlTree String
getRngAttrDescr :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrDescr                 = String -> a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"descr"

getRngAttrHref                  :: ArrowXml a => a XmlTree String
getRngAttrHref :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrHref                  = String -> a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"href"

getRngAttrName                  :: ArrowXml a => a XmlTree String
getRngAttrName :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName                  = String -> a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"name"

getRngAttrNs                    :: ArrowXml a => a XmlTree String
getRngAttrNs :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrNs                    = String -> a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"ns"

getRngAttrType                  :: ArrowXml a => a XmlTree String
getRngAttrType :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrType                  = String -> a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"type"

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