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 !>>>
simplificationStep1 :: IOSArrow XmlTree XmlTree
simplificationStep1 :: IOSArrow XmlTree XmlTree
simplificationStep1
= (
( 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
>>>
(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 (AssocList String String -> NsEnv
toNsEnv [("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
>>>
String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
processdatatypeLib ""
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
(
(
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 (\ uri :: 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 (\ uri :: String
uri -> (String
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "" 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
>>>
(
( 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
>>>
(
(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
>>>
(
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
>>>
(
(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
>>>
(
( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError "" (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 (\ a :: String
a -> ( "datatypeLibrary attribute: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ " 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
>>>
(
String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
removeAttr "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
>>>
(
( String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr "type" "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 "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
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 uri :: 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 "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 )
(
(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 "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 "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 "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 "xml:base" String
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 "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
:-> (
(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 "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 "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 attrName :: String
attrName u :: 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 (\ a :: String
a -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (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
>>>
( (String -> String) -> IOSLA (XIOState ()) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ("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 env :: 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 "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 "" 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
createAttr :: (XName, XName) -> LA XmlTree XmlTree
createAttr :: (XName, XName) -> LA XmlTree XmlTree
createAttr (pre :: XName
pre, uri :: 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 env' :: NsEnv
env' name :: String
name
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
px
= 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
= String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError "" ( "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]
++
" 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]
++
", namespace env is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AssocList String String -> String
forall a. Show a => a -> String
show (((XName, XName) -> (String, String))
-> NsEnv -> AssocList String String
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
= String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr "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
processdatatypeLib :: (ArrowXml a) => String -> a XmlTree XmlTree
processdatatypeLib :: String -> a XmlTree XmlTree
processdatatypeLib lib :: 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 )
, ( (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 "datatypeLibrary" String
lib
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
simplificationStep2 :: Bool -> Bool -> [Uri] -> [Uri] -> IOSArrow XmlTree XmlTree
simplificationStep2 :: Bool -> Bool -> [String] -> [String] -> IOSArrow XmlTree XmlTree
simplificationStep2 validateExternalRef :: Bool
validateExternalRef validateInclude :: Bool
validateInclude extHRefs :: [String]
extHRefs includeHRefs :: [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 "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
importExternalRef :: String -> String -> IOSArrow XmlTree XmlTree
importExternalRef :: String -> String -> IOSArrow XmlTree XmlTree
importExternalRef ns :: String
ns href :: 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 ""
( "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
forall a. Show a => a -> String
show String
href String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": 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
then ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError ""
( "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]
++
", referenced in externalRef does not " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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
)
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
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
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
>>>
(
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 (\ a :: String
a -> String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
&& String
ns 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
>>>
String -> IOSArrow XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc ("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 href :: 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 ""
( "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' newDoc' :: 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
forall a. Show a => a -> String
show String
href String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": 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
then ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError ""
( "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]
++
", referenced in include does not " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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
)
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
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
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 href :: String
href newDoc :: XmlTree
newDoc
=
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
>>>
String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
removeAttr "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 newDoc :: XmlTree
newDoc hasStart :: Bool
hasStart defNames :: [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 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
>>>
(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
>>>
(([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
>>>
IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
setRngNameDiv
checkInclude :: String -> XmlTree -> IOSArrow XmlTree XmlTree
checkInclude :: String -> XmlTree -> IOSArrow XmlTree XmlTree
checkInclude href :: String
href newDoc :: 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 (
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 (\ (a :: Bool
a, b :: 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 (
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 (\ (a :: [String]
a, b :: [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 ""
( "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]
++
", referenced in include-pattern"
)
)
)
( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError ""
( "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]
++ ", referenced in include-pattern"
)
)
where
diff :: [a] -> [a] -> [a]
diff a :: [a]
a b :: [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 defNames :: [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 (\n :: 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
== "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 "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
== "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 (\xs :: [String]
xs -> [String
x | String
x <- [String]
xs, String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= ""])
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 ""
]
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 (
(
( 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 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
>>>
(
(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 "" 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 "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
>>>
String -> IOSArrow XmlTree XmlTree
processnsAttribute ""
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 (
(
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
>>>
(
( 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 :: String -> a XmlTree XmlTree
replaceNameAttr name :: String
name
| '}' 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
(pre' :: String
pre', local' :: 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
/= '}') 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 name :: 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)
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
)
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
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
]
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 (
(
(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
>>>
(
( 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 ("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
> 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 -> 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
> 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
>>>
(
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
> 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
>>>
(
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 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
== 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
>>>
(
((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 (\ i :: Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
-> 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 "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 ( "new text-Pattern: mixed is transformed into " String -> String -> String
forall a. [a] -> [a] -> [a]
++
" 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
>>>
(
( 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 "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 ( "new empty-Pattern: optional is transformed " String -> String -> String
forall a. [a] -> [a] -> [a]
++
" 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
>>>
(
( 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 "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 ( "zeroOrMore is transformed into a " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 ( "new empty-Pattern: zeroOrMore is transformed " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 ""
( "An except element that is a child of an anyName " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 ""
( "An except element that is a child of an nsName element " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 ""
( "A name element that occurs as the first child or descendant of " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"an attribute and has an ns attribute with an empty value must " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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
== "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 ""
( "A name or nsName element that occurs as the first child or " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"descendant of an attribute must not have an ns attribute " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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
>>>
( ( 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
checkDatatype :: Uri -> DatatypeName -> IOSArrow XmlTree XmlTree
checkDatatype :: String -> String -> IOSArrow XmlTree XmlTree
checkDatatype libName :: String
libName typeName :: 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 ""
( "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]
++ " not found" )
)
where
DTC _ _ allowedDataTypes :: 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
checkType :: Uri -> DatatypeName -> AllowedDatatypes -> IOSArrow XmlTree XmlTree
checkType :: String -> String -> AllowedDatatypes -> IOSArrow XmlTree XmlTree
checkType libName :: String
libName typeName :: String
typeName allowedTypes :: 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 ""
( "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]
++
" 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
checkParams :: DatatypeName -> Uri -> AllowedParams -> [ParamName] -> IOSArrow XmlTree XmlTree
checkParams :: String
-> String -> [String] -> [String] -> IOSArrow XmlTree XmlTree
checkParams typeName :: String
typeName libName :: String
libName allowedParams :: [String]
allowedParams paramNames :: [String]
paramNames
= ( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError ""
( "Param(s): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
formatStringListQuot [String]
diff String -> String -> String
forall a. [a] -> [a] -> [a]
++
" 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]
++
" 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 (\param :: 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
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 "" "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
>>>
( String -> Map String XmlTree -> IOSArrow XmlTree XmlTree
mergeCombinedPatternMap "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 "define" (String -> Bool -> String -> XmlTree -> XmlTree -> XmlTree
combinePatterns "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
>>>
( String -> Map String XmlTree -> IOSArrow XmlTree XmlTree
mergeCombinedPatternMap "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 "start" (String -> Bool -> String -> XmlTree -> XmlTree -> XmlTree
combinePatterns "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
>>>
(
( 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
>>>
( AssocList String String
-> AssocList String String -> IOSArrow XmlTree XmlTree
renameDefines (AssocList String String
-> AssocList String String -> IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
XmlTree
(AssocList String String, AssocList 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
$<<
( String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree [String]
getPatternNamesInGrammar "define"
IOSArrow XmlTree [String]
-> IOSLA
(XIOState ())
[String]
(AssocList String String, AssocList String String)
-> IOSLA
(XIOState ())
XmlTree
(AssocList String String, AssocList String String)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
( IOSArrow [String] (AssocList String String)
createUniqueNames
IOSArrow [String] (AssocList String String)
-> IOSArrow [String] (AssocList String String)
-> IOSLA
(XIOState ())
[String]
(AssocList String String, AssocList String String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
AssocList String String
-> IOSArrow [String] (AssocList String String)
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
>>>
( 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
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 (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
( (
( 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
>>>
(
( 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 :: String
-> (String -> XmlTree -> XmlTree -> XmlTree)
-> a XmlTree (Map String XmlTree)
getPatternNameMapInGrammar pattern :: String
pattern combinator :: 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 :: String -> a XmlTree [String]
getPatternNamesInGrammar pattern :: 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 :: AssocList String String
-> AssocList String String -> IOSArrow XmlTree XmlTree
renameDefines ref :: AssocList String String
ref parentRef :: AssocList String String
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
:-> (
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 "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 (\n :: 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 -> AssocList String String -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n AssocList String String
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
>>>
AssocList String String
-> AssocList String String -> IOSArrow XmlTree XmlTree
renameDefines AssocList String String
ref AssocList String String
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
:-> ( AssocList String String
-> AssocList String String -> IOSArrow XmlTree XmlTree
renameDefines (AssocList String String
-> AssocList String String -> IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
XmlTree
(AssocList String String, AssocList 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
$<<
( (
String -> IOSArrow XmlTree [String]
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree [String]
getPatternNamesInGrammar "define"
IOSArrow XmlTree [String]
-> IOSArrow [String] (AssocList String String)
-> IOSLA (XIOState ()) XmlTree (AssocList String String)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
IOSArrow [String] (AssocList String String)
createUniqueNames
)
IOSLA (XIOState ()) XmlTree (AssocList String String)
-> IOSLA (XIOState ()) XmlTree (AssocList String String)
-> IOSLA
(XIOState ())
XmlTree
(AssocList String String, AssocList String String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
AssocList String String
-> IOSLA (XIOState ()) XmlTree (AssocList String String)
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA AssocList String String
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 (\name :: String
name -> (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name (((String, String) -> String) -> AssocList String String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst AssocList String String
ref)))
)
(
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 "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 (\n :: 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 -> AssocList String String -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n AssocList String String
ref)
)
)
(
String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError "" (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 (\ n :: String
n -> ( "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]
++
" referenced in ref-Pattern not " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"found in schema"
)
)
)
)
)
, IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRngParentRef
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 (\name :: String
name -> (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name (((String, String) -> String) -> AssocList String String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst AssocList String String
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 "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 (\n :: 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 -> AssocList String String -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n AssocList String String
parentRef)
)
)
( String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError "" (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 (\ n :: String
n -> ( "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]
++
" referenced in parentRef-Pattern " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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
:-> AssocList String String
-> AssocList String String -> IOSArrow XmlTree XmlTree
renameDefines AssocList String String
ref AssocList String String
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 pattern :: String
pattern keepName :: Bool
keepName name :: String
name t1 :: XmlTree
t1 t2 :: XmlTree
t2 = XmlTree
combined
where [combined :: 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 (c1 :: String
c1, d1 :: XmlTree
d1) (c2 :: String
c2, d2 :: XmlTree
d2)
| String
c1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
&& String
c2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" = 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 ("More than one " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pattern String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-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]
++ " without a combine-attribute in the same grammar")
| String
c1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" = 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 -> 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 ("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]
++
" for the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pattern String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-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]
++ " in the same grammar")
combineWith :: String -> XmlTree -> XmlTree -> LA n XmlTree
combineWith :: String -> XmlTree -> XmlTree -> LA n XmlTree
combineWith c :: String
c d1 :: XmlTree
d1 d2 :: 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 "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 pattern :: String
pattern definitions :: 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
]
simplificationStep6 :: IOSArrow XmlTree XmlTree
simplificationStep6 :: IOSArrow XmlTree XmlTree
simplificationStep6 =
(
([(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
>>>
( 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 1 (String -> IOSArrow XmlTree XmlTree
forall s b. String -> IOStateArrow s b XmlTree
getRelaxParam "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
>>>
(AssocList String String
-> [(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 :: AssocList String String
-> [(String, XmlTree)] -> IOSArrow XmlTree XmlTree
replaceExpandableRefs foundNames :: AssocList String String
foundNames defTable :: [(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 (\name :: String
name -> String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name (((String, String) -> String) -> AssocList String String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst AssocList String String
foundNames))
)
(String -> String -> IOSArrow XmlTree XmlTree
forall n. String -> String -> IOSArrow n XmlTree
mkRelaxError "" (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 (\ n :: String
n -> ( "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) -> AssocList String String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd AssocList String String
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
$ AssocList String String
-> [(String, XmlTree)] -> IOSArrow XmlTree XmlTree
replaceExpandableRefs AssocList String String
foundNames [(String, XmlTree)]
defTable)
]
where
replaceRef :: NewName -> OldName -> IOSArrow XmlTree XmlTree
replaceRef :: String -> String -> IOSArrow XmlTree XmlTree
replaceRef name :: String
name oldname :: 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
>>>
AssocList String String
-> [(String, XmlTree)] -> IOSArrow XmlTree XmlTree
replaceExpandableRefs ((String
name,String
oldname)(String, String)
-> AssocList String String -> AssocList String String
forall a. a -> [a] -> [a]
:AssocList String String
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 parentIsDefine :: 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)
( AssocList String String -> IOSArrow XmlTree XmlTree
processElements' (AssocList String String -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (AssocList String 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 IOSLA (XIOState ()) XmlTree String
getDefineName
IOSArrow XmlTree [String]
-> IOSArrow [String] (AssocList String String)
-> IOSLA (XIOState ()) XmlTree (AssocList String String)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
IOSArrow [String] (AssocList String String)
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' :: AssocList String String -> IOSArrow XmlTree XmlTree
processElements' [(oldname :: String
oldname, name :: 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' l :: AssocList String String
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
$ "processElements' called with illegal arg: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AssocList String String -> String
forall a. Show a => a -> String
show AssocList String String
l
storeElement :: NewName -> OldName -> IOSArrow XmlTree XmlTree
storeElement :: String -> String -> IOSArrow XmlTree XmlTree
storeElement name :: String
name oldname :: 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 "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 "elementTable"
createAttr :: NewName -> OldName -> IOSArrow XmlTree XmlTree
createAttr :: String -> String -> IOSArrow XmlTree XmlTree
createAttr name :: String
name oldname :: 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 ("created for element " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
oldname)
getExpandableDefines :: (ArrowXml a) => a XmlTree Env
getExpandableDefines :: 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 :: 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
)
simplificationStep7 :: IOSArrow XmlTree XmlTree
simplificationStep7 :: IOSArrow XmlTree XmlTree
simplificationStep7
= ( Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged 0
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
( (
( ( 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 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`
(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
>>>
(
( 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 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 (\s :: [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
== 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
>>>
(
( 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 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
>>>
(
( ( Int -> IOSArrow XmlTree XmlTree
forall b. Int -> IOSArrow b b
markTreeChanged 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`
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
>>>
(
( 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 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 (\s :: [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
== 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
>>>
(
( 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 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
>>>
(
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
>>>
(
( 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 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
>>>
( 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 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)
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 :: IOSArrow b Int
hasTreeChanged
= Int -> String -> IOSArrow b Int
forall s b. Int -> String -> IOStateArrow s b Int
getSysAttrInt 0 "rng:changeTree"
IOSArrow b Int -> IOSLA (XIOState ()) Int Int -> IOSArrow 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
== 1)
markTreeChanged :: Int -> IOSArrow b b
markTreeChanged :: Int -> IOSArrow b b
markTreeChanged i :: Int
i
= IOSArrow b b -> IOSArrow b b
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (String -> Int -> IOSArrow b b
forall s b. String -> Int -> IOStateArrow s b b
setSysAttrInt "rng:changeTree" Int
i)
simplificationStep8 :: IOSArrow XmlTree XmlTree
simplificationStep8 :: IOSArrow XmlTree XmlTree
simplificationStep8
= ( ( [(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 [
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 (\n :: [String]
n -> [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Pattern not allowed as descendent(s)" String -> String -> String
forall a. [a] -> [a] -> [a]
++
" 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 )
),
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 (\ n :: [String]
n c :: String
c -> ( [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Pattern not allowed as descendent(s) " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 "" else " " 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]
++
" 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
)
),
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 (\n :: [String]
n -> [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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
)
),
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 (\n :: [String]
n -> [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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
)
),
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 [ "attribute", "data", "value", "text", "list",
"group", "interleave", "oneOrMore", "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 (\n :: [String]
n -> [String] -> String
formatStringListPatt [String]
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 [ "attribute", "data", "value", "text", "list",
"group", "interleave", "oneOrMore", "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 -> 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
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 (\ n :: String
n -> ( "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]
++ " contains a pattern that can match " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 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 (\a :: ContentType
a b :: 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 (\a :: ContentType
a b :: 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 (\t :: 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 CTEmpty _ = Bool
True
isGroupable _ CTEmpty = Bool
True
isGroupable CTComplex CTComplex = Bool
True
isGroupable _ _ = Bool
False
checkPattern :: IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
checkPattern :: IOSArrow (XmlTree, ([NameClass], [NameClass])) XmlTree
checkPattern
= (\ (_, (a :: [NameClass]
a, b :: [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 _ [] = Bool
False
isIn [] _ = Bool
False
isIn (x :: NameClass
x:xs :: [NameClass]
xs) ys :: [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 name :: String
name fct :: 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 )
)
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
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
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
)
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' nc :: [(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 -> 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 (\ n :: String
n -> ( "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]
++ " 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 "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 "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 ""
( "An attribute that has an anyName or nsName descendant element " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 ""
( "Both element-pattern occuring in an interleave " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"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 "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 "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 "" "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 (\(_, (a :: [String]
a, _)) -> [(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 (\(_, (_, b :: [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 nc' :: [(String, NameClass)]
nc' l :: [String]
l = (String -> NameClass) -> [String] -> [NameClass]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: 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 "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 "text" IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this )
overlap :: NameClass -> NameClass -> Bool
overlap :: NameClass -> NameClass -> Bool
overlap nc1 :: NameClass
nc1 nc2 :: 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 nc1 :: NameClass
nc1 nc2 :: NameClass
nc2 qn :: 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 = ""
illegalUri :: Uri
illegalUri :: String
illegalUri = "\x1"
representatives :: NameClass -> [QName]
representatives :: NameClass -> [QName]
representatives AnyName
= [String -> String -> String -> QName
mkQName "" String
illegalLocalName String
illegalUri]
representatives (AnyNameExcept nc :: NameClass
nc)
= (String -> String -> String -> QName
mkQName "" String
illegalLocalName String
illegalUri) QName -> [QName] -> [QName]
forall a. a -> [a] -> [a]
: (NameClass -> [QName]
representatives NameClass
nc)
representatives (NsName ns :: String
ns)
= [String -> String -> String -> QName
mkQName "" String
illegalLocalName String
ns]
representatives (NsNameExcept ns :: String
ns nc :: NameClass
nc)
= (String -> String -> String -> QName
mkQName "" String
illegalLocalName String
ns) QName -> [QName] -> [QName]
forall a. a -> [a] -> [a]
: (NameClass -> [QName]
representatives NameClass
nc)
representatives (Name ns :: String
ns ln :: String
ln)
= [String -> String -> String -> QName
mkQName "" String
ln String
ns]
representatives (NameClassChoice nc1 :: NameClass
nc1 nc2 :: NameClass
nc2)
= (NameClass -> [QName]
representatives NameClass
nc1) [QName] -> [QName] -> [QName]
forall a. [a] -> [a] -> [a]
++ (NameClass -> [QName]
representatives NameClass
nc2)
representatives _
= []
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 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 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 "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] (AssocList String String)
createUniqueNames
= Int -> IOSArrow [String] (AssocList String String)
forall s.
Int -> IOSLA (XIOState s) [String] (AssocList String String)
createUnique (Int -> IOSArrow [String] (AssocList String String))
-> IOSLA (XIOState ()) [String] Int
-> IOSArrow [String] (AssocList String String)
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] (AssocList String String)
createUnique num :: Int
num
= ([String] -> (AssocList String String, Int))
-> IOSLA (XIOState s) [String] (AssocList String String, Int)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Int -> [String] -> (AssocList String String, Int)
unique Int
num)
IOSLA (XIOState s) [String] (AssocList String String, Int)
-> IOSLA
(XIOState s)
(AssocList String String, Int)
(AssocList String String)
-> IOSLA (XIOState s) [String] (AssocList String 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 s) (AssocList String String) (AssocList String String)
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
IOSLA
(XIOState s) (AssocList String String) (AssocList String String)
-> IOSLA (XIOState s) Int Int
-> IOSLA
(XIOState s)
(AssocList String String, Int)
(AssocList String String, 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)
)
IOSLA
(XIOState s)
(AssocList String String, Int)
(AssocList String String, Int)
-> IOSLA
(XIOState s)
(AssocList String String, Int)
(AssocList String String)
-> IOSLA
(XIOState s)
(AssocList String String, Int)
(AssocList String String)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
((AssocList String String, Int) -> AssocList String String)
-> IOSLA
(XIOState s)
(AssocList String String, Int)
(AssocList String String)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (AssocList String String, Int) -> AssocList String String
forall a b. (a, b) -> a
fst
where
unique :: Int -> [String] -> (RefList, Int)
unique :: Int -> [String] -> (AssocList String String, Int)
unique n0 :: Int
n0 l :: [String]
l
= ( (String -> Int -> (String, String))
-> [String] -> [Int] -> AssocList String String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ x :: String
x n :: 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
)
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 allDefs :: [(String, XmlTree)]
allDefs processedDefs :: [String]
processedDefs reachableDefs :: [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
$
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
$
( 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 (\n :: 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 :: 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] -> IOSArrow 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 l :: [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 (\s :: 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 :: QName -> a XmlTree XmlTree
wrapPattern2Two name :: 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
> 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 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 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
== 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
f :: IOSArrow XmlTree XmlTree
f !>>> :: IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
!>>> g :: 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
> 0))
IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
IOSArrow XmlTree XmlTree
g
mkRelaxError :: String -> String -> IOSArrow n XmlTree
mkRelaxError :: String -> String -> IOSArrow n XmlTree
mkRelaxError changesStr :: String
changesStr errStr :: 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 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 -> IOSArrow n XmlTree -> IOSArrow n XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
IOSArrow n XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => a n XmlTree
mkRngRelaxError
IOSArrow n XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow 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
)
errorsFound :: IOSArrow a a
errorsFound :: 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
> 0) )
IOStateArrow () a Int -> IOSArrow a a -> IOSArrow a a
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
IOSArrow a a
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
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 str :: 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
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 (\(changes :: String
changes, param :: String
param) -> String
changes String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "" Bool -> Bool -> Bool
&& String
param String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "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
$ \l :: String
l _ -> " (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")
(String -> IOSLA (XIOState ()) (String, String) String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA "")
createSimpleForm :: Bool -> Bool -> Bool -> IOSArrow XmlTree XmlTree
createSimpleForm :: Bool -> Bool -> Bool -> IOSArrow XmlTree XmlTree
createSimpleForm checkRestrictions :: Bool
checkRestrictions validateExternalRef :: Bool
validateExternalRef validateInclude :: Bool
validateInclude
= Int -> String -> IOSArrow XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg 2 ("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 "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 "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 "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 "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 "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 "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 :: String -> IOStateArrow s [XmlTree] XmlTree
setRelaxParam n :: 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]
-> IOStateArrow s [XmlTree] XmlTree
-> IOStateArrow 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]) -> IOStateArrow 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 :: String -> IOStateArrow s b XmlTree
getRelaxParam n :: 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
-> IOStateArrow 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)