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

{- |
   Module     : Text.XML.HXT.RelaxNG.Simplification
   Copyright  : Copyright (C) 2008 Torben Kuseler, Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   The modul creates the simplified form of a Relax NG schema.
   See also chapter 4 of the Relax NG specification.

-}

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

module Text.XML.HXT.RelaxNG.Simplification
  ( createSimpleForm
  , getErrors
  , resetStates
  )

where


import Control.Arrow.ListArrows

import Text.XML.HXT.DOM.Interface

import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.Edit                  ( removeWhiteSpace
                                                )
import Text.XML.HXT.Arrow.Namespace             ( processWithNsEnv
                                                )
import Text.XML.HXT.Arrow.XmlState
import Text.XML.HXT.Arrow.XmlState.TypeDefs

import Text.XML.HXT.RelaxNG.DataTypes
import Text.XML.HXT.RelaxNG.BasicArrows
import Text.XML.HXT.RelaxNG.CreatePattern
import Text.XML.HXT.RelaxNG.DataTypeLibraries
import Text.XML.HXT.RelaxNG.Utils
import Text.XML.HXT.RelaxNG.Validation
import Text.XML.HXT.RelaxNG.Schema        as S
import Text.XML.HXT.RelaxNG.SchemaGrammar as SG

import Data.Maybe
    ( fromJust
    , fromMaybe
    )
import Data.List
    ( (\\)
    )
import Data.Map
    ( Map, fromListWithKey, toList )

infixr 1 !>>>

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

{-
- 4.1. Annotations: Foreign attributes and elements are removed.
- 4.2. Whitespace:
    - For each element other than value and param, each child that is a string
      containing only whitespace characters is removed.
    - Leading and trailing whitespace characters are removed from the value of each name,
      type and combine attribute and from the content of each name element.
- 4.3. datatypeLibrary attribute:
    - The value of each datatypeLibary attribute is transformed by escaping disallowed characters
    - For any data or value element that does not have a datatypeLibrary attribute,
      a datatypeLibrary attribute is added.
    - Any datatypeLibrary attribute that is on an element other than data or value is removed.
- 4.4. type attribute of value element
-}
simplificationStep1 :: IOSArrow XmlTree XmlTree
simplificationStep1 :: IOSArrow XmlTree XmlTree
simplificationStep1
    = ( {-
        - 4.5. href attribute
        - The value of the href attribute on an externalRef or include element is first
        - transformed by escaping disallowed characters
        - The URI reference is then resolved into an absolute form
        - The value of the href attribute will be used to construct an element.
        -}
        ( String -> IOSArrow XmlTree XmlTree
processHref (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState ()) XmlTree String
forall s b. IOStateArrow s b String
getBaseURI )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        -- 4.10 QNames
        (NsEnv -> IOSArrow XmlTree XmlTree)
-> NsEnv -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(NsEnv -> a XmlTree XmlTree) -> NsEnv -> a XmlTree XmlTree
processWithNsEnv NsEnv -> IOSArrow XmlTree XmlTree
processEnvNames (RefList -> NsEnv
toNsEnv [(String
"xml", String
xmlNamespace)])
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        -- 4.4 For any data or value element that does not have a datatypeLibrary attribute,
        -- a datatypeLibrary attribute is added.
        -- Wird vorgezogen, da danach der Rest in einem Baumdurchlauf erledigt werden kann
        String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
processdatatypeLib String
""
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processTopDownWithAttrl
        (
         ( -- 4.1 Foreign attributes and elements are removed
           IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
           IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
           ( ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot
               IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
               IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getNamespaceUri
               IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
               (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ String
uri -> (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool
compareURI String
uri String
relaxNamespace))
             )
             IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
             ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttr
               IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
               IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getNamespaceUri
               IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
               (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ String
uri -> (String
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool
compareURI String
uri String
relaxNamespace)))
             )
           )
         )
         IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
         ( -- 4.2 For each element other than value and param, each child that
           -- is a string containing only whitespace characters is removed.
           ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
removeWhiteSpace
             IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
             (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngParam IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue)
           )
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem
         )
         IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
         ( -- 4.2 Leading and trailing whitespace characters are removed from the value
           -- of each name, type and combine attribute ...
           (String -> String) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeAttrValue String -> String
normalizeWhitespace
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
           ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrName IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrType IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrCombine)
         )
         IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
         ( -- 4.2 ... and from the content of each name element.
           IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren ((String -> String) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeText String -> String
normalizeWhitespace)
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
           IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngName
         )
         IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
         ( -- 4.3 The value of each datatypeLibary attribute is transformed
           -- by escaping disallowed characters
           (String -> String) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeAttrValue String -> String
escapeURI
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
           IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrDatatypeLibrary
         )
         IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
         ( -- The value of the datatypeLibary attribute has to be a valid URI
           ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrDatatypeLibrary
                                  IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
a -> ( String
"datatypeLibrary attribute: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid URI"
                                              )
                                      )
                                )
           )
           IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
           ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem
             IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
             IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrDatatypeLibrary
             IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
             IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrDatatypeLibrary IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isRelaxAnyURI)
           )
         )
         IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
         ( -- 4.3 Any datatypeLibrary attribute that is on an element
           -- other than data or value is removed.
           String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
removeAttr String
"datatypeLibrary"
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
           ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem
             IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
             IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngData IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue)
             IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
             IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrDatatypeLibrary
           )
         )
         IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
         ( -- 4.4 For any value element that does not have a type attribute,
           -- a type attribute is added with value token and the value of
           -- the datatypeLibrary attribute is changed to the empty string.
           ( String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"type" String
"token"
             IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"datatypeLibrary" String
""
           )
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
           ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrType )
         )
        )
      ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors
    where
    processHref :: String -> IOSArrow XmlTree XmlTree
    processHref :: String -> IOSArrow XmlTree XmlTree
processHref String
uri
        = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
          ( [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
            [ ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasAttr String
"xml:base" )
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isExternalRefInclude IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrHref )
                    ( -- The value of the href attribute is transformed by
                      -- escaping disallowed characters
                      (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processAttrl ((String -> String) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeAttrValue String -> String
escapeURI IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrHref))
                      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> -- compute the new base uri from the old uri and the href attribute
                      (String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"href" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (String -> String -> IOSLA (XIOState ()) XmlTree String
absURI String
"href" (String -> IOSLA (XIOState ()) XmlTree String)
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (String -> String -> IOSLA (XIOState ()) XmlTree String
absURI String
"xml:base" String
uri)))
                      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
processHref (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> String -> IOSLA (XIOState ()) XmlTree String
absURI String
"xml:base" String
uri)
                    ) -- element without a href attribute, just compute the new base uri
                    (String -> IOSArrow XmlTree XmlTree
processHref (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> String -> IOSLA (XIOState ()) XmlTree String
absURI String
"xml:base" String
uri)
                  )
            , ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isExternalRefInclude IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrHref )
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( -- The value of the href attribute is transformed by
                    -- escaping disallowed characters
                    (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processAttrl ((String -> String) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeAttrValue String -> String
escapeURI IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrHref))
                    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"href" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> String -> IOSLA (XIOState ()) XmlTree String
absURI String
"href" String
uri)
                  )
            , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> String -> IOSArrow XmlTree XmlTree
processHref String
uri
            ]
          )
        where
        absURI :: String -> String -> IOSArrow XmlTree String
        absURI :: String -> String -> IOSLA (XIOState ()) XmlTree String
absURI String
attrName String
u
            = ( String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
attrName
                IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
a -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (String -> String -> Maybe String
expandURIString String
a String
u))
                IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) String String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> -- the uri should not have a fragment-identifier (4.5)
                ( (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (String
"illegal URI, fragment identifier not allowed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
                  IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
                  (IOSLA (XIOState ()) String String
forall (a :: * -> * -> *). ArrowList a => a String String
getFragmentFromURI IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) String String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                )
              )

    processEnvNames :: NsEnv -> IOSArrow XmlTree XmlTree
    processEnvNames :: NsEnv -> IOSArrow XmlTree XmlTree
processEnvNames NsEnv
env
        = ( ( (NsEnv -> String -> IOSArrow XmlTree XmlTree
replaceQNames NsEnv
env (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"name")
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
              ( (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute)
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrName
              )
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            ( (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
addAttrl (IOSLA (XIOState ()) XmlTree String
forall s b. IOStateArrow s b String
getBaseURI IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) String XmlTree
createAttrL))
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue
            )
          )
        where

        createAttrL :: IOSArrow String XmlTree
        createAttrL :: IOSLA (XIOState ()) String XmlTree
createAttrL
            = IOSLA (XIOState ()) String XmlTree
setBaseUri
              IOSLA (XIOState ()) String XmlTree
-> IOSLA (XIOState ()) String XmlTree
-> IOSLA (XIOState ()) String XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
              ( LA String XmlTree -> IOSLA (XIOState ()) String XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA String XmlTree -> IOSLA (XIOState ()) String XmlTree)
-> LA String XmlTree -> IOSLA (XIOState ()) String XmlTree
forall a b. (a -> b) -> a -> b
$ String -> LA String XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt String
"" LA String XmlTree -> LA XmlTree XmlTree -> LA String XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [LA XmlTree XmlTree] -> LA XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA (((XName, XName) -> LA XmlTree XmlTree)
-> NsEnv -> [LA XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map (XName, XName) -> LA XmlTree XmlTree
createAttr NsEnv
env) )
            where
{- old stuff
            createAttr :: (XName, XName) -> LA XmlTree XmlTree
            createAttr (pre, uri)
                = mkRngAttr nm (constA $ show uri)
                where
                nm  | isNullXName pre   = contextAttributesDefault
                    | otherwise         = contextAttributes ++ show pre
-}

            createAttr :: (XName, XName) -> LA XmlTree XmlTree
            createAttr :: (XName, XName) -> LA XmlTree XmlTree
createAttr (XName
pre, XName
uri)
                = QName -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
QName -> a n XmlTree -> a n XmlTree
mkAttr QName
qn (String -> LA XmlTree XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt (XName -> String
unXN XName
uri))
                where
                qn :: QName
                qn :: QName
qn  | XName -> Bool
isNullXName XName
pre   = String -> QName
mkName (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ String
contextAttributesDefault
                    | Bool
otherwise         = String -> QName
mkName (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ String
contextAttributes String -> String -> String
forall a. [a] -> [a] -> [a]
++ XName -> String
unXN XName
pre

            setBaseUri :: IOSArrow String XmlTree
            setBaseUri :: IOSLA (XIOState ()) String XmlTree
setBaseUri = IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) String XmlTree
forall (a :: * -> * -> *) b.
ArrowXml a =>
a b String -> a b XmlTree
mkRngAttrContextBase IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

        replaceQNames :: NsEnv -> String -> IOSArrow XmlTree XmlTree
        replaceQNames :: NsEnv -> String -> IOSArrow XmlTree XmlTree
replaceQNames NsEnv
env' String
name
            | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
px                                   -- no prefix, nothing to do
                = IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
            | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ns                                   -- prefix there, but no namespace
                = String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" ( String
"No namespace mapping for the prefix " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
px String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                    String
" in the context of element: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                    String
", namespace env is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RefList -> String
forall a. Show a => a -> String
show (((XName, XName) -> (String, String)) -> NsEnv -> RefList
forall a b. (a -> b) -> [a] -> [b]
map (XName -> String
unXN (XName -> String)
-> (XName -> String) -> (XName, XName) -> (String, String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** XName -> String
unXN) NsEnv
env')
                                  )
            | Bool
otherwise                                 -- build universal name
                = String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"name" (QName -> String
universalName QName
qn)
            where
            qn :: QName
qn = NsEnv -> QName -> QName
setNamespace NsEnv
env' (QName -> QName) -> (String -> QName) -> String -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QName
mkName (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ String
name
            px :: String
px = QName -> String
namePrefix   QName
qn
            ns :: String
ns = QName -> String
namespaceUri QName
qn

    -- The value of the added datatypeLibrary attribute is the value of the
    -- datatypeLibrary attribute of the nearest ancestor element that
    -- has a datatypeLibrary attribute, or the empty string
    -- if there is no such ancestor.
    processdatatypeLib :: (ArrowXml a) => String -> a XmlTree XmlTree
    processdatatypeLib :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
processdatatypeLib String
lib
        = a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (a XmlTree XmlTree -> a XmlTree XmlTree)
-> a XmlTree XmlTree -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
          [IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)]
-> a XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
          [ a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrDatatypeLibrary
            a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
processdatatypeLib (String -> a XmlTree XmlTree)
-> a XmlTree String -> a XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrDatatypeLibrary )             -- set the new datatypeLibrary value

          , ( (a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngData a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue)
              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
>>>
              a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrDatatypeLibrary
            )
            a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( String -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"datatypeLibrary" String
lib                                 -- add a datatypeLibrary attribute
                  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
processdatatypeLib String
lib
                )

          , a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
            a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
processdatatypeLib String
lib
          ]
          a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem

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


{-
- 4.5. href attribute
    - see simplificationStep1
- 4.6. externalRef element
    - An element is constructed using the URI reference
      that is the value of href attribute
    - This element must match the syntax for pattern.
    - The element is transformed by recursively applying the rules from
      this subsection and from previous subsections of this section.
    - This must not result in a loop.
    - Any ns attribute on the externalRef element is transferred
      to the referenced element if the referenced element does
      not already have an ns attribute.
    - The externalRef element is then replaced by the referenced element.
- 4.7. include element
    - An element is constructed using the URI reference that is the
      value of href attribute
    - This element must be a grammar element, matching the syntax for grammar.
    - This grammar element is transformed by recursively applying the rules
      from this subsection and from previous subsections of this section.
    - This must not result in a loop.

    - If the include element has a start component, then the grammar element
      must have a start component.
    - If the include element has a start component, then all start components
      are removed from the grammar element.
    - If the include element has a define component, then the grammar element
      must have a define component with the same name.
    - For every define component of the include element, all define components
      with the same name are removed from the grammar element.

    - The include element is transformed into a div element.
    - The attributes of the div element are the attributes of the
      include element other than the href attribute.
    - The children of the div element are the grammar element
    - The grammar element is then renamed to div.
-}

simplificationStep2 :: Bool -> Bool -> [Uri] -> [Uri] -> IOSArrow XmlTree XmlTree
simplificationStep2 :: Bool -> Bool -> [String] -> [String] -> IOSArrow XmlTree XmlTree
simplificationStep2 Bool
validateExternalRef Bool
validateInclude [String]
extHRefs [String]
includeHRefs =
  ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (
      ( (String -> String -> IOSArrow XmlTree XmlTree
importExternalRef (String -> String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, String)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< (IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrNs IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrHref))
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExternalRef
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
importInclude (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"href")
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngInclude
      )
    )
  ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors
  where
  -- returns the contents of the (validated) schema
  -- or a relax error
  importExternalRef     :: String -> String -> IOSArrow XmlTree XmlTree
  importExternalRef :: String -> String -> IOSArrow XmlTree XmlTree
importExternalRef String
ns String
href
      | String
href String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
extHRefs
          = String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
            (  String
"loop in externalRef-Pattern, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
formatStringListArr ([String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
hrefString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
extHRefs) )
      | Bool
otherwise
          = String -> IOSArrow XmlTree XmlTree
forall b. String -> IOSArrow b XmlTree
readForRelax String
href
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" (String -> String
forall a. Show a => a -> String
show String
href String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": can't read URI, referenced in externalRef-Pattern")
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
documentStatusOk
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
!>>>
            ( if Bool
validateExternalRef                                            -- if validation parameters are set
              then ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
                     ( String
"The content of the schema " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
href String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
", referenced in externalRef does not " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
"match the syntax for pattern"
                     )
                     IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
                     IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
validateWithRelax IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b XmlTree
S.relaxSchemaArrow                       -- the referenced schema is validated with respect to
                   )
                else IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
              )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
!>>>
            ( IOSArrow XmlTree XmlTree
simplificationStep1                                               -- perform the transformations from previous steps
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Bool -> Bool -> [String] -> [String] -> IOSArrow XmlTree XmlTree
simplificationStep2 Bool
validateExternalRef Bool
validateInclude (String
hrefString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
extHRefs) [String]
includeHRefs
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren                                                       -- remove the root node
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ( -- Any ns attribute on the externalRef element
                -- is transferred to the referenced element
                String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrNs String
ns
                IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                (IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrNs IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ String
a -> String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
&& String
ns String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""))
              )
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc (String
"imported external ref: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
href)

  importInclude :: String -> IOSArrow XmlTree XmlTree
  importInclude :: String -> IOSArrow XmlTree XmlTree
importInclude String
href
      | String
href String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
includeHRefs
          = String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
            ( String
"loop in include-Pattern, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
formatStringListArr ([String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
hrefString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
includeHRefs) )
      | Bool
otherwise
          = XmlTree -> IOSArrow XmlTree XmlTree
processInclude' (XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSArrow XmlTree XmlTree
forall {a}. IOSLA (XIOState ()) a XmlTree
newDoc
      where
      processInclude' :: XmlTree -> IOSArrow XmlTree XmlTree
processInclude' XmlTree
newDoc'
          | Bool -> Bool
not (Bool -> Bool) -> (XmlTree -> Bool) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> (XmlTree -> [XmlTree]) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree XmlTree -> XmlTree -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError (XmlTree -> Bool) -> XmlTree -> Bool
forall a b. (a -> b) -> a -> b
$ XmlTree
newDoc'
              = XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA XmlTree
newDoc'
          | Bool
otherwise
              = String -> XmlTree -> IOSArrow XmlTree XmlTree
processInclude String
href XmlTree
newDoc'
      newDoc :: IOSLA (XIOState ()) a XmlTree
newDoc
          = String -> IOSLA (XIOState ()) a XmlTree
forall b. String -> IOSArrow b XmlTree
readForRelax String
href
            IOSLA (XIOState ()) a XmlTree
-> IOSArrow XmlTree XmlTree -> IOSLA (XIOState ()) a XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" (String -> String
forall a. Show a => a -> String
show String
href String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": can't read URI, referenced in include-Pattern")
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
documentStatusOk
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
!>>>
            ( if Bool
validateInclude                                        -- if validation parameters are set
              then ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
                     ( String
"The content of the schema " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
href String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
", referenced in include does not " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
"match the syntax for grammar"
                     )
                     IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
                     IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
validateWithRelax IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b XmlTree
SG.relaxSchemaArrow              -- the referenced schema is validated with respect to
                   )
              else IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
!>>>
            ( IOSArrow XmlTree XmlTree
simplificationStep1                                       -- perform the transformations from previous steps
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Bool -> Bool -> [String] -> [String] -> IOSArrow XmlTree XmlTree
simplificationStep2 Bool
validateExternalRef Bool
validateInclude [String]
extHRefs (String
hrefString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
includeHRefs)
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren                                               -- remove the root node
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem
            )

  processInclude :: String -> XmlTree -> IOSArrow XmlTree XmlTree
  processInclude :: String -> XmlTree -> IOSArrow XmlTree XmlTree
processInclude String
href XmlTree
newDoc
    = -- The include element is transformed into a div element.
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
setRngNameDiv
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      -- The attributes of the div element are the attributes of
      -- the include element other than the href attribute.
      String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
removeAttr String
"href"
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> XmlTree -> IOSArrow XmlTree XmlTree
checkInclude String
href XmlTree
newDoc


  insertNewDoc :: XmlTree -> Bool -> [String] -> IOSArrow XmlTree XmlTree
  insertNewDoc :: XmlTree -> Bool -> [String] -> IOSArrow XmlTree XmlTree
insertNewDoc XmlTree
newDoc Bool
hasStart [String]
defNames
    = Int -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
Int -> a (t b) (t b) -> a (t b) (t b)
insertChildrenAt Int
0 (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
        XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA XmlTree
newDoc
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        -- If the include element has a start component, then all start components
        -- are removed from the grammar element.
        (IOSArrow XmlTree XmlTree
removeStartComponent IOSArrow XmlTree XmlTree
-> (XmlTree -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b.
ArrowIf a =>
a b b -> (b -> Bool) -> a b b
`whenP` (Bool -> XmlTree -> Bool
forall a b. a -> b -> a
const Bool
hasStart))
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        -- For every define component of the include element, all define components
        -- with the same name are removed from the grammar element.
        (([String] -> IOSArrow XmlTree XmlTree
removeDefineComponent [String]
defNames) IOSArrow XmlTree XmlTree
-> (XmlTree -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b.
ArrowIf a =>
a b b -> (b -> Bool) -> a b b
`whenP` (Bool -> XmlTree -> Bool
forall a b. a -> b -> a
const (Bool -> XmlTree -> Bool) -> Bool -> XmlTree -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
defNames [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []))
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        -- The grammar element is then renamed to div.
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
setRngNameDiv


  checkInclude :: String -> XmlTree -> IOSArrow XmlTree XmlTree
  checkInclude :: String -> XmlTree -> IOSArrow XmlTree XmlTree
checkInclude String
href XmlTree
newDoc
    = IOSLA (XIOState ()) XmlTree (Bool, Bool)
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( -- If the include element has a start component, then the grammar element
            -- must have a start component.
            IOSArrow XmlTree Bool
hasStartComponent IOSArrow XmlTree Bool
-> IOSArrow XmlTree Bool
-> IOSLA (XIOState ()) XmlTree (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA XmlTree
newDoc IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree Bool -> IOSArrow XmlTree Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree Bool
hasStartComponent)
            IOSLA (XIOState ()) XmlTree (Bool, Bool)
-> IOSLA (XIOState ()) (Bool, Bool) (Bool, Bool)
-> IOSLA (XIOState ()) XmlTree (Bool, Bool)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            ((Bool, Bool) -> Bool)
-> IOSLA (XIOState ()) (Bool, Bool) (Bool, Bool)
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ (Bool
a, Bool
b) -> if Bool
a then Bool
b else Bool
True)
          )
        ( IOSLA (XIOState ()) XmlTree ([String], [String])
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( -- If the include element has a define component, then the grammar element
                -- must have a define component with the same name.
                IOSArrow XmlTree [String]
getDefineComponents IOSArrow XmlTree [String]
-> IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) XmlTree ([String], [String])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA XmlTree
newDoc IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree [String] -> IOSArrow XmlTree [String]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree [String]
getDefineComponents)
                IOSLA (XIOState ()) XmlTree ([String], [String])
-> IOSLA (XIOState ()) ([String], [String]) ([String], [String])
-> IOSLA (XIOState ()) XmlTree ([String], [String])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                (([String], [String]) -> Bool)
-> IOSLA (XIOState ()) ([String], [String]) ([String], [String])
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ ([String]
a, [String]
b) -> ([String] -> [String] -> [String]
forall {a}. Eq a => [a] -> [a] -> [a]
diff [String]
a [String]
b) [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [])
              )
            (XmlTree -> Bool -> [String] -> IOSArrow XmlTree XmlTree
insertNewDoc XmlTree
newDoc (Bool -> [String] -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (Bool, [String])
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< IOSArrow XmlTree Bool
hasStartComponent IOSArrow XmlTree Bool
-> IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) XmlTree (Bool, [String])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSArrow XmlTree [String]
getDefineComponents)
            ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
              ( String
"Define-pattern missing in schema " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
href String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
", referenced in include-pattern"
              )
            )
        )
        ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"Grammar-element without a start-pattern in schema " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String -> String
forall a. Show a => a -> String
show String
href String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", referenced in include-pattern"
          )
        )
    where
    diff :: [a] -> [a] -> [a]
diff [a]
a [a]
b = ([a] -> [a]
forall a. Eq a => [a] -> [a]
noDoubles [a]
a) [a] -> [a] -> [a]
forall {a}. Eq a => [a] -> [a] -> [a]
\\ ([a] -> [a]
forall a. Eq a => [a] -> [a]
noDoubles [a]
b)

  removeStartComponent :: IOSArrow XmlTree XmlTree
  removeStartComponent :: IOSArrow XmlTree XmlTree
removeStartComponent
    = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
        [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngStart IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none,
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDiv   IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
removeStartComponent,
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this       IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
        ]

  removeDefineComponent :: [String] -> IOSArrow XmlTree XmlTree
  removeDefineComponent :: [String] -> IOSArrow XmlTree XmlTree
removeDefineComponent [String]
defNames
    = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
        [IfThen
   (IOSLA (XIOState ()) XmlTree String) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
            IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\String
n -> String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
n [String]
defNames))          IOSLA (XIOState ()) XmlTree String
-> IOSArrow XmlTree XmlTree
-> IfThen
     (IOSLA (XIOState ()) XmlTree String) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none,
          (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getName IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"div")) IOSLA (XIOState ()) XmlTree String
-> IOSArrow XmlTree XmlTree
-> IfThen
     (IOSLA (XIOState ()) XmlTree String) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ([String] -> IOSArrow XmlTree XmlTree
removeDefineComponent [String]
defNames),
          (String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
"foo" IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"foo"))       IOSLA (XIOState ()) XmlTree String
-> IOSArrow XmlTree XmlTree
-> IfThen
     (IOSLA (XIOState ()) XmlTree String) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
        ]

  hasStartComponent :: IOSArrow XmlTree Bool
  hasStartComponent :: IOSArrow XmlTree Bool
hasStartComponent = IOSArrow XmlTree Bool -> IOSLA (XIOState ()) XmlTree [Bool]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA IOSArrow XmlTree Bool
hasStartComponent' IOSLA (XIOState ()) XmlTree [Bool]
-> IOSLA (XIOState ()) [Bool] Bool -> IOSArrow XmlTree Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Bool] -> Bool) -> IOSLA (XIOState ()) [Bool] Bool
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Bool -> Bool
forall a. a -> a
id)
    where
    hasStartComponent' :: IOSArrow XmlTree Bool
    hasStartComponent' :: IOSArrow XmlTree Bool
hasStartComponent'
      = IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree Bool -> IOSArrow XmlTree Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree Bool)]
-> IOSArrow XmlTree Bool
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngStart IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree Bool
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree Bool)
forall a b. a -> b -> IfThen a b
:-> (Bool -> IOSArrow XmlTree Bool
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA Bool
True),
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDiv   IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree Bool
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree Bool)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree Bool
hasStartComponent',
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this       IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree Bool
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree Bool)
forall a b. a -> b -> IfThen a b
:-> (Bool -> IOSArrow XmlTree Bool
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA Bool
False)
        ]

  getDefineComponents :: IOSArrow XmlTree [String]
  getDefineComponents :: IOSArrow XmlTree [String]
getDefineComponents = IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA IOSLA (XIOState ()) XmlTree String
getDefineComponents'
                        IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) [String] [String]
-> IOSArrow XmlTree [String]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                        ([String] -> [String]) -> IOSLA (XIOState ()) [String] [String]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\[String]
xs -> [String
x | String
x <- [String]
xs, String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""])
    where
    getDefineComponents' :: IOSArrow XmlTree String
    getDefineComponents' :: IOSLA (XIOState ()) XmlTree String
getDefineComponents'
      = IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
        IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        [IfThen
   (IOSArrow XmlTree XmlTree) (IOSLA (XIOState ()) XmlTree String)]
-> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
        [ IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IfThen
     (IOSArrow XmlTree XmlTree) (IOSLA (XIOState ()) XmlTree String)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
        , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDiv    IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IfThen
     (IOSArrow XmlTree XmlTree) (IOSLA (XIOState ()) XmlTree String)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState ()) XmlTree String
getDefineComponents'
        , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this        IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IfThen
     (IOSArrow XmlTree XmlTree) (IOSLA (XIOState ()) XmlTree String)
forall a b. a -> b -> IfThen a b
:-> String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
""
        ]


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


{-
- 4.8. name attribute of element and attribute elements
    - The name attribute on an element or attribute element
      is transformed into a name child element.
    - If an attribute element has a name attribute but no ns attribute,
      then an ns="" attribute is added to the name child element.
- 4.9. ns attribute
    - For any name, nsName or value element that does not have
      an ns attribute, an ns attribute is added.
    - any ns attribute that is on an element other than name,
      nsName or value is removed.
- 4.10. QNames
    - For any name element containing a prefix, the prefix is removed
      and an ns attribute is added replacing any existing ns attribute.
    - The value of the added ns attribute is the value to which the
      namespace map of the context of the name element maps the prefix.
    - The context must have a mapping for the prefix.
-}
simplificationStep3 :: IOSArrow XmlTree XmlTree
simplificationStep3 :: IOSArrow XmlTree XmlTree
simplificationStep3 =
  ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (
      ( -- 4.8 The name attribute on an element or attribute
        -- element is transformed into a name child element
        ( Int -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
Int -> a (t b) (t b) -> a (t b) (t b)
insertChildrenAt Int
0 (IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngName IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none (String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName))
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        ( -- 4.8 If an attribute element has a name attribute but no ns attribute,
          --  then an ns="" attribute is added to the name child element
           (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrNs String
"" IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngName))
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
           (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrName IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrNs)
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
removeAttr String
"name"
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
      ( (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrName )
    )
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    -- 4.9 For any name, nsName or value element that does not have
    -- an ns attribute, an ns attribute is added.
    String -> IOSArrow XmlTree XmlTree
processnsAttribute String
""
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (
      ( -- 4.9 any ns attribute that is on an element other than name,
        -- nsName or value is removed.
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
rmRngAttrNs
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngName IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNsName IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue)
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- 4.10 For any name element containing a prefix, the prefix is removed and an ns attribute
        -- is added replacing any existing ns attribute.
        ( String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
replaceNameAttr (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isText IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getText) )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngName
      )
    )
  ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors
  where
  replaceNameAttr :: (ArrowXml a) => String -> a XmlTree XmlTree
  replaceNameAttr :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
replaceNameAttr String
name
      | Char
'}' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
name
          = ( String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrNs String
pre
              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
>>>
              a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren ((String -> String) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeText ((String -> String) -> a XmlTree XmlTree)
-> (String -> String) -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a b. a -> b -> a
const String
local)
            )
      | Bool
otherwise
          = a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
    where
    (String
pre', String
local') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') String
name
    pre :: String
pre            = String -> String
forall a. [a] -> [a]
tail String
pre'
    local :: String
local          = String -> String
forall a. [a] -> [a]
tail String
local'

  processnsAttribute :: String -> IOSArrow XmlTree XmlTree
  processnsAttribute :: String -> IOSArrow XmlTree XmlTree
processnsAttribute String
name
    = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
        [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
        [ (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrNs)                     -- set the new ns attribute value
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> (String -> IOSArrow XmlTree XmlTree
processnsAttribute (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrNs)
        , ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isNameNsNameValue
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrNs
          )                                             -- For any name, nsName or value element that does not have
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrNs String
name                       -- an ns attribute, an ns attribute is added.
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
processnsAttribute String
name
              )
        , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> String -> IOSArrow XmlTree XmlTree
processnsAttribute String
name
        ]

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


{-
- 4.11 Each div element is replaced by its children
- 4.12 Number of child elements
    - A define, oneOrMore, zeroOrMore, optional, list or mixed element
      is transformed so that it has exactly one child element
    - An element element is transformed so that it has exactly two child elements
    - A except element is transformed so that it has exactly one child element
    - If an attribute element has only one child element (a name class), then a text element is added.
    - A choice, group or interleave element is transformed so that it has exactly two child elements.
- 4.13 A mixed element is transformed into an interleaving with a text element
- 4.14 An optional element is transformed into a choice with empty
- 4.15 A zeroOrMore element is transformed into a choice between oneOrMore and empty
- 4.16. Constraints: no transformation is performed, but various constraints are checked.
    - An except element that is a child of an anyName element must not have any anyName descendant elements.
    - An except element that is a child of an nsName element must not have any nsName or anyName
      descendant elements.
    - A name element that occurs as the first child of an attribute element or as the descendant of the
      first child of an attribute element and that has an ns attribute with value equal to the empty
      string must not have content equal to xmlns.
    - A name or nsName element that occurs as the first child of an attribute element or as the
      descendant of the first child of an attribute element must not have an ns attribute with
      value http://www.w3.org/2000/xmlns.
    - A data or value element must be correct in its use of datatypes.
-}
simplificationStep4 :: IOSArrow XmlTree XmlTree
simplificationStep4 :: IOSArrow XmlTree XmlTree
simplificationStep4 =
  ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (
      ( -- Each div element is replaced by its children.
        (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
simplificationStep4)
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDiv
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- A define, oneOrMore, zeroOrMore, optional, list or mixed element
        -- is transformed so that it has exactly one child element
        ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
          ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngGroup
            (String -> IOSArrow XmlTree XmlTree
setChangesAttr (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getName IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (String
"group-Pattern: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)))
            IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        (  IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isDefineOneOrMoreZeroOrMoreOptionalListMixed
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
           (Int -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(Int -> Bool) -> a XmlTree XmlTree
noOfChildren (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- An element element is transformed so that it has exactly two child elements
        ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
          ( ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isNameAnyNameNsName )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngGroup IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
              ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isNameAnyNameNsName
              )
            )
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(Int -> Bool) -> a XmlTree XmlTree
noOfChildren (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- A except element is transformed so that it has exactly one child element.
        IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngChoice IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExcept IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(Int -> Bool) -> a XmlTree XmlTree
noOfChildren (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- If an attribute element has only one child element
        -- (a name class), then a text element is added.
        Int -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
Int -> a (t b) (t b) -> a (t b) (t b)
insertChildrenAt Int
1 (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngText IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none)
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(Int -> Bool) -> a XmlTree XmlTree
noOfChildren (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- A choice, group or interleave element is transformed so
        -- that it has exactly two child elements.
        ((QName -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => QName -> a XmlTree XmlTree
wrapPattern2Two (QName -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree QName -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState ()) XmlTree QName
forall (a :: * -> * -> *). ArrowXml a => a XmlTree QName
getQName) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
simplificationStep4)
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        (  IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isChoiceGroupInterleave
           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
           (Int -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(Int -> Bool) -> a XmlTree XmlTree
noOfChildren (\ Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- A mixed element is transformed into an interleaving with a text element
        ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngInterleave
          ( String -> IOSArrow XmlTree XmlTree
setChangesAttr String
"mixed is transformed into an interleave" )
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngText
            ( String -> IOSArrow XmlTree XmlTree
setChangesAttr ( String
"new text-Pattern: mixed is transformed into " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  String
" an interleave with text"
                             )
            )
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngMixed
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- An optional element is transformed into a choice with empty
        ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngChoice
          ( String -> IOSArrow XmlTree XmlTree
setChangesAttr String
"optional is transformed into a choice" )
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngEmpty
            ( String -> IOSArrow XmlTree XmlTree
setChangesAttr ( String
"new empty-Pattern: optional is transformed " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                               String
" into a choice with empty"
                             )
            )
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngOptional
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( -- A zeroOrMore element is transformed into a choice between oneOrMore and empty
        ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngChoice
          ( String -> IOSArrow XmlTree XmlTree
setChangesAttr String
"zeroOrMore is transformed into a choice" )
          ( ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngOneOrMore
              ( String -> IOSArrow XmlTree XmlTree
setChangesAttr ( String
"zeroOrMore is transformed into a " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   String
"choice between oneOrMore and empty"
                               )
              )
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngEmpty
              ( String -> IOSArrow XmlTree XmlTree
setChangesAttr ( String
"new empty-Pattern: zeroOrMore is transformed " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   String
"into a choice between oneOrMore and empty"
                               )
              )
            )
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngZeroOrMore
      )
    )
  ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors


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


restrictionsStep1 :: IOSArrow XmlTree XmlTree
restrictionsStep1 :: IOSArrow XmlTree XmlTree
restrictionsStep1 =
  ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (
      ( ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"An except element that is a child of an anyName " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"element must not have any anyName descendant elements"
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAnyName
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExcept
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAnyName
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"An except element that is a child of an nsName element " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"must not have any nsName or anyName descendant elements."
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNsName
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExcept
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAnyName IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNsName)
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"A name element that occurs as the first child or descendant of " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"an attribute and has an ns attribute with an empty value must " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"not have content equal to \"xmlns\""
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
firstChild
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
multi (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngName IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrNs) )
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrNs IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
            IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
            (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getText IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xmlns"))
          )
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"A name or nsName element that occurs as the first child or " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"descendant of an attribute must not have an ns attribute " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"with value http://www.w3.org/2000/xmlns"
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
firstChild
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
multi (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isNameNsName IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrNs) )
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrNs
          IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> String -> Bool
compareURI String
xmlnsNamespace)
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> -- A data or value element must be correct in its use of datatypes.
      ( ( String -> String -> IOSArrow XmlTree XmlTree
checkDatatype (String -> String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, String)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrDatatypeLibrary IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrType )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngData IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue )
      )
    )
  ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors
  where

  -- the datatypeLibrary attribute must identify a valid datatype library

  checkDatatype :: Uri -> DatatypeName -> IOSArrow XmlTree XmlTree
  checkDatatype :: String -> String -> IOSArrow XmlTree XmlTree
checkDatatype String
libName String
typeName
      = (XmlTree -> Bool)
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP (Bool -> XmlTree -> Bool
forall a b. a -> b -> a
const (Bool -> XmlTree -> Bool) -> Bool -> XmlTree -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
libName ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ ((String, DatatypeCheck) -> String)
-> [(String, DatatypeCheck)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, DatatypeCheck) -> String
forall a b. (a, b) -> a
fst [(String, DatatypeCheck)]
datatypeLibraries)
        ( String -> String -> AllowedDatatypes -> IOSArrow XmlTree XmlTree
checkType String
libName String
typeName AllowedDatatypes
allowedDataTypes )
        ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"DatatypeLibrary " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
libName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found" )
        )
    where
    DTC DatatypeAllows
_ DatatypeEqual
_ AllowedDatatypes
allowedDataTypes = Maybe DatatypeCheck -> DatatypeCheck
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DatatypeCheck -> DatatypeCheck)
-> Maybe DatatypeCheck -> DatatypeCheck
forall a b. (a -> b) -> a -> b
$ String -> [(String, DatatypeCheck)] -> Maybe DatatypeCheck
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
libName [(String, DatatypeCheck)]
datatypeLibraries

  -- the type attribute must identify a datatype within the datatype library identified
  -- by the value of the datatypeLibrary attribute.

  checkType :: Uri -> DatatypeName -> AllowedDatatypes -> IOSArrow XmlTree XmlTree
  checkType :: String -> String -> AllowedDatatypes -> IOSArrow XmlTree XmlTree
checkType String
libName String
typeName AllowedDatatypes
allowedTypes
      = (XmlTree -> Bool)
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP (Bool -> XmlTree -> Bool
forall a b. a -> b -> a
const (Bool -> XmlTree -> Bool) -> Bool -> XmlTree -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
typeName ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ ((String, [String]) -> String) -> AllowedDatatypes -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> String
forall a b. (a, b) -> a
fst AllowedDatatypes
allowedTypes)
        ( String
-> String -> [String] -> [String] -> IOSArrow XmlTree XmlTree
checkParams String
typeName String
libName [String]
getParams ([String] -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree [String] -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$<
          ( IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngParam IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName) )
        )
       ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
         ( String
"Datatype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
typeName String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
" not declared for DatatypeLibrary " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
libName
         )
       )
    where
    getParams :: [String]
getParams = Maybe [String] -> [String]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> AllowedDatatypes -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
typeName AllowedDatatypes
allowedTypes

  -- For a data element, the parameter list must be one that is allowed by the datatype

  checkParams :: DatatypeName -> Uri -> AllowedParams -> [ParamName] -> IOSArrow XmlTree XmlTree
  checkParams :: String
-> String -> [String] -> [String] -> IOSArrow XmlTree XmlTree
checkParams String
typeName String
libName [String]
allowedParams [String]
paramNames
      = ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"Param(s): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
formatStringListQuot [String]
diff String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
" not allowed for Datatype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
typeName String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
" in Library " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String -> String
forall a. Show a => a -> String
show ( if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
libName
                   then String
relaxNamespace
                   else String
libName
                 )
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngData IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (XmlTree -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Bool -> XmlTree -> Bool
forall a b. a -> b -> a
const (Bool -> XmlTree -> Bool) -> Bool -> XmlTree -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
diff [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) )
      where
      diff :: [String]
diff = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
param -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
param [String]
allowedParams) [String]
paramNames


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


{-
- 4.17. combine attribute
    - For each grammar element, all define elements with the same name are combined together.
    - Similarly, for each grammar element all start elements are combined together.
- 4.18. grammar element
    - A grammar must have a start child element.
    - Transform the top-level pattern p into <grammar><start>p</start></grammar>.
    - Rename define elements so that no two define elements anywhere in the schema
      have the same name. To rename a define element, change the value of its name
      attribute and change the value of the name attribute of all ref and parentRef
      elements that refer to that define element.
    - Move all define elements to be children of the top-level grammar element
    - Replace each nested grammar element by the child of its start element
    - Rename each parentRef element to ref.
-}
simplificationStep5 :: IOSArrow XmlTree XmlTree
simplificationStep5 :: IOSArrow XmlTree XmlTree
simplificationStep5
    = ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown
        ( ( ( ( (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError)
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" String
"A grammar must have a start child element" )
              )
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
              (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngStart))
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            -- For each grammar element, all define elements with the same
            -- name are combined together.
            -- ( combinePatternList "define" $< (getPatternNamesInGrammar "define" >>> arr nub) )
            ( String -> Map String XmlTree -> IOSArrow XmlTree XmlTree
mergeCombinedPatternMap String
"define" (Map String XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (Map String XmlTree)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String
-> (String -> XmlTree -> XmlTree -> XmlTree)
-> IOSLA (XIOState ()) XmlTree (Map String XmlTree)
forall (a :: * -> * -> *).
ArrowXml a =>
String
-> (String -> XmlTree -> XmlTree -> XmlTree)
-> a XmlTree (Map String XmlTree)
getPatternNameMapInGrammar String
"define" (String -> Bool -> String -> XmlTree -> XmlTree -> XmlTree
combinePatterns String
"define" Bool
True))
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            -- Similarly, for each grammar element all start elements
            -- are combined together.
            ( String -> Map String XmlTree -> IOSArrow XmlTree XmlTree
mergeCombinedPatternMap String
"start" (Map String XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (Map String XmlTree)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (String
-> (String -> XmlTree -> XmlTree -> XmlTree)
-> IOSLA (XIOState ()) XmlTree (Map String XmlTree)
forall (a :: * -> * -> *).
ArrowXml a =>
String
-> (String -> XmlTree -> XmlTree -> XmlTree)
-> a XmlTree (Map String XmlTree)
getPatternNameMapInGrammar String
"start" (String -> Bool -> String -> XmlTree -> XmlTree -> XmlTree
combinePatterns String
"start" Bool
False)) )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        ( -- transform the top-level pattern p into <grammar><start>p</start></grammar>.
          ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
            ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngGrammar IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
              ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngStart IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar)
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        ( RefList -> RefList -> IOSArrow XmlTree XmlTree
renameDefines (RefList -> RefList -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (RefList, RefList)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<<
          ( String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree [String]
getPatternNamesInGrammar String
"define"
            IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) [String] (RefList, RefList)
-> IOSLA (XIOState ()) XmlTree (RefList, RefList)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            ( IOSArrow [String] RefList
createUniqueNames
              IOSArrow [String] RefList
-> IOSArrow [String] RefList
-> IOSLA (XIOState ()) [String] (RefList, RefList)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
              RefList -> IOSArrow [String] RefList
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA []
            )
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        -- Move all define elements to be children of the top-level grammar element
        ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
          ( -- root node
            IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
            ( -- the first grammar pattern remains unchanged
              ( IOSArrow XmlTree XmlTree
deleteAllDefines
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                ( IOSArrow XmlTree XmlTree
getAllDefines IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren IOSArrow XmlTree XmlTree
deleteAllDefines )
              )
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown
              ( ( -- Replace each nested grammar element by the child of its start element
                  ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngStart IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
                  IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                  IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar
                )
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                ( -- Rename each parentRef element to ref.
                  ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
setRngNameRef
                    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                    IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngParentRef
                  )
                )
              )
            )
          )
        )
      ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors
    where
    getPatternNameMapInGrammar :: (ArrowXml a) => String -> (String -> XmlTree -> XmlTree -> XmlTree)
                                  -> a XmlTree (Map String XmlTree)
    getPatternNameMapInGrammar :: forall (a :: * -> * -> *).
ArrowXml a =>
String
-> (String -> XmlTree -> XmlTree -> XmlTree)
-> a XmlTree (Map String XmlTree)
getPatternNameMapInGrammar String
pattern String -> XmlTree -> XmlTree -> XmlTree
combinator
        = (
              a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren 
              a XmlTree XmlTree
-> a XmlTree (String, XmlTree) -> a XmlTree (String, XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              a XmlTree XmlTree
allGrammarPatterns
              a XmlTree XmlTree
-> a XmlTree (String, XmlTree) -> a XmlTree (String, XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              (a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName a XmlTree String
-> a XmlTree XmlTree -> a XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this)
          )
          a XmlTree (String, XmlTree)
-> ([(String, XmlTree)] -> Map String XmlTree)
-> a XmlTree (Map String XmlTree)
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> d) -> a b d
>.
          (String -> XmlTree -> XmlTree -> XmlTree)
-> [(String, XmlTree)] -> Map String XmlTree
forall k a. Ord k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromListWithKey String -> XmlTree -> XmlTree -> XmlTree
combinator
        where allGrammarPatterns :: a XmlTree XmlTree
allGrammarPatterns 
                  = [IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)]
-> a XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
                    [ String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
pattern
                      a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
                      a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                    , a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar 
                      a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> 
                      a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                    , a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                      a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
                      (a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren 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
>>> a XmlTree XmlTree
allGrammarPatterns)
                    ]

    getPatternNamesInGrammar :: (ArrowXml a) => String -> a XmlTree [String]
    getPatternNamesInGrammar :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree [String]
getPatternNamesInGrammar String
pattern
        = a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
          ( a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown ( a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar ) )
          a XmlTree XmlTree -> a XmlTree [String] -> a XmlTree [String]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          a XmlTree String -> a XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( (a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
multi (String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
pattern))
                  a XmlTree XmlTree -> a XmlTree String -> a XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                  a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                )

    renameDefines :: RefList -> RefList -> IOSArrow XmlTree XmlTree
    renameDefines :: RefList -> RefList -> IOSArrow XmlTree XmlTree
renameDefines RefList
ref RefList
parentRef
        = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
          ( [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
            [ IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> (                                     -- the original name is needed for error messages
                    String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
defineOrigName (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                                        -- rename the define-pattern
                                                        -- the new name is looked up in the ref table
                    String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"name" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                                        IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                        (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\String
n -> Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> RefList -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n RefList
ref)
                                      )
                    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                    RefList -> RefList -> IOSArrow XmlTree XmlTree
renameDefines RefList
ref RefList
parentRef
                  )
            , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( RefList -> RefList -> IOSArrow XmlTree XmlTree
renameDefines (RefList -> RefList -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (RefList, RefList)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<<
                    ( (                                 -- compute all define names in the grammar
                        String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree [String]
getPatternNamesInGrammar String
"define"
                        IOSArrow XmlTree [String]
-> IOSArrow [String] RefList -> IOSLA (XIOState ()) XmlTree RefList
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                                        -- create a new (unique) name for all define names
                        IOSArrow [String] RefList
createUniqueNames
                      )
                      IOSLA (XIOState ()) XmlTree RefList
-> IOSLA (XIOState ()) XmlTree RefList
-> IOSLA (XIOState ()) XmlTree (RefList, RefList)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                                        -- set the old ref list to be the new parentRef list
                      RefList -> IOSLA (XIOState ()) XmlTree RefList
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA RefList
ref
                    )
                  )
            , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRef
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( IOSLA (XIOState ()) XmlTree String
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                          IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\String
name -> (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name (((String, String) -> String) -> RefList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst RefList
ref)))
                        )
                    (                                   -- the original name is needed for error messages
                      String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
defineOrigName (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                                        -- rename the ref-pattern
                                                        -- the new name is looked up in the ref table
                      String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"name" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                                          IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\String
n -> Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> RefList -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n RefList
ref)
                                        )
                    )
                    (                                   -- the referenced pattern does not exist in the schema
                      String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                                           IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                           (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
n -> ( String
"Define-Pattern with name " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                         String
" referenced in ref-Pattern not " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                         String
"found in schema"
                                                       )
                                               )
                                         )
                    )
                  )
            , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngParentRef                            -- same as ref, but the parentRef list is used
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( IOSLA (XIOState ()) XmlTree String
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                          IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\String
name -> (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name (((String, String) -> String) -> RefList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst RefList
parentRef)))
                        )
                    ( String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
defineOrigName (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
"name" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                                          IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\String
n -> Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> RefList -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n RefList
parentRef)
                                        )
                    )
                    ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$<
                      ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                        IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                        (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
n -> ( String
"Define-Pattern with name " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      String
" referenced in parentRef-Pattern " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      String
"not found in schema"
                                    )
                            )
                      )
                    )
                  )
            , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> RefList -> RefList -> IOSArrow XmlTree XmlTree
renameDefines RefList
ref RefList
parentRef
            ]
          )


    getAllDefines :: IOSArrow XmlTree XmlTree
    getAllDefines :: IOSArrow XmlTree XmlTree
getAllDefines = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
multi IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine

    deleteAllDefines :: IOSArrow XmlTree XmlTree
    deleteAllDefines :: IOSArrow XmlTree XmlTree
deleteAllDefines = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine

    combinePatterns :: String -> Bool -> String -> XmlTree -> XmlTree -> XmlTree
    combinePatterns :: String -> Bool -> String -> XmlTree -> XmlTree -> XmlTree
combinePatterns String
pattern Bool
keepName String
name XmlTree
t1 XmlTree
t2 = XmlTree
combined
        where [XmlTree
combined] = LA Any XmlTree -> Any -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA ((String, XmlTree) -> (String, XmlTree) -> LA Any XmlTree
forall {a}. (String, XmlTree) -> (String, XmlTree) -> LA a XmlTree
combine ((String, XmlTree) -> (String, XmlTree) -> LA Any XmlTree)
-> LA Any ((String, XmlTree), (String, XmlTree)) -> LA Any XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< LA Any ((String, XmlTree), (String, XmlTree))
forall {b}. LA b ((String, XmlTree), (String, XmlTree))
parts) Any
forall a. HasCallStack => a
undefined
              combine :: (String, XmlTree) -> (String, XmlTree) -> LA a XmlTree
combine (String
c1, XmlTree
d1) (String
c2, XmlTree
d2)
                  | String
c1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
&& String
c2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = LA a XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => a n XmlTree
mkRngRelaxError
                                           LA a XmlTree -> LA XmlTree XmlTree -> LA a XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                           String -> LA XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrDescr (String
"More than one " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pattern String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-Pattern: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name 
                                                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" without a combine-attribute in the same grammar")
                  | String
c1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = String -> XmlTree -> XmlTree -> LA a XmlTree
forall n. String -> XmlTree -> XmlTree -> LA n XmlTree
combineWith String
c2 XmlTree
d1 XmlTree
d2
                  | String
c2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = String -> XmlTree -> XmlTree -> LA a XmlTree
forall n. String -> XmlTree -> XmlTree -> LA n XmlTree
combineWith String
c1 XmlTree
d1 XmlTree
d2
                  | String
c1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
c2 = String -> XmlTree -> XmlTree -> LA a XmlTree
forall n. String -> XmlTree -> XmlTree -> LA n XmlTree
combineWith String
c1 XmlTree
d1 XmlTree
d2
                  | Bool
otherwise = LA a XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => a n XmlTree
mkRngRelaxError
                                LA a XmlTree -> LA XmlTree XmlTree -> LA a XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                String -> LA XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrDescr (String
"Different combine-Attributes: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                 ([String] -> String
formatStringListQuot [String
c1, String
c2]) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                 String
" for the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pattern String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-Pattern " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                 String -> String
forall a. Show a => a -> String
show String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in the same grammar")
              combineWith :: String -> XmlTree -> XmlTree -> LA n XmlTree
              combineWith :: forall n. String -> XmlTree -> XmlTree -> LA n XmlTree
combineWith String
c XmlTree
d1 XmlTree
d2 = String -> LA n XmlTree -> LA n XmlTree -> LA n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
pattern
                                        (String -> LA n String -> LA n XmlTree
forall (a :: * -> * -> *) b.
ArrowXml a =>
String -> a b String -> a b XmlTree
mkRngAttr String
"combine" (String -> LA n String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
c) LA n XmlTree -> LA n XmlTree -> LA n XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> if Bool
keepName then String -> LA n XmlTree
forall (a :: * -> * -> *) b. ArrowXml a => String -> a b XmlTree
mkRngAttrName String
name else LA n XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none)
                                        (String -> LA n XmlTree -> LA n XmlTree -> LA n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngElement String
c LA n XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none (LA n XmlTree -> LA n XmlTree) -> LA n XmlTree -> LA n XmlTree
forall a b. (a -> b) -> a -> b
$ (n -> [XmlTree]) -> LA n XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((n -> [XmlTree]) -> LA n XmlTree)
-> (n -> [XmlTree]) -> LA n XmlTree
forall a b. (a -> b) -> a -> b
$ [XmlTree] -> n -> [XmlTree]
forall a b. a -> b -> a
const [XmlTree
d1, XmlTree
d2])
              parts :: LA b ((String, XmlTree), (String, XmlTree))
parts = (
                       (XmlTree -> LA b XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA XmlTree
t1 LA b XmlTree
-> LA XmlTree (String, XmlTree) -> LA b (String, XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrCombine LA XmlTree String
-> LA XmlTree XmlTree -> LA XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LA XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)
                       LA b (String, XmlTree)
-> LA b (String, XmlTree)
-> LA b ((String, XmlTree), (String, XmlTree))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                       (XmlTree -> LA b XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA XmlTree
t2 LA b XmlTree
-> LA XmlTree (String, XmlTree) -> LA b (String, XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrCombine LA XmlTree String
-> LA XmlTree XmlTree -> LA XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LA XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)
                      )

    mergeCombinedPatternMap :: String -> Map String XmlTree -> IOSArrow XmlTree XmlTree
    mergeCombinedPatternMap :: String -> Map String XmlTree -> IOSArrow XmlTree XmlTree
mergeCombinedPatternMap String
pattern Map String XmlTree
definitions
        = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (([(String, XmlTree)]
-> IOSLA (XIOState ()) XmlTree (String, XmlTree)
forall (a :: * -> * -> *) c b. ArrowList a => [c] -> a b c
constL (Map String XmlTree -> [(String, XmlTree)]
forall k a. Map k a -> [(k, a)]
toList Map String XmlTree
definitions) IOSLA (XIOState ()) XmlTree (String, XmlTree)
-> IOSLA (XIOState ()) (String, XmlTree) XmlTree
-> IOSArrow 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, XmlTree) -> XmlTree)
-> IOSLA (XIOState ()) (String, XmlTree) XmlTree
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (String, XmlTree) -> XmlTree
forall a b. (a, b) -> b
snd)
                           IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                           (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
deleteDefinitions))
          where deleteDefinitions :: IOSArrow XmlTree XmlTree
deleteDefinitions 
                   = [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
                     [ String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
pattern
                       IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
                       IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                     , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar 
                       IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> 
                       IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                     , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                       IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
                       IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren IOSArrow XmlTree XmlTree
deleteDefinitions
                     ]

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


{-
- 4.19. define and ref elements
    - Remove any define element that is not reachable.
    - Now, for each element element that is not the child of a define element,
      add a define element to the grammar element,
      and replace the element element by a ref element referring
      to the added define element.
    - For each ref element that is expandable and is a descendant
      of a start element or an element element, expand it by replacing
      the ref element by the child of the define element to which it refers
    - This must not result in a loop.
    - Remove any define element whose child is not an element element.
-}
simplificationStep6 :: IOSArrow XmlTree XmlTree
simplificationStep6 :: IOSArrow XmlTree XmlTree
simplificationStep6 =
  ( -- Remove any define element that is not reachable.
    ([(String, XmlTree)]
-> [String] -> [String] -> IOSArrow XmlTree XmlTree
removeUnreachableDefines ([(String, XmlTree)]
 -> [String] -> [String] -> IOSArrow XmlTree XmlTree)
-> IOSLA
     (XIOState ()) XmlTree ([(String, XmlTree)], ([String], [String]))
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 c3 b d.
ArrowList a =>
(c1 -> c2 -> c3 -> a b d) -> a b (c1, (c2, c3)) -> a b d
$<<< IOSArrow XmlTree [(String, XmlTree)]
getAllDeepDefines
                                   IOSArrow XmlTree [(String, XmlTree)]
-> IOSLA (XIOState ()) XmlTree ([String], [String])
-> IOSLA
     (XIOState ()) XmlTree ([(String, XmlTree)], ([String], [String]))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                   [String] -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA []
                                   IOSArrow XmlTree [String]
-> IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) XmlTree ([String], [String])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                   IOSArrow XmlTree [String]
getRefsFromStartPattern
    )
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    -- for each element element that is not the child of a define element,
    -- add a define element to the grammar element,
    ( Bool -> IOSArrow XmlTree XmlTree
processElements Bool
False
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (Int -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
Int -> a (t b) (t b) -> a (t b) (t b)
insertChildrenAt Int
1 (String -> IOSArrow XmlTree XmlTree
forall s b. String -> IOStateArrow s b XmlTree
getRelaxParam String
"elementTable"))
    )
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    -- For each ref element that is expandable...
    -- Remove any define element whose child is not an element element
    (RefList -> [(String, XmlTree)] -> IOSArrow XmlTree XmlTree
replaceExpandableRefs [] ([(String, XmlTree)] -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree [(String, XmlTree)] -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSArrow XmlTree [(String, XmlTree)]
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree [(String, XmlTree)]
getExpandableDefines IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
deleteExpandableDefines)
  ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors
  where
  replaceExpandableRefs :: RefList -> Env -> IOSArrow XmlTree XmlTree
  replaceExpandableRefs :: RefList -> [(String, XmlTree)] -> IOSArrow XmlTree XmlTree
replaceExpandableRefs RefList
foundNames [(String, XmlTree)]
defTable
    = [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRef
             IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> (IOSLA (XIOState ()) XmlTree String
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                        IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                        (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\String
name -> String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name (((String, String) -> String) -> RefList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst RefList
foundNames))
                      )
                    -- we have found a loop if the name is in the list
                    (String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
defineOrigName
                                          IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
n -> ( String
"Recursion in ref-Pattern: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                        [String] -> String
formatStringListArr ([String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String
nString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> RefList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd RefList
foundNames)
                                                      )
                                              )
                                        )
                    )
                    (String -> String -> IOSArrow XmlTree XmlTree
replaceRef (String -> String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, String)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
defineOrigName)
                 ),
        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ RefList -> [(String, XmlTree)] -> IOSArrow XmlTree XmlTree
replaceExpandableRefs RefList
foundNames [(String, XmlTree)]
defTable)
      ]
    where
    replaceRef :: NewName -> OldName -> IOSArrow XmlTree XmlTree
    replaceRef :: String -> String -> IOSArrow XmlTree XmlTree
replaceRef String
name String
oldname
      = ( XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA (Maybe XmlTree -> XmlTree
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe XmlTree -> XmlTree) -> Maybe XmlTree -> XmlTree
forall a b. (a -> b) -> a -> b
$ String -> [(String, XmlTree)] -> Maybe XmlTree
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, XmlTree)]
defTable)
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          RefList -> [(String, XmlTree)] -> IOSArrow XmlTree XmlTree
replaceExpandableRefs ((String
name,String
oldname)(String, String) -> RefList -> RefList
forall a. a -> [a] -> [a]
:RefList
foundNames) [(String, XmlTree)]
defTable
        )
        IOSArrow XmlTree XmlTree
-> (XmlTree -> Bool) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b.
ArrowIf a =>
a b b -> (b -> Bool) -> a b b
`whenP`
        (Bool -> XmlTree -> Bool
forall a b. a -> b -> a
const (Bool -> XmlTree -> Bool) -> Bool -> XmlTree -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ ((String, XmlTree) -> String) -> [(String, XmlTree)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, XmlTree) -> String
forall a b. (a, b) -> a
fst [(String, XmlTree)]
defTable)


  processElements :: Bool -> IOSArrow XmlTree XmlTree
  processElements :: Bool -> IOSArrow XmlTree XmlTree
processElements Bool
parentIsDefine
    = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
      ( [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
        [ IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( (XmlTree -> Bool)
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP (Bool -> XmlTree -> Bool
forall a b. a -> b -> a
const Bool
parentIsDefine)
                (Bool -> IOSArrow XmlTree XmlTree
processElements Bool
False)
                ( RefList -> IOSArrow XmlTree XmlTree
processElements' (RefList -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree RefList -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$<
                  ( IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA IOSLA (XIOState ()) XmlTree String
getDefineName                 -- create a new define id
                    IOSArrow XmlTree [String]
-> IOSArrow [String] RefList -> IOSLA (XIOState ()) XmlTree RefList
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                    IOSArrow [String] RefList
createUniqueNames
                  )
                )
              )
        , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> Bool -> IOSArrow XmlTree XmlTree
processElements Bool
True
        , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> Bool -> IOSArrow XmlTree XmlTree
processElements Bool
False
        ])
    where
    getDefineName :: IOSArrow XmlTree String
    getDefineName :: IOSLA (XIOState ()) XmlTree String
getDefineName
        = IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
firstChild
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          LA XmlTree NameClass -> IOSLA (XIOState ()) XmlTree NameClass
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA LA XmlTree NameClass
createNameClass
          IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) NameClass String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          (NameClass -> String) -> IOSLA (XIOState ()) NameClass String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr NameClass -> String
forall a. Show a => a -> String
show

    processElements' :: RefList -> IOSArrow XmlTree XmlTree
    processElements' :: RefList -> IOSArrow XmlTree XmlTree
processElements' [(String
oldname, String
name)]
      = String -> String -> IOSArrow XmlTree XmlTree
storeElement String
name String
oldname
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngRef (String -> String -> IOSArrow XmlTree XmlTree
createAttr String
name String
oldname) IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
    processElements' RefList
l
        = String -> IOSArrow XmlTree XmlTree
forall a. HasCallStack => String -> a
error (String -> IOSArrow XmlTree XmlTree)
-> String -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ String
"processElements' called with illegal arg: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RefList -> String
forall a. Show a => a -> String
show RefList
l

    storeElement :: NewName -> OldName -> IOSArrow XmlTree XmlTree
    storeElement :: String -> String -> IOSArrow XmlTree XmlTree
storeElement String
name String
oldname
      = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
          ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngDefine
             (String -> String -> IOSArrow XmlTree XmlTree
createAttr String
name String
oldname) (Bool -> IOSArrow XmlTree XmlTree
processElements Bool
False)
          )
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree [XmlTree]
-> IOSLA (XIOState ()) XmlTree (XmlTree, [XmlTree])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
          (IOSArrow XmlTree XmlTree -> IOSLA (XIOState ()) XmlTree [XmlTree]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (IOSArrow XmlTree XmlTree -> IOSLA (XIOState ()) XmlTree [XmlTree])
-> IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree [XmlTree]
forall a b. (a -> b) -> a -> b
$ String -> IOSArrow XmlTree XmlTree
forall s b. String -> IOStateArrow s b XmlTree
getRelaxParam String
"elementTable")
          IOSLA (XIOState ()) XmlTree (XmlTree, [XmlTree])
-> IOSLA (XIOState ()) (XmlTree, [XmlTree]) XmlTree
-> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          (XmlTree -> [XmlTree] -> [XmlTree])
-> IOSLA (XIOState ()) (XmlTree, [XmlTree]) [XmlTree]
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 (:)
          IOSLA (XIOState ()) (XmlTree, [XmlTree]) [XmlTree]
-> IOSLA (XIOState ()) [XmlTree] XmlTree
-> IOSLA (XIOState ()) (XmlTree, [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 -> IOSLA (XIOState ()) [XmlTree] XmlTree
forall s. String -> IOStateArrow s [XmlTree] XmlTree
setRelaxParam String
"elementTable"

    createAttr :: NewName -> OldName -> IOSArrow XmlTree XmlTree
    createAttr :: String -> String -> IOSArrow XmlTree XmlTree
createAttr String
name String
oldname
      = String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowXml a => String -> a b XmlTree
mkRngAttrName String
name
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowXml a => String -> a b XmlTree
mkRngAttrDefineOrigName (String
"created for element " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
oldname)

  getExpandableDefines :: (ArrowXml a) => a XmlTree Env
  getExpandableDefines :: forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree [(String, XmlTree)]
getExpandableDefines
    = a XmlTree (String, XmlTree) -> a XmlTree [(String, XmlTree)]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (a XmlTree (String, XmlTree) -> a XmlTree [(String, XmlTree)])
-> a XmlTree (String, XmlTree) -> a XmlTree [(String, XmlTree)]
forall a b. (a -> b) -> a -> b
$ (a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
multi ( ( a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine
                         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
>>>
                         a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                         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
>>>
                         a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement
                       )
                       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
                     )
              )
              a XmlTree XmlTree
-> a XmlTree (String, XmlTree) -> a XmlTree (String, XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              (a XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName a XmlTree String
-> a XmlTree XmlTree -> a XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this)

  deleteExpandableDefines :: (ArrowXml a) => a XmlTree XmlTree
  deleteExpandableDefines :: forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
deleteExpandableDefines
    = a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (a XmlTree XmlTree -> a XmlTree XmlTree)
-> a XmlTree XmlTree -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                       a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                       ( a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine
                         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
>>>
                         a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                         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
>>>
                         a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement
                       )


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


{-
- 4.20. notAllowed element
    - An attribute, list, group, interleave, or oneOrMore element that has
      a notAllowed child element is transformed into a notAllowed element.
    - A choice element that has two notAllowed child elements
      is transformed into a notAllowed element
    - A choice element that has one notAllowed child element
      is transformed into its other child element.
    - An except element that has a notAllowed child element is removed.
    - The preceding transformations are applied repeatedly
      until none of them is applicable any more.
    - Any define element that is no longer reachable is removed.
- 4.21. empty element
    - A group, interleave or choice element that has two empty child
      elements is transformed into an empty element.
    - A group or interleave element that has one empty child element
      is transformed into its other child element.
    - A choice element whose second child element is an empty element
      is transformed by interchanging its two child elements.
    - A oneOrMore element that has an empty child element
      is transformed into an empty element.
    - The preceding transformations are applied repeatedly
      until none of them is applicable any more.
-}

simplificationStep7 :: IOSArrow XmlTree XmlTree
simplificationStep7 :: IOSArrow XmlTree XmlTree
simplificationStep7
    = ( Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
0                               -- 0 = no changes, 1 = changes performed
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processTopDownWithAttrl
        ( ( -- An attribute, list, group, interleave, or oneOrMore element that has a
            -- notAllowed child element is transformed into a notAllowed element.
            ( ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngNotAllowed IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
1
              )
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`                                 -- keep all errors
              (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError)
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeListGroupInterleaveOneOrMore
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNotAllowed
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( -- A choice element that has two notAllowed child elements is
            -- transformed into a notAllowed element
            ( IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree -> a n XmlTree
mkRngNotAllowed IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
1
            )
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree [XmlTree]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngChoice
              IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree [XmlTree]
-> IOSLA (XIOState ()) XmlTree [XmlTree]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree -> IOSLA (XIOState ()) XmlTree [XmlTree]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNotAllowed)
              IOSLA (XIOState ()) XmlTree [XmlTree]
-> IOSLA (XIOState ()) [XmlTree] [XmlTree]
-> IOSLA (XIOState ()) XmlTree [XmlTree]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ([XmlTree] -> Bool) -> IOSLA (XIOState ()) [XmlTree] [XmlTree]
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\[XmlTree]
s -> [XmlTree] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XmlTree]
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2)
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( -- A choice element that has one notAllowed child element is
            -- transformed into its other child element.
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNotAllowed
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
1
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngChoice IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNotAllowed )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( -- An except element that has a notAllowed child element is removed.
            ( ( Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
1
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
              )
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`                  -- keep all errors
              IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExcept IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNotAllowed )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> -- transforming the empty pattern (4.21)
          ( -- A group, interleave or choice element that has two empty child elements
            -- is transformed into an empty element.
            ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngEmpty IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
1
            )
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree [XmlTree]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isChoiceGroupInterleave
              IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree [XmlTree]
-> IOSLA (XIOState ()) XmlTree [XmlTree]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree -> IOSLA (XIOState ()) XmlTree [XmlTree]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty)
              IOSLA (XIOState ()) XmlTree [XmlTree]
-> IOSLA (XIOState ()) [XmlTree] [XmlTree]
-> IOSLA (XIOState ()) XmlTree [XmlTree]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ([XmlTree] -> Bool) -> IOSLA (XIOState ()) [XmlTree] [XmlTree]
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\[XmlTree]
s -> [XmlTree] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XmlTree]
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2)
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( -- A group or interleave element that has one empty child element
            -- is transformed into its other child element.
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
1
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isGroupInterleave IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( -- A choice element whose second child element is an empty element is transformed
            -- by interchanging its two child elements.
            IOSArrow XmlTree XmlTree
changeChoiceChildren
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngChoice IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( -- A oneOrMore element that has an empty child element
            -- is transformed into an empty element.
            ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngEmpty IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
1
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngOneOrMore IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty )
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        -- The preceding transformations are applied repeatedly
        -- until none of them is applicable any more.
        ( IOSArrow XmlTree XmlTree
simplificationStep7
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree Int -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          IOSLA (XIOState ()) XmlTree Int
forall b. IOSArrow b Int
hasTreeChanged
        )
      ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors
    where
    changeChoiceChildren :: IOSArrow XmlTree XmlTree
    changeChoiceChildren :: IOSArrow XmlTree XmlTree
changeChoiceChildren
        = ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
              ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n XmlTree
mkRngEmpty IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty)
              )
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged Int
1
            )
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b c
single (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem)           -- first child not "empty" elem
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty
            )
          )

hasTreeChanged  :: IOSArrow b Int
hasTreeChanged :: forall b. IOSArrow b Int
hasTreeChanged
    = Int -> String -> IOStateArrow () b Int
forall s b. Int -> String -> IOStateArrow s b Int
getSysAttrInt Int
0 String
"rng:changeTree"
      IOStateArrow () b Int
-> IOSLA (XIOState ()) Int Int -> IOStateArrow () b Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      (Int -> Bool) -> IOSLA (XIOState ()) Int Int
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)

markTreeChanged :: Int -> IOSArrow b b
markTreeChanged :: forall b. Int -> IOSArrow b b
markTreeChanged Int
i
    = IOSLA (XIOState ()) b b -> IOSLA (XIOState ()) b b
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (String -> Int -> IOSLA (XIOState ()) b b
forall s b. String -> Int -> IOStateArrow s b b
setSysAttrInt String
"rng:changeTree" Int
i)

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


simplificationStep8 :: IOSArrow XmlTree XmlTree
simplificationStep8 :: IOSArrow XmlTree XmlTree
simplificationStep8                     -- Remove any define element that is not reachable.
    = ( ( [(String, XmlTree)]
-> [String] -> [String] -> IOSArrow XmlTree XmlTree
removeUnreachableDefines ([(String, XmlTree)]
 -> [String] -> [String] -> IOSArrow XmlTree XmlTree)
-> IOSLA
     (XIOState ()) XmlTree ([(String, XmlTree)], ([String], [String]))
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 c3 b d.
ArrowList a =>
(c1 -> c2 -> c3 -> a b d) -> a b (c1, (c2, c3)) -> a b d
$<<<
          ( IOSArrow XmlTree [(String, XmlTree)]
getAllDeepDefines
            IOSArrow XmlTree [(String, XmlTree)]
-> IOSLA (XIOState ()) XmlTree ([String], [String])
-> IOSLA
     (XIOState ()) XmlTree ([(String, XmlTree)], ([String], [String]))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
            [String] -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA []
            IOSArrow XmlTree [String]
-> IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) XmlTree ([String], [String])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
            IOSArrow XmlTree [String]
getRefsFromStartPattern
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors
      )


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


restrictionsStep2 :: IOSArrow XmlTree XmlTree
restrictionsStep2 :: IOSArrow XmlTree XmlTree
restrictionsStep2 =
  IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (
    [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [
-- 7.1.1. attribute pattern, the following paths are prohibited:
--        attribute//(ref | attribute)
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
        ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError (String -> String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, String)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< (IOSLA (XIOState ()) XmlTree String
getChangesAttr
                                IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                ( IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRef
                                          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          (IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getName IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSLA (XIOState ()) XmlTree String
getChangesAttr IOSLA (XIOState ()) XmlTree (String, String)
-> IOSLA (XIOState ()) (String, String) String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> String -> String)
-> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 String -> String -> String
forall a. [a] -> [a] -> [a]
(++))
                                        )
                                  IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) [String] String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  ([String] -> String) -> IOSLA (XIOState ()) [String] String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\[String]
n -> [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                             String
"Pattern not allowed as descendent(s)" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                             String
" of a attribute-Pattern"
                                      )
                                )
                               )
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRef )
        ),

-- 7.1.2. oneOrMore pattern, the following paths are prohibited:
--        oneOrMore//(group | interleave)//attribute
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngOneOrMore IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
        ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError (String -> String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, String)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< (IOSLA (XIOState ()) XmlTree String
getChangesAttr
                                IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                ( IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isGroupInterleave
                                          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          (IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getName IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSLA (XIOState ()) XmlTree String
getChangesAttr IOSLA (XIOState ()) XmlTree (String, String)
-> IOSLA (XIOState ()) (String, String) String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> String -> String)
-> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 String -> String -> String
forall a. [a] -> [a] -> [a]
(++))
                                        )
                                  IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree ([String], String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                  IOSLA (XIOState ()) XmlTree String
getChangesAttr
                                  IOSLA (XIOState ()) XmlTree ([String], String)
-> IOSLA (XIOState ()) ([String], String) String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  ([String] -> String -> String)
-> IOSLA (XIOState ()) ([String], String) String
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 (\ [String]
n String
c -> ( [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                   String
"Pattern not allowed as descendent(s) " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                   String
"of a oneOrMore-Pattern" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                   (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
c then String
"" else String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                   String
" followed by an attribute descendent"
                                                 )
                                       )
                                )
                               )
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isGroupInterleave
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute
          )
        ),

-- 7.1.3. list pattern, the following paths are prohibited:
--        list//( list | ref | attribute | text | interleave)
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngList IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
        ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError (String -> String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, String)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< (IOSLA (XIOState ()) XmlTree String
getChangesAttr
                                IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                ( IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRefTextListInterleave
                                          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          (IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getName IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSLA (XIOState ()) XmlTree String
getChangesAttr IOSLA (XIOState ()) XmlTree (String, String)
-> IOSLA (XIOState ()) (String, String) String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> String -> String)
-> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 String -> String -> String
forall a. [a] -> [a] -> [a]
(++))
                                        )
                                  IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) [String] String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  ([String] -> String) -> IOSLA (XIOState ()) [String] String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\[String]
n -> [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                             String
"Pattern not allowed as descendent(s) of a list-Pattern")
                                )
                               )
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRefTextListInterleave
          )
        ),

-- 7.1.4. except in data pattern, the following paths are prohibited:
--        data/except//(attribute | ref | text | list | group | interleave | oneOrMore | empty)
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngData IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
        ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError (String -> String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, String)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< (IOSLA (XIOState ()) XmlTree String
getChangesAttr
                                IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                ( IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                         IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                         IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRefTextListGroupInterleaveOneOrMoreEmpty
                                         IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                         (IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getName IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSLA (XIOState ()) XmlTree String
getChangesAttr IOSLA (XIOState ()) XmlTree (String, String)
-> IOSLA (XIOState ()) (String, String) String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> String -> String)
-> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 String -> String -> String
forall a. [a] -> [a] -> [a]
(++))
                                        )
                                  IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) [String] String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  ([String] -> String) -> IOSLA (XIOState ()) [String] String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\[String]
n -> [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                             String
"Pattern not allowed as descendent(s) of a data/except-Pattern")
                                )
                               )
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExcept
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isAttributeRefTextListGroupInterleaveOneOrMoreEmpty
          )
        ),

-- 7.1.5. start element, the following paths are prohibited:
--        start//(attribute | data | value | text | list | group | interleave | oneOrMore | empty)
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngStart IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
        ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError (String -> String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, String)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<< (IOSLA (XIOState ()) XmlTree String
getChangesAttr
                                IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                ( IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                         IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                         IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep ([String] -> IOSArrow XmlTree XmlTree
checkElemName [ String
"attribute", String
"data", String
"value", String
"text", String
"list",
                                                               String
"group", String
"interleave", String
"oneOrMore", String
"empty"])
                                         IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                         (IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getName IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSLA (XIOState ()) XmlTree String
getChangesAttr IOSLA (XIOState ()) XmlTree (String, String)
-> IOSLA (XIOState ()) (String, String) String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> String -> String)
-> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 String -> String -> String
forall a. [a] -> [a] -> [a]
(++))
                                        )
                                  IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) [String] String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  ([String] -> String) -> IOSLA (XIOState ()) [String] String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\[String]
n -> [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                             String
"Pattern not allowed as descendent(s) of a start-Pattern")
                                )
                               )
            )
          )
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep ([String] -> IOSArrow XmlTree XmlTree
checkElemName [ String
"attribute", String
"data", String
"value", String
"text", String
"list",
                                  String
"group", String
"interleave", String
"oneOrMore", String
"empty"])
          )
        ),

        IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      ]
  ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors


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


restrictionsStep3 :: IOSArrow XmlTree XmlTree
restrictionsStep3 :: IOSArrow XmlTree XmlTree
restrictionsStep3
    = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown
      ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
          ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$<
            ( -- getRngAttrName
              ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngName IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getText )
              IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
n -> ( String
"Content of element " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" contains a pattern that can match " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                            String
"a child and a pattern that matches a single string"
                          )
                  )
            )
          )
        )
        IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> ([XmlTree] -> [XmlTree]) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. (Int -> [XmlTree] -> [XmlTree]
forall a. Int -> [a] -> [a]
take Int
1 ([XmlTree] -> [XmlTree])
-> ([XmlTree] -> [XmlTree]) -> [XmlTree] -> [XmlTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> [XmlTree]
forall a. [a] -> [a]
reverse) )
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSLA (XIOState ()) XmlTree ContentType
getContentType IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) ContentType ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ContentType -> Bool)
-> IOSLA (XIOState ()) ContentType ContentType
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (ContentType -> ContentType -> Bool
forall a. Eq a => a -> a -> Bool
== ContentType
CTNone)
        )
      ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors



getContentType :: IOSArrow XmlTree ContentType
getContentType :: IOSLA (XIOState ()) XmlTree ContentType
getContentType
    = [IfThen
   (IOSArrow XmlTree XmlTree)
   (IOSLA (XIOState ()) XmlTree ContentType)]
-> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
      [ IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngValue      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> (ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTSimple)
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngData       IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState ()) XmlTree ContentType
processData
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngList       IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> (ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTSimple)
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngText       IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> (ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTComplex)
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRef        IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> (ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTComplex)
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngEmpty      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> (ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTEmpty)
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute  IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState ()) XmlTree ContentType
processAttribute
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGroup      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState ()) XmlTree ContentType
processGroup
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngInterleave IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState ()) XmlTree ContentType
processInterleave
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngOneOrMore  IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState ()) XmlTree ContentType
processOneOrMore
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngChoice     IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IfThen
     (IOSArrow XmlTree XmlTree)
     (IOSLA (XIOState ()) XmlTree ContentType)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState ()) XmlTree ContentType
processChoice
      ]
    where
    processData :: IOSArrow XmlTree ContentType
    processData :: IOSLA (XIOState ()) XmlTree ContentType
processData
        = IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExcept))
          (ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTSimple)
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngExcept
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSLA (XIOState ()) XmlTree ContentType
getContentType
            IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) ContentType ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (ContentType -> Bool)
-> IOSLA (XIOState ()) ContentType ContentType
-> IOSLA (XIOState ()) ContentType ContentType
-> IOSLA (XIOState ()) ContentType ContentType
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP (ContentType -> ContentType -> Bool
forall a. Eq a => a -> a -> Bool
/= ContentType
CTNone) (ContentType -> IOSLA (XIOState ()) ContentType ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTSimple) (ContentType -> IOSLA (XIOState ()) ContentType ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTNone)
          )
    processAttribute :: IOSArrow XmlTree ContentType
    processAttribute :: IOSLA (XIOState ()) XmlTree ContentType
processAttribute
        = IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
lastChild
                IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                IOSLA (XIOState ()) XmlTree ContentType
getContentType
                IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) ContentType ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                (ContentType -> Bool)
-> IOSLA (XIOState ()) ContentType ContentType
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (ContentType -> ContentType -> Bool
forall a. Eq a => a -> a -> Bool
/= ContentType
CTNone)
              )
          (ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTEmpty)
          (ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTNone)

    processGroup :: IOSArrow XmlTree ContentType
    processGroup :: IOSLA (XIOState ()) XmlTree ContentType
processGroup
        = IOSArrow XmlTree (ContentType, ContentType)
get2ContentTypes
          IOSArrow XmlTree (ContentType, ContentType)
-> IOSLA (XIOState ()) (ContentType, ContentType) ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          (ContentType -> ContentType -> ContentType)
-> IOSLA (XIOState ()) (ContentType, ContentType) ContentType
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 (\ContentType
a ContentType
b -> if ContentType -> ContentType -> Bool
isGroupable ContentType
a ContentType
b then ContentType -> ContentType -> ContentType
forall a. Ord a => a -> a -> a
max ContentType
a ContentType
b else ContentType
CTNone)

    processInterleave :: IOSArrow XmlTree ContentType
    processInterleave :: IOSLA (XIOState ()) XmlTree ContentType
processInterleave
        = IOSArrow XmlTree (ContentType, ContentType)
get2ContentTypes
          IOSArrow XmlTree (ContentType, ContentType)
-> IOSLA (XIOState ()) (ContentType, ContentType) ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          (ContentType -> ContentType -> ContentType)
-> IOSLA (XIOState ()) (ContentType, ContentType) ContentType
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 (\ContentType
a ContentType
b -> if ContentType -> ContentType -> Bool
isGroupable ContentType
a ContentType
b then ContentType -> ContentType -> ContentType
forall a. Ord a => a -> a -> a
max ContentType
a ContentType
b else ContentType
CTNone)

    processOneOrMore :: IOSArrow XmlTree ContentType
    processOneOrMore :: IOSLA (XIOState ()) XmlTree ContentType
processOneOrMore
        = IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                IOSLA (XIOState ()) XmlTree ContentType
getContentType IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) ContentType ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ContentType -> Bool)
-> IOSLA (XIOState ()) ContentType ContentType
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (ContentType -> ContentType -> Bool
forall a. Eq a => a -> a -> Bool
/= ContentType
CTNone)
                IOSLA (XIOState ()) ContentType ContentType
-> IOSLA (XIOState ()) ContentType ContentType
-> IOSLA (XIOState ()) ContentType ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                (ContentType -> Bool)
-> IOSLA (XIOState ()) ContentType ContentType
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ContentType
t -> ContentType -> ContentType -> Bool
isGroupable ContentType
t ContentType
t)
              )
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree ContentType
getContentType )
          ( ContentType -> IOSLA (XIOState ()) XmlTree ContentType
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA ContentType
CTNone )

    processChoice :: IOSArrow XmlTree ContentType
    processChoice :: IOSLA (XIOState ()) XmlTree ContentType
processChoice
        = IOSArrow XmlTree (ContentType, ContentType)
get2ContentTypes
          IOSArrow XmlTree (ContentType, ContentType)
-> IOSLA (XIOState ()) (ContentType, ContentType) ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          (ContentType -> ContentType -> ContentType)
-> IOSLA (XIOState ()) (ContentType, ContentType) ContentType
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 ContentType -> ContentType -> ContentType
forall a. Ord a => a -> a -> a
max

    isGroupable :: ContentType -> ContentType -> Bool
    isGroupable :: ContentType -> ContentType -> Bool
isGroupable ContentType
CTEmpty   ContentType
_         = Bool
True
    isGroupable ContentType
_         ContentType
CTEmpty   = Bool
True
    isGroupable ContentType
CTComplex ContentType
CTComplex = Bool
True
    isGroupable ContentType
_         ContentType
_         = Bool
False


checkPattern :: IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
checkPattern :: IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
checkPattern
    = (\ (XmlTree
_, ([NameClass]
a, [NameClass]
b)) -> [NameClass] -> [NameClass] -> Bool
isIn [NameClass]
a [NameClass]
b) ((XmlTree, ([NameClass], [NameClass])) -> Bool)
-> IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
-> IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d
`guardsP` (((XmlTree, ([NameClass], [NameClass])) -> XmlTree)
-> IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (XmlTree, ([NameClass], [NameClass])) -> XmlTree
forall a b. (a, b) -> a
fst)
    where
    isIn :: [NameClass] -> [NameClass] -> Bool
    isIn :: [NameClass] -> [NameClass] -> Bool
isIn [NameClass]
_ []      = Bool
False
    isIn [] [NameClass]
_      = Bool
False
    isIn (NameClass
x:[NameClass]
xs) [NameClass]
ys = ((NameClass -> Bool) -> [NameClass] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (NameClass -> NameClass -> Bool
overlap NameClass
x) [NameClass]
ys) Bool -> Bool -> Bool
|| [NameClass] -> [NameClass] -> Bool
isIn [NameClass]
xs [NameClass]
ys


occur :: String -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur :: String -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur String
name IOSArrow XmlTree XmlTree
fct
    = [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
      [ String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasRngElemName String
name
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
        IOSArrow XmlTree XmlTree
fct
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isChoiceGroupInterleaveOneOrMore
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:->
        (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur String
name IOSArrow XmlTree XmlTree
fct)
      ]

get2ContentTypes :: IOSArrow XmlTree (ContentType, ContentType)
get2ContentTypes :: IOSArrow XmlTree (ContentType, ContentType)
get2ContentTypes
    = ( ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
firstChild IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree ContentType
getContentType )
        IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSArrow XmlTree (ContentType, ContentType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
lastChild  IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ContentType
-> IOSLA (XIOState ()) XmlTree ContentType
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree ContentType
getContentType )
      )

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


-- Duplicate attributes are not allowed. -> fertig
-- Attributes using infinite name classes must be repeated; an attribute element that
-- has an anyName or nsName descendant element must have a oneOrMore ancestor element. -> fertig

-- berechnet alle define-Namen (fuer ref-Pattern) und Nameclasses der element-Pattern

restrictionsStep4 :: IOSArrow XmlTree XmlTree
restrictionsStep4 :: IOSArrow XmlTree XmlTree
restrictionsStep4
    = ( [(String, NameClass)] -> IOSArrow XmlTree XmlTree
restrictionsStep4' ([(String, NameClass)] -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree [(String, NameClass)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$<
        IOSLA (XIOState ()) XmlTree (String, NameClass)
-> IOSLA (XIOState ()) XmlTree [(String, NameClass)]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine                                -- get all defines
                IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree (String, NameClass)
-> IOSLA (XIOState ()) XmlTree (String, NameClass)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName                                -- get define name
                  IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree (String, NameClass)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                  ( IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree NameClass
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b c
single ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                             IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree NameClass
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                             IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                             IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree NameClass
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                             LA XmlTree NameClass -> IOSLA (XIOState ()) XmlTree NameClass
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA LA XmlTree NameClass
createNameClass             -- compute the name class from 1. grandchild
                           )
                    IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree NameClass
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                    (NameClass -> IOSLA (XIOState ()) XmlTree NameClass
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA NameClass
AnyName)
                  )
                )
              )
      ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` IOSArrow XmlTree XmlTree
collectErrors

restrictionsStep4' :: [(String, NameClass)] -> IOSArrow XmlTree XmlTree
restrictionsStep4' :: [(String, NameClass)] -> IOSArrow XmlTree XmlTree
restrictionsStep4' [(String, NameClass)]
nc =
  IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (
    (
      ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" (String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$<
          ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
            IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
n -> ( String
"Both attribute-pattern occuring in an " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                          String -> String
forall a. Show a => a -> String
show String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" belong to the same name-class"
                        )
                )
          )
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
      ( (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGroup IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngInterleave)
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ([NameClass], [NameClass])
-> IOSLA
     (XIOState ()) XmlTree (XmlTree, ([NameClass], [NameClass]))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
firstChild
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree [NameClass]
-> IOSLA (XIOState ()) XmlTree [NameClass]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree [NameClass]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( String -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur String
"attribute" (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b c
single IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)
                    IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree NameClass
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                    LA XmlTree NameClass -> IOSLA (XIOState ()) XmlTree NameClass
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA LA XmlTree NameClass
createNameClass
                  )
          )
          IOSLA (XIOState ()) XmlTree [NameClass]
-> IOSLA (XIOState ()) XmlTree [NameClass]
-> IOSLA (XIOState ()) XmlTree ([NameClass], [NameClass])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
lastChild
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree [NameClass]
-> IOSLA (XIOState ()) XmlTree [NameClass]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree [NameClass]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( String -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur String
"attribute" (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b c
single IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)
                    IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree NameClass
-> IOSLA (XIOState ()) XmlTree NameClass
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                    LA XmlTree NameClass -> IOSLA (XIOState ()) XmlTree NameClass
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA LA XmlTree NameClass
createNameClass
                  )
          )
        )
        IOSLA (XIOState ()) XmlTree (XmlTree, ([NameClass], [NameClass]))
-> IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
-> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
checkPattern
      )
    )
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    (
      ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"An attribute that has an anyName or nsName descendant element " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"must have a oneOrMore ancestor element"
          )
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
      (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngElement IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
checkInfiniteAttribute)
    )
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
""
          ( String
"Both element-pattern occuring in an interleave " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"belong to the same name-class"
          )
        )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
      ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngInterleave
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree ([String], [String])
-> IOSLA (XIOState ()) XmlTree (XmlTree, ([String], [String]))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
          (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
firstChild IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree [String] -> IOSArrow XmlTree [String]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (String -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur String
"ref" IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName))
          IOSArrow XmlTree [String]
-> IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) XmlTree ([String], [String])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
          (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
lastChild  IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree [String] -> IOSArrow XmlTree [String]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (String -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur String
"ref" IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName))
        )
        IOSLA (XIOState ()) XmlTree (XmlTree, ([String], [String]))
-> IOSLA (XIOState ()) (XmlTree, ([String], [String])) XmlTree
-> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        IOSLA (XIOState ()) (XmlTree, ([String], [String])) XmlTree
checkNames
      )
    )
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    ( ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
"" String
"A text pattern must not occur in both children of an interleave" )
      )
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
      (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngInterleave IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSArrow XmlTree XmlTree
checkText)
    )
  )
  where
  checkInfiniteAttribute :: IOSArrow XmlTree XmlTree
  checkInfiniteAttribute :: IOSArrow XmlTree XmlTree
checkInfiniteAttribute
    = IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      [IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)]
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
      [ IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngOneOrMore IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      , ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttribute
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAnyName IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngNsName)
        ) IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      , IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IfThen (IOSArrow XmlTree XmlTree) (IOSArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOSArrow XmlTree XmlTree
checkInfiniteAttribute
      ]

  checkNames :: IOSArrow (XmlTree, ([String], [String])) XmlTree
  checkNames :: IOSLA (XIOState ()) (XmlTree, ([String], [String])) XmlTree
checkNames = (((XmlTree, ([String], [String])) -> XmlTree)
-> IOSLA (XIOState ()) (XmlTree, ([String], [String])) XmlTree
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (XmlTree, ([String], [String])) -> XmlTree
forall a b. (a, b) -> a
fst)
               IOSLA (XIOState ()) (XmlTree, ([String], [String])) XmlTree
-> IOSLA
     (XIOState ())
     (XmlTree, ([String], [String]))
     ([NameClass], [NameClass])
-> IOSLA
     (XIOState ())
     (XmlTree, ([String], [String]))
     (XmlTree, ([NameClass], [NameClass]))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
               (((XmlTree, ([String], [String])) -> [NameClass])
-> IOSLA (XIOState ()) (XmlTree, ([String], [String])) [NameClass]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(XmlTree
_, ([String]
a, [String]
_)) -> [(String, NameClass)] -> [String] -> [NameClass]
getNameClasses [(String, NameClass)]
nc [String]
a))
               IOSLA (XIOState ()) (XmlTree, ([String], [String])) [NameClass]
-> IOSLA (XIOState ()) (XmlTree, ([String], [String])) [NameClass]
-> IOSLA
     (XIOState ())
     (XmlTree, ([String], [String]))
     ([NameClass], [NameClass])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
               (((XmlTree, ([String], [String])) -> [NameClass])
-> IOSLA (XIOState ()) (XmlTree, ([String], [String])) [NameClass]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(XmlTree
_, ([String]
_, [String]
b)) -> [(String, NameClass)] -> [String] -> [NameClass]
getNameClasses [(String, NameClass)]
nc [String]
b))
               IOSLA
  (XIOState ())
  (XmlTree, ([String], [String]))
  (XmlTree, ([NameClass], [NameClass]))
-> IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
-> IOSLA (XIOState ()) (XmlTree, ([String], [String])) XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
               IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
checkPattern
    where
    getNameClasses :: [(String, NameClass)] -> [String] -> [NameClass]
    getNameClasses :: [(String, NameClass)] -> [String] -> [NameClass]
getNameClasses [(String, NameClass)]
nc' [String]
l = (String -> NameClass) -> [String] -> [NameClass]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> Maybe NameClass -> NameClass
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe NameClass -> NameClass) -> Maybe NameClass -> NameClass
forall a b. (a -> b) -> a -> b
$ String -> [(String, NameClass)] -> Maybe NameClass
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, NameClass)]
nc') [String]
l

  checkText :: IOSArrow XmlTree XmlTree
  checkText :: IOSArrow XmlTree XmlTree
checkText
      = ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
firstChild IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur String
"text" IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this )
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
lastChild  IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
occur String
"text" IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this )

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


overlap         :: NameClass -> NameClass -> Bool
overlap :: NameClass -> NameClass -> Bool
overlap NameClass
nc1 NameClass
nc2
    = (QName -> Bool) -> [QName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (NameClass -> NameClass -> QName -> Bool
bothContain NameClass
nc1 NameClass
nc2) (NameClass -> [QName]
representatives NameClass
nc1 [QName] -> [QName] -> [QName]
forall a. [a] -> [a] -> [a]
++ NameClass -> [QName]
representatives NameClass
nc2)

bothContain     :: NameClass -> NameClass -> QName -> Bool
bothContain :: NameClass -> NameClass -> QName -> Bool
bothContain NameClass
nc1 NameClass
nc2 QName
qn
    = NameClass -> QName -> Bool
contains NameClass
nc1 QName
qn Bool -> Bool -> Bool
&& NameClass -> QName -> Bool
contains NameClass
nc2 QName
qn

illegalLocalName        :: LocalName
illegalLocalName :: String
illegalLocalName        = String
""

illegalUri              :: Uri
illegalUri :: String
illegalUri              = String
"\x1"

representatives         :: NameClass -> [QName]
representatives :: NameClass -> [QName]
representatives NameClass
AnyName
    = [String -> String -> String -> QName
mkQName String
"" String
illegalLocalName String
illegalUri]

representatives (AnyNameExcept NameClass
nc)
    = (String -> String -> String -> QName
mkQName String
"" String
illegalLocalName String
illegalUri) QName -> [QName] -> [QName]
forall a. a -> [a] -> [a]
: (NameClass -> [QName]
representatives NameClass
nc)

representatives (NsName String
ns)
    = [String -> String -> String -> QName
mkQName String
"" String
illegalLocalName String
ns]

representatives (NsNameExcept String
ns NameClass
nc)
    = (String -> String -> String -> QName
mkQName String
"" String
illegalLocalName String
ns) QName -> [QName] -> [QName]
forall a. a -> [a] -> [a]
: (NameClass -> [QName]
representatives NameClass
nc)

representatives (Name String
ns String
ln)
    = [String -> String -> String -> QName
mkQName String
"" String
ln String
ns]

representatives (NameClassChoice NameClass
nc1 NameClass
nc2)
    = (NameClass -> [QName]
representatives NameClass
nc1) [QName] -> [QName] -> [QName]
forall a. [a] -> [a] -> [a]
++ (NameClass -> [QName]
representatives NameClass
nc2)

representatives NameClass
_
    = []

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

resetStates :: IOSArrow XmlTree XmlTree
resetStates :: IOSArrow XmlTree XmlTree
resetStates
    = ( IOSLA (XIOState ()) XmlTree Int -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (Int -> IOSLA (XIOState ()) XmlTree Int
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA Int
0  IOSLA (XIOState ()) XmlTree Int
-> IOSLA (XIOState ()) Int Int -> IOSLA (XIOState ()) XmlTree Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Selector XIOSysState Int -> IOSLA (XIOState ()) Int Int
forall c s. Selector XIOSysState c -> IOStateArrow s c c
setSysVar Selector XIOSysState Int
theRelaxDefineId)
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        IOSLA (XIOState ()) XmlTree Int -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (Int -> IOSLA (XIOState ()) XmlTree Int
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA Int
0  IOSLA (XIOState ()) XmlTree Int
-> IOSLA (XIOState ()) Int Int -> IOSLA (XIOState ()) XmlTree Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Selector XIOSysState Int -> IOSLA (XIOState ()) Int Int
forall c s. Selector XIOSysState c -> IOStateArrow s c c
setSysVar Selector XIOSysState Int
theRelaxNoOfErrors)
        IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ([XmlTree] -> IOSLA (XIOState ()) XmlTree [XmlTree]
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA [] IOSLA (XIOState ()) XmlTree [XmlTree]
-> IOSLA (XIOState ()) [XmlTree] XmlTree
-> IOSArrow 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 -> IOSLA (XIOState ()) [XmlTree] XmlTree
forall s. String -> IOStateArrow s [XmlTree] XmlTree
setRelaxParam String
"elementTable" )
      )


getAllDeepDefines :: IOSArrow XmlTree Env
getAllDeepDefines :: IOSArrow XmlTree [(String, XmlTree)]
getAllDeepDefines
    = IOSLA (XIOState ()) XmlTree (String, XmlTree)
-> IOSArrow XmlTree [(String, XmlTree)]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (IOSLA (XIOState ()) XmlTree (String, XmlTree)
 -> IOSArrow XmlTree [(String, XmlTree)])
-> IOSLA (XIOState ()) XmlTree (String, XmlTree)
-> IOSArrow XmlTree [(String, XmlTree)]
forall a b. (a -> b) -> a -> b
$ IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine
      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree (String, XmlTree)
-> IOSLA (XIOState ()) XmlTree (String, XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName IOSLA (XIOState ()) XmlTree String
-> IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this )


createUniqueNames :: IOSArrow [String] RefList
createUniqueNames :: IOSArrow [String] RefList
createUniqueNames
    = Int -> IOSArrow [String] RefList
forall {s}. Int -> IOSLA (XIOState s) [String] RefList
createUnique (Int -> IOSArrow [String] RefList)
-> IOSLA (XIOState ()) [String] Int -> IOSArrow [String] RefList
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< Selector XIOSysState Int -> IOSLA (XIOState ()) [String] Int
forall s a. Selector XIOSysState Int -> IOStateArrow s a Int
incrSysVar Selector XIOSysState Int
theRelaxDefineId
    where
    createUnique :: Int -> IOSLA (XIOState s) [String] RefList
createUnique Int
num
        = ([String] -> (RefList, Int))
-> IOSLA (XIOState s) [String] (RefList, Int)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Int -> [String] -> (RefList, Int)
unique Int
num)                              -- assign numbers to names
          IOSLA (XIOState s) [String] (RefList, Int)
-> IOSLA (XIOState s) (RefList, Int) RefList
-> IOSLA (XIOState s) [String] RefList
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( IOSLA (XIOState s) RefList RefList
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
            IOSLA (XIOState s) RefList RefList
-> IOSLA (XIOState s) Int Int
-> IOSLA (XIOState s) (RefList, Int) (RefList, Int)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
            IOSLA (XIOState s) Int Int -> IOSLA (XIOState s) Int Int
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (Selector XIOSysState Int -> IOSLA (XIOState s) Int Int
forall c s. Selector XIOSysState c -> IOStateArrow s c c
setSysVar Selector XIOSysState Int
theRelaxDefineId)        -- store next unused number
          )
          IOSLA (XIOState s) (RefList, Int) (RefList, Int)
-> IOSLA (XIOState s) (RefList, Int) RefList
-> IOSLA (XIOState s) (RefList, Int) RefList
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ((RefList, Int) -> RefList)
-> IOSLA (XIOState s) (RefList, Int) RefList
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (RefList, Int) -> RefList
forall a b. (a, b) -> a
fst
        where
        unique :: Int -> [String] -> (RefList, Int)
        unique :: Int -> [String] -> (RefList, Int)
unique Int
n0 [String]
l
            = ( (String -> Int -> (String, String)) -> [String] -> [Int] -> RefList
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ String
x Int
n -> (String
x, Int -> String
forall a. Show a => a -> String
show Int
n)) [String]
l [Int
n0 ..]
              , Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
l
              )

-- | Return all reachable defines from the start pattern

getRefsFromStartPattern :: IOSArrow XmlTree [String]
getRefsFromStartPattern :: IOSArrow XmlTree [String]
getRefsFromStartPattern
  = IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA
    ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngGrammar
      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngStart
      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRef
      IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
    )

removeUnreachableDefines :: Env -> [String] -> [String] -> IOSArrow XmlTree XmlTree
removeUnreachableDefines :: [(String, XmlTree)]
-> [String] -> [String] -> IOSArrow XmlTree XmlTree
removeUnreachableDefines [(String, XmlTree)]
allDefs [String]
processedDefs [String]
reachableDefs
    = (XmlTree -> Bool)
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP (Bool -> XmlTree -> Bool
forall a b. a -> b -> a
const (Bool -> XmlTree -> Bool) -> Bool -> XmlTree -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
unprocessedDefs [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [])
      ( [(String, XmlTree)]
-> [String] -> [String] -> IOSArrow XmlTree XmlTree
removeUnreachableDefines [(String, XmlTree)]
allDefs (String
nextTreeName String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
processedDefs) ([String] -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree [String] -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSArrow XmlTree [String]
forall n. IOSArrow n [String]
newReachableDefs )
      ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ -- root node
        IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ -- first grammar
        ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
          IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngDefine
            IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
            IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\String
n -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
n [String]
reachableDefs)
          )
        )
      )
    where
    unprocessedDefs :: [String]
    unprocessedDefs :: [String]
unprocessedDefs
        = [String]
reachableDefs [String] -> [String] -> [String]
forall {a}. Eq a => [a] -> [a] -> [a]
\\ [String]
processedDefs

    newReachableDefs :: IOSArrow n [String]
    newReachableDefs :: forall n. IOSArrow n [String]
newReachableDefs
        = XmlTree -> IOSLA (XIOState ()) n XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA XmlTree
getTree
          IOSLA (XIOState ()) n XmlTree
-> IOSArrow XmlTree [String] -> IOSLA (XIOState ()) n [String]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSLA (XIOState ()) XmlTree String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRef
                  IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                  IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getRngAttrName
                )
          IOSArrow XmlTree [String]
-> IOSLA (XIOState ()) [String] [String]
-> IOSArrow XmlTree [String]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ([String] -> [String]) -> IOSLA (XIOState ()) [String] [String]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ([String] -> [String]
forall a. Eq a => [a] -> [a]
noDoubles ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String]
reachableDefs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++))

    getTree :: XmlTree
    getTree :: XmlTree
getTree
        = Maybe XmlTree -> XmlTree
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe XmlTree -> XmlTree) -> Maybe XmlTree -> XmlTree
forall a b. (a -> b) -> a -> b
$ String -> [(String, XmlTree)] -> Maybe XmlTree
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
nextTreeName [(String, XmlTree)]
allDefs

    nextTreeName :: String
    nextTreeName :: String
nextTreeName
        = [String] -> String
forall a. [a] -> a
head [String]
unprocessedDefs


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


checkElemName :: [String] -> IOSArrow XmlTree XmlTree
checkElemName :: [String] -> IOSArrow XmlTree XmlTree
checkElemName [String]
l
    = ( IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem IOSArrow XmlTree XmlTree
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getLocalPart IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) String String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\String
s -> String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
s [String]
l) )
      IOSLA (XIOState ()) XmlTree String
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
      IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

wrapPattern2Two :: (ArrowXml a) => QName -> a XmlTree XmlTree
wrapPattern2Two :: forall (a :: * -> * -> *). ArrowXml a => QName -> a XmlTree XmlTree
wrapPattern2Two QName
name
  = [IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)]
-> a XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
    [ (Int -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(Int -> Bool) -> a XmlTree XmlTree
noOfChildren (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2)
      a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( (QName
-> a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
QName -> a n XmlTree -> a n XmlTree -> a n XmlTree
mkElement QName
name a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                               (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
>>. Int -> [XmlTree] -> [XmlTree]
forall a. Int -> [a] -> [a]
take Int
2)
                              )
                              a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                              (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
>>. Int -> [XmlTree] -> [XmlTree]
forall a. Int -> [a] -> [a]
drop Int
2)
                            )
            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
>>>
            QName -> a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => QName -> a XmlTree XmlTree
wrapPattern2Two QName
name
          )
    , (Int -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(Int -> Bool) -> a XmlTree XmlTree
noOfChildren (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
      a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
    , a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      a XmlTree XmlTree
-> a XmlTree XmlTree
-> IfThen (a XmlTree XmlTree) (a XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> a XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
    ]

(!>>>)          :: IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
IOSArrow XmlTree XmlTree
f !>>> :: IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
!>>> IOSArrow XmlTree XmlTree
g
    = IOSArrow XmlTree XmlTree
f
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSLA (XIOState ()) XmlTree Int
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA (Selector XIOSysState Int -> IOSLA (XIOState ()) XmlTree Int
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState Int
theRelaxNoOfErrors IOSLA (XIOState ()) XmlTree Int
-> IOSLA (XIOState ()) Int Int -> IOSLA (XIOState ()) XmlTree Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Bool) -> IOSLA (XIOState ()) Int Int
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0))
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
          IOSArrow XmlTree XmlTree
g

mkRelaxError :: String -> String -> IOSArrow n XmlTree
mkRelaxError :: forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError String
changesStr String
errStr
  = IOSLA (XIOState ()) n Int -> IOSLA (XIOState ()) n n
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (Int -> IOSLA (XIOState ()) n Int
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA Int
1 IOSLA (XIOState ()) n Int
-> IOSLA (XIOState ()) Int Int -> IOSLA (XIOState ()) n Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Selector XIOSysState Int
-> (Int -> Int -> Int) -> IOSLA (XIOState ()) Int Int
forall c b s.
Selector XIOSysState c -> (b -> c -> c) -> IOStateArrow s b b
chgSysVar Selector XIOSysState Int
theRelaxNoOfErrors Int -> Int -> Int
forall a. Num a => a -> a -> a
(+))
    IOSLA (XIOState ()) n n
-> IOSLA (XIOState ()) n XmlTree -> IOSLA (XIOState ()) n XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    IOSLA (XIOState ()) n XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => a n XmlTree
mkRngRelaxError
    IOSLA (XIOState ()) n XmlTree
-> IOSArrow XmlTree XmlTree -> IOSLA (XIOState ()) n XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrDescr String
errStr
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    ( if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
changesStr
      then IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      else String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addRngAttrChanges String
changesStr
    )

collectErrors :: IOSArrow XmlTree XmlTree
collectErrors :: IOSArrow XmlTree XmlTree
collectErrors
  = IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
    IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree Bool -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
    ( (Selector XIOSysState Bool -> IOSArrow XmlTree Bool
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState Bool
theRelaxCollectErrors IOSArrow XmlTree Bool
-> IOSLA (XIOState ()) Bool Bool -> IOSArrow XmlTree Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Bool -> Bool) -> IOSLA (XIOState ()) Bool Bool
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Bool -> Bool
not)
      IOSArrow XmlTree Bool
-> IOSLA (XIOState ()) Bool Bool -> IOSArrow XmlTree Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSLA (XIOState ()) Bool Bool
forall a. IOSArrow a a
errorsFound
    )

-- | errors found?
errorsFound :: IOSArrow a a
errorsFound :: forall a. IOSArrow a a
errorsFound
    = ( Selector XIOSysState Int -> IOStateArrow () a Int
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState Int
theRelaxNoOfErrors IOStateArrow () a Int
-> IOSLA (XIOState ()) Int Int -> IOStateArrow () a Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Bool) -> IOSLA (XIOState ()) Int Int
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) )
      IOStateArrow () a Int
-> IOSLA (XIOState ()) a a -> IOSLA (XIOState ()) a a
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
      IOSLA (XIOState ()) a a
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

-- | Returns the list of simplification errors or 'none'
getErrors :: IOSArrow XmlTree XmlTree
getErrors :: IOSArrow XmlTree XmlTree
getErrors = IOSArrow XmlTree XmlTree
forall a. IOSArrow a a
errorsFound
            IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
            IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
multi IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngRelaxError

setChangesAttr :: String -> IOSArrow XmlTree XmlTree
setChangesAttr :: String -> IOSArrow XmlTree XmlTree
setChangesAttr String
str
  = IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA (IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
hasRngAttrRelaxSimplificationChanges)
      ( IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processAttrl (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
          (String -> String) -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeAttrValue (String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str))
          IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngAttrRelaxSimplificationChanges
      )
      (String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowXml a => String -> a b XmlTree
mkRngAttrRelaxSimplificationChanges String
str)


getChangesAttr :: IOSArrow XmlTree String
getChangesAttr :: IOSLA (XIOState ()) XmlTree String
getChangesAttr
  = String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
a_relaxSimplificationChanges
    IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree String
-> IOSLA (XIOState ()) XmlTree (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
    String -> IOSLA (XIOState ()) XmlTree String
forall s b. String -> IOStateArrow s b String
getSysAttr String
a_output_changes
    IOSLA (XIOState ()) XmlTree (String, String)
-> IOSLA (XIOState ()) (String, String) String
-> IOSLA (XIOState ()) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    ((String, String) -> Bool)
-> IOSLA (XIOState ()) (String, String) String
-> IOSLA (XIOState ()) (String, String) String
-> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP (\(String
changes, String
param) -> String
changes String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& String
param String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1")
      ((String -> String -> String)
-> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 ((String -> String -> String)
 -> IOSLA (XIOState ()) (String, String) String)
-> (String -> String -> String)
-> IOSLA (XIOState ()) (String, String) String
forall a b. (a -> b) -> a -> b
$ \String
l String
_ -> String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
      (String -> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
"")

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

-- | Creates the simple form of a Relax NG schema
-- 
-- The schema document has to be parsed with namespace propagation

createSimpleForm :: Bool -> Bool -> Bool -> IOSArrow XmlTree XmlTree
createSimpleForm :: Bool -> Bool -> Bool -> IOSArrow XmlTree XmlTree
createSimpleForm Bool
checkRestrictions Bool
validateExternalRef Bool
validateInclude
    = Int -> String -> IOSArrow XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"createSimpleForm: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Bool, Bool, Bool) -> String
forall a. Show a => a -> String
show (Bool
checkRestrictions,Bool
validateExternalRef, Bool
validateInclude))
      IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ( if Bool
checkRestrictions
        then IOSArrow XmlTree XmlTree
createSimpleWithRest
        else IOSArrow XmlTree XmlTree
createSimpleWithoutRest
      )
    where

    createSimpleWithRest :: IOSArrow XmlTree XmlTree
    createSimpleWithRest :: IOSArrow XmlTree XmlTree
createSimpleWithRest
        = (IOSArrow XmlTree XmlTree
 -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree
-> [IOSArrow XmlTree XmlTree]
-> IOSArrow XmlTree XmlTree
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
(!>>>) IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this ([IOSArrow XmlTree XmlTree] -> IOSArrow XmlTree XmlTree)
-> [IOSArrow XmlTree XmlTree] -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
          [[IOSArrow XmlTree XmlTree]] -> [IOSArrow XmlTree XmlTree]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall (m :: * -> *) a. Monad m => a -> m a
return (IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree])
-> IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall a b. (a -> b) -> a -> b
$ String -> IOSArrow XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"relax NG: simplificationPart1 starts"
                 , [IOSArrow XmlTree XmlTree]
simplificationPart1
                 , IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall (m :: * -> *) a. Monad m => a -> m a
return (IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree])
-> IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall a b. (a -> b) -> a -> b
$ String -> IOSArrow XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"relax NG: simplificationPart1 done"
                 , [IOSArrow XmlTree XmlTree]
restrictionsPart1
                 , IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall (m :: * -> *) a. Monad m => a -> m a
return (IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree])
-> IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall a b. (a -> b) -> a -> b
$ String -> IOSArrow XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"relax NG: restrictionsPart1 done"
                 , [IOSArrow XmlTree XmlTree]
simplificationPart2
                 , IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall (m :: * -> *) a. Monad m => a -> m a
return (IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree])
-> IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall a b. (a -> b) -> a -> b
$ String -> IOSArrow XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"relax NG simplificationPart2 done"
                 , [IOSArrow XmlTree XmlTree]
restrictionsPart2
                 , IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall (m :: * -> *) a. Monad m => a -> m a
return (IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree])
-> IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall a b. (a -> b) -> a -> b
$ String -> IOSArrow XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"relax NG: restrictionsPart2 done"
                 , [IOSArrow XmlTree XmlTree]
finalCleanUp
                 , IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall (m :: * -> *) a. Monad m => a -> m a
return (IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree])
-> IOSArrow XmlTree XmlTree -> [IOSArrow XmlTree XmlTree]
forall a b. (a -> b) -> a -> b
$ String -> IOSArrow XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"relax NG: finalCleanUp done"
                 ]

    createSimpleWithoutRest :: IOSArrow XmlTree XmlTree
    createSimpleWithoutRest :: IOSArrow XmlTree XmlTree
createSimpleWithoutRest
        = (IOSArrow XmlTree XmlTree
 -> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree
-> [IOSArrow XmlTree XmlTree]
-> IOSArrow XmlTree XmlTree
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
(!>>>) IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this ([IOSArrow XmlTree XmlTree] -> IOSArrow XmlTree XmlTree)
-> [IOSArrow XmlTree XmlTree] -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
          [[IOSArrow XmlTree XmlTree]] -> [IOSArrow XmlTree XmlTree]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [IOSArrow XmlTree XmlTree]
simplificationPart1
                 , [IOSArrow XmlTree XmlTree]
simplificationPart2
                 , [IOSArrow XmlTree XmlTree]
finalCleanUp
                 ]

    simplificationPart1 :: [IOSArrow XmlTree XmlTree]
    simplificationPart1 :: [IOSArrow XmlTree XmlTree]
simplificationPart1
        = [ IOSArrow XmlTree XmlTree
simplificationStep1
          , Bool -> Bool -> [String] -> [String] -> IOSArrow XmlTree XmlTree
simplificationStep2 Bool
validateExternalRef Bool
validateInclude [] []
          , IOSArrow XmlTree XmlTree
simplificationStep3
          , IOSArrow XmlTree XmlTree
simplificationStep4
          ]

    simplificationPart2 :: [IOSArrow XmlTree XmlTree]
    simplificationPart2 :: [IOSArrow XmlTree XmlTree]
simplificationPart2
        = [ IOSArrow XmlTree XmlTree
simplificationStep5
          , IOSArrow XmlTree XmlTree
simplificationStep6
          , IOSArrow XmlTree XmlTree
simplificationStep7
          , IOSArrow XmlTree XmlTree
simplificationStep8
          ]

    restrictionsPart1 :: [IOSArrow XmlTree XmlTree]
    restrictionsPart1 :: [IOSArrow XmlTree XmlTree]
restrictionsPart1
        = [ IOSArrow XmlTree XmlTree
restrictionsStep1 ]

    restrictionsPart2 :: [IOSArrow XmlTree XmlTree]
    restrictionsPart2 :: [IOSArrow XmlTree XmlTree]
restrictionsPart2
        = [ IOSArrow XmlTree XmlTree
restrictionsStep2
          , IOSArrow XmlTree XmlTree
restrictionsStep3
          , IOSArrow XmlTree XmlTree
restrictionsStep4
          ]

    finalCleanUp :: [IOSArrow XmlTree XmlTree]
    finalCleanUp :: [IOSArrow XmlTree XmlTree]
finalCleanUp
        = [ IOSArrow XmlTree XmlTree
cleanUp
          ]

    cleanUp :: IOSArrow XmlTree XmlTree
    cleanUp :: IOSArrow XmlTree XmlTree
cleanUp = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown (IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
              String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
removeAttr String
a_relaxSimplificationChanges
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
removeAttr String
defineOrigName

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

setRelaxParam           :: String -> IOStateArrow s XmlTrees XmlTree
setRelaxParam :: forall s. String -> IOStateArrow s [XmlTree] XmlTree
setRelaxParam String
n         = Selector XIOSysState (AssocList String [XmlTree])
-> ([XmlTree]
    -> AssocList String [XmlTree] -> AssocList String [XmlTree])
-> IOStateArrow s [XmlTree] [XmlTree]
forall c b s.
Selector XIOSysState c -> (b -> c -> c) -> IOStateArrow s b b
chgSysVar Selector XIOSysState (AssocList String [XmlTree])
theRelaxAttrList (String
-> [XmlTree]
-> AssocList String [XmlTree]
-> AssocList String [XmlTree]
forall k v. Eq k => k -> v -> AssocList k v -> AssocList k v
addEntry String
n)
                          IOStateArrow s [XmlTree] [XmlTree]
-> IOSLA (XIOState s) [XmlTree] XmlTree
-> IOSLA (XIOState s) [XmlTree] XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          ([XmlTree] -> [XmlTree]) -> IOSLA (XIOState s) [XmlTree] XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL [XmlTree] -> [XmlTree]
forall a. a -> a
id

getRelaxParam           :: String -> IOStateArrow s b XmlTree
getRelaxParam :: forall s b. String -> IOStateArrow s b XmlTree
getRelaxParam String
n         = Selector XIOSysState (AssocList String [XmlTree])
-> IOStateArrow s b (AssocList String [XmlTree])
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState (AssocList String [XmlTree])
theRelaxAttrList
                          IOStateArrow s b (AssocList String [XmlTree])
-> IOSLA (XIOState s) (AssocList String [XmlTree]) XmlTree
-> IOSLA (XIOState s) b XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          (AssocList String [XmlTree] -> [XmlTree])
-> IOSLA (XIOState s) (AssocList String [XmlTree]) XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (String -> AssocList String [XmlTree] -> [XmlTree]
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
n)

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