{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module Text.XML.HXT.RelaxNG.PatternToString
( patternToStringTree
, patternToFormatedString
, xmlTreeToPatternStringTree
, xmlTreeToPatternFormatedString
, xmlTreeToPatternString
, nameClassToString
)
where
import Control.Arrow.ListArrows
import Data.Tree.Class ( formatTree )
import Data.Tree.NTree.TypeDefs
import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.RelaxNG.DataTypes
import Text.XML.HXT.RelaxNG.CreatePattern
import Text.XML.HXT.RelaxNG.Utils
type PatternTree = NTree String
xmlTreeToPatternString :: LA XmlTree String
xmlTreeToPatternString :: LA XmlTree [Char]
xmlTreeToPatternString
= LA XmlTree Pattern
createPatternFromXmlTree
LA XmlTree Pattern -> (Pattern -> [Char]) -> LA XmlTree [Char]
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^
Pattern -> [Char]
forall a. Show a => a -> [Char]
show
nameClassToString :: NameClass -> String
nameClassToString :: NameClass -> [Char]
nameClassToString NameClass
AnyName
= [Char]
"AnyName"
nameClassToString (AnyNameExcept NameClass
nc)
= [Char]
"AnyNameExcept " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NameClass -> [Char]
nameClassToString NameClass
nc
nameClassToString (Name [Char]
uri [Char]
local)
= [Char]
"{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
uri [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
local
nameClassToString (NsName [Char]
uri)
= [Char]
"{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
uri [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
nameClassToString (NsNameExcept [Char]
uri NameClass
nc)
= [Char]
uri [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"except (NsName) " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NameClass -> [Char]
nameClassToString NameClass
nc
nameClassToString (NameClassChoice NameClass
nc1 NameClass
nc2)
= NameClass -> [Char]
nameClassToString NameClass
nc1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NameClass -> [Char]
nameClassToString NameClass
nc2
nameClassToString (NCError [Char]
e)
= [Char]
"NameClass Error: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e
patternToStringTree :: LA Pattern String
patternToStringTree :: LA Pattern [Char]
patternToStringTree
= [NameClass]
-> SLA [NameClass] Pattern PatternTree -> LA Pattern PatternTree
forall (a :: * -> * -> *) s b c.
ArrowList a =>
s -> SLA s b c -> a b c
fromSLA [] SLA [NameClass] Pattern PatternTree
pattern2PatternTree
LA Pattern PatternTree
-> (PatternTree -> [Char]) -> LA Pattern [Char]
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^
(\PatternTree
p -> ([Char] -> [Char]) -> PatternTree -> [Char]
forall a. (a -> [Char]) -> NTree a -> [Char]
forall (t :: * -> *) a. Tree t => (a -> [Char]) -> t a -> [Char]
formatTree [Char] -> [Char]
forall a. a -> a
id PatternTree
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n")
xmlTreeToPatternStringTree :: LA XmlTree String
xmlTreeToPatternStringTree :: LA XmlTree [Char]
xmlTreeToPatternStringTree
= LA XmlTree Pattern
createPatternFromXmlTree
LA XmlTree Pattern -> LA Pattern [Char] -> LA XmlTree [Char]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
LA Pattern [Char]
patternToStringTree
pattern2PatternTree :: SLA [NameClass] Pattern PatternTree
pattern2PatternTree :: SLA [NameClass] Pattern PatternTree
pattern2PatternTree
= [IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)]
-> SLA [NameClass] Pattern PatternTree
forall b c d.
[IfThen (SLA [NameClass] b c) (SLA [NameClass] b d)]
-> SLA [NameClass] b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
[ (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxEmpty SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> (PatternTree -> SLA [NameClass] Pattern PatternTree
forall c b. c -> SLA [NameClass] b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA (PatternTree -> SLA [NameClass] Pattern PatternTree)
-> PatternTree -> SLA [NameClass] Pattern PatternTree
forall a b. (a -> b) -> a -> b
$ [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
"empty" [])
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxNotAllowed SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern PatternTree
notAllowed2PatternTree
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxText SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> (PatternTree -> SLA [NameClass] Pattern PatternTree
forall c b. c -> SLA [NameClass] b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA (PatternTree -> SLA [NameClass] Pattern PatternTree)
-> PatternTree -> SLA [NameClass] Pattern PatternTree
forall a b. (a -> b) -> a -> b
$ [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
"text" [])
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxChoice SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern PatternTree
choice2PatternTree
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxInterleave SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern PatternTree
children2PatternTree [Char]
"interleave"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxGroup SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern PatternTree
children2PatternTree [Char]
"group"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxOneOrMore SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern PatternTree
children2PatternTree [Char]
"oneOrMore"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxList SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern PatternTree
children2PatternTree [Char]
"list"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxData SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern PatternTree
data2PatternTree
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxDataExcept SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern PatternTree
dataExcept2PatternTree
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxValue SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern PatternTree
value2PatternTree
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxAttribute SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern PatternTree
createPatternTreeFromElement [Char]
"attribute"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxElement SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern PatternTree
element2PatternTree
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxAfter SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> IfThen
(SLA [NameClass] Pattern Pattern)
(SLA [NameClass] Pattern PatternTree)
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern PatternTree
children2PatternTree [Char]
"after"
]
notAllowed2PatternTree :: SLA [NameClass] Pattern PatternTree
notAllowed2PatternTree :: SLA [NameClass] Pattern PatternTree
notAllowed2PatternTree
= (Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree)
-> (Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree
forall a b. (a -> b) -> a -> b
$ \(NotAllowed (ErrMsg ErrLevel
_l [[Char]]
sl)) -> [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
"notAllowed" (NTrees [Char] -> PatternTree) -> NTrees [Char] -> PatternTree
forall a b. (a -> b) -> a -> b
$ ([Char] -> PatternTree) -> [[Char]] -> NTrees [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\ [Char]
s -> [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
s []) [[Char]]
sl
data2PatternTree :: SLA [NameClass] Pattern PatternTree
data2PatternTree :: SLA [NameClass] Pattern PatternTree
data2PatternTree
= (Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree)
-> (Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree
forall a b. (a -> b) -> a -> b
$ \ (Data Datatype
d ParamList
p) -> [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
"data" [ Datatype -> PatternTree
datatype2PatternTree Datatype
d
, [Char] -> ParamList -> PatternTree
mapping2PatternTree [Char]
"parameter" ParamList
p
]
dataExcept2PatternTree :: SLA [NameClass] Pattern PatternTree
dataExcept2PatternTree :: SLA [NameClass] Pattern PatternTree
dataExcept2PatternTree
= SLA [NameClass] Pattern Pattern
forall b. SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern (NTrees [Char])
-> SLA [NameClass] Pattern (Pattern, NTrees [Char])
forall b c c'.
SLA [NameClass] b c
-> SLA [NameClass] b c' -> SLA [NameClass] b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern (NTrees [Char])
forall b c. SLA [NameClass] b c -> SLA [NameClass] b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern (NTrees [Char]))
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern (NTrees [Char])
forall a b. (a -> b) -> a -> b
$ (Pattern -> [Pattern]) -> SLA [NameClass] Pattern Pattern
forall b c. (b -> [c]) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL Pattern -> [Pattern]
getChildrenPattern SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SLA [NameClass] Pattern PatternTree
pattern2PatternTree)
SLA [NameClass] Pattern (Pattern, NTrees [Char])
-> SLA [NameClass] (Pattern, NTrees [Char]) PatternTree
-> SLA [NameClass] Pattern PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(Pattern -> NTrees [Char] -> PatternTree)
-> SLA [NameClass] (Pattern, NTrees [Char]) PatternTree
forall b1 b2 c. (b1 -> b2 -> c) -> SLA [NameClass] (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 ( \ (DataExcept Datatype
d ParamList
param Pattern
_) NTrees [Char]
pattern ->
[Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
"dataExcept" ([ Datatype -> PatternTree
datatype2PatternTree Datatype
d
, [Char] -> ParamList -> PatternTree
mapping2PatternTree [Char]
"parameter" ParamList
param
] NTrees [Char] -> NTrees [Char] -> NTrees [Char]
forall a. [a] -> [a] -> [a]
++ NTrees [Char]
pattern)
)
value2PatternTree :: SLA [NameClass] Pattern PatternTree
value2PatternTree :: SLA [NameClass] Pattern PatternTree
value2PatternTree
= (Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree)
-> (Pattern -> PatternTree) -> SLA [NameClass] Pattern PatternTree
forall a b. (a -> b) -> a -> b
$ \ (Value Datatype
d [Char]
v Context
c) -> [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree ([Char]
"value = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
v) [ Datatype -> PatternTree
datatype2PatternTree Datatype
d
, Context -> PatternTree
context2PatternTree Context
c
]
createPatternTreeFromElement :: String -> SLA [NameClass] Pattern PatternTree
createPatternTreeFromElement :: [Char] -> SLA [NameClass] Pattern PatternTree
createPatternTreeFromElement [Char]
name
= ( (Pattern -> NameClass) -> SLA [NameClass] Pattern NameClass
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Pattern -> NameClass
getNameClassFromPattern
SLA [NameClass] Pattern NameClass
-> SLA [NameClass] Pattern (NTrees [Char])
-> SLA [NameClass] Pattern (NameClass, NTrees [Char])
forall b c c'.
SLA [NameClass] b c
-> SLA [NameClass] b c' -> SLA [NameClass] b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern (NTrees [Char])
forall b c. SLA [NameClass] b c -> SLA [NameClass] b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ((Pattern -> [Pattern]) -> SLA [NameClass] Pattern Pattern
forall b c. (b -> [c]) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL Pattern -> [Pattern]
getChildrenPattern SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SLA [NameClass] Pattern PatternTree
pattern2PatternTree)
)
SLA [NameClass] Pattern (NameClass, NTrees [Char])
-> SLA [NameClass] (NameClass, NTrees [Char]) PatternTree
-> SLA [NameClass] Pattern PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(NameClass -> NTrees [Char] -> PatternTree)
-> SLA [NameClass] (NameClass, NTrees [Char]) PatternTree
forall b1 b2 c. (b1 -> b2 -> c) -> SLA [NameClass] (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 (\NameClass
nc NTrees [Char]
rl -> [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree ([Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NameClass -> [Char]
forall a. Show a => a -> [Char]
show NameClass
nc) NTrees [Char]
rl)
children2PatternTree :: String -> SLA [NameClass] Pattern PatternTree
children2PatternTree :: [Char] -> SLA [NameClass] Pattern PatternTree
children2PatternTree [Char]
name
= SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern (NTrees [Char])
forall b c. SLA [NameClass] b c -> SLA [NameClass] b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ((Pattern -> [Pattern]) -> SLA [NameClass] Pattern Pattern
forall b c. (b -> [c]) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL Pattern -> [Pattern]
getChildrenPattern SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SLA [NameClass] Pattern PatternTree
pattern2PatternTree)
SLA [NameClass] Pattern (NTrees [Char])
-> (NTrees [Char] -> PatternTree)
-> SLA [NameClass] Pattern PatternTree
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^
([Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
name)
choice2PatternTree :: SLA [NameClass] Pattern PatternTree
choice2PatternTree :: SLA [NameClass] Pattern PatternTree
choice2PatternTree
= SLA [NameClass] Pattern (NameClass, [NameClass])
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern PatternTree
forall b c d.
SLA [NameClass] b c
-> SLA [NameClass] b d
-> SLA [NameClass] b d
-> SLA [NameClass] b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA (
(Pattern -> Pattern) -> SLA [NameClass] Pattern Pattern
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ([Pattern] -> Pattern
forall a. HasCallStack => [a] -> a
last ([Pattern] -> Pattern)
-> (Pattern -> [Pattern]) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [Pattern]
getChildrenPattern) SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern (NameClass, [NameClass])
-> SLA [NameClass] Pattern (NameClass, [NameClass])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Pattern -> Bool
isRelaxElement) SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern (NameClass, [NameClass])
-> SLA [NameClass] Pattern (NameClass, [NameClass])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
((Pattern -> NameClass) -> SLA [NameClass] Pattern NameClass
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Pattern -> NameClass
getNameClassFromPattern SLA [NameClass] Pattern NameClass
-> SLA [NameClass] Pattern [NameClass]
-> SLA [NameClass] Pattern (NameClass, [NameClass])
forall b c c'.
SLA [NameClass] b c
-> SLA [NameClass] b c' -> SLA [NameClass] b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SLA [NameClass] Pattern [NameClass]
forall b. SLA [NameClass] b [NameClass]
forall s (a :: * -> * -> *) b. ArrowState s a => a b s
getState) SLA [NameClass] Pattern (NameClass, [NameClass])
-> SLA
[NameClass] (NameClass, [NameClass]) (NameClass, [NameClass])
-> SLA [NameClass] Pattern (NameClass, [NameClass])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
((NameClass, [NameClass]) -> Bool)
-> SLA
[NameClass] (NameClass, [NameClass]) (NameClass, [NameClass])
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA(\ (NameClass
nc, [NameClass]
liste) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ NameClass -> [NameClass] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem NameClass
nc [NameClass]
liste)
)
(
(Pattern -> [Pattern]) -> SLA [NameClass] Pattern [Pattern]
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Pattern -> [Pattern]
getChildrenPattern
SLA [NameClass] Pattern [Pattern]
-> SLA [NameClass] [Pattern] PatternTree
-> SLA [NameClass] Pattern PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
([NameClass] -> [Pattern] -> [NameClass])
-> SLA [NameClass] [Pattern] [Pattern]
forall b. ([NameClass] -> b -> [NameClass]) -> SLA [NameClass] b b
forall s (a :: * -> * -> *) b.
ArrowState s a =>
(s -> b -> s) -> a b b
changeState (\[NameClass]
s [Pattern]
p -> (Pattern -> NameClass
getNameClassFromPattern ([Pattern] -> Pattern
forall a. HasCallStack => [a] -> a
last [Pattern]
p)) NameClass -> [NameClass] -> [NameClass]
forall a. a -> [a] -> [a]
: [NameClass]
s)
SLA [NameClass] [Pattern] [Pattern]
-> SLA [NameClass] [Pattern] PatternTree
-> SLA [NameClass] [Pattern] PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
( ( [Pattern] -> Pattern
forall a. HasCallStack => [a] -> a
head ([Pattern] -> Pattern)
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] [Pattern] PatternTree
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> SLA [NameClass] Pattern PatternTree
pattern2PatternTree )
SLA [NameClass] [Pattern] PatternTree
-> SLA [NameClass] [Pattern] PatternTree
-> SLA [NameClass] [Pattern] (PatternTree, PatternTree)
forall b c c'.
SLA [NameClass] b c
-> SLA [NameClass] b c' -> SLA [NameClass] b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
( [Pattern] -> Pattern
forall a. HasCallStack => [a] -> a
last ([Pattern] -> Pattern)
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] [Pattern] PatternTree
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> [Char] -> SLA [NameClass] Pattern PatternTree
createPatternTreeFromElement [Char]
"element" )
)
SLA [NameClass] [Pattern] (PatternTree, PatternTree)
-> SLA [NameClass] (PatternTree, PatternTree) PatternTree
-> SLA [NameClass] [Pattern] PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(PatternTree -> PatternTree -> PatternTree)
-> SLA [NameClass] (PatternTree, PatternTree) PatternTree
forall b1 b2 c. (b1 -> b2 -> c) -> SLA [NameClass] (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 ( \ PatternTree
l1 PatternTree
l2 -> [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
"choice" [PatternTree
l1, PatternTree
l2] )
)
( [Char] -> SLA [NameClass] Pattern PatternTree
children2PatternTree [Char]
"choice" )
element2PatternTree :: SLA [NameClass] Pattern PatternTree
element2PatternTree :: SLA [NameClass] Pattern PatternTree
element2PatternTree
= SLA [NameClass] Pattern (NameClass, [NameClass])
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern PatternTree
forall b c d.
SLA [NameClass] b c
-> SLA [NameClass] b d
-> SLA [NameClass] b d
-> SLA [NameClass] b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( ((Pattern -> NameClass) -> SLA [NameClass] Pattern NameClass
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Pattern -> NameClass
getNameClassFromPattern SLA [NameClass] Pattern NameClass
-> SLA [NameClass] Pattern [NameClass]
-> SLA [NameClass] Pattern (NameClass, [NameClass])
forall b c c'.
SLA [NameClass] b c
-> SLA [NameClass] b c' -> SLA [NameClass] b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SLA [NameClass] Pattern [NameClass]
forall b. SLA [NameClass] b [NameClass]
forall s (a :: * -> * -> *) b. ArrowState s a => a b s
getState)
SLA [NameClass] Pattern (NameClass, [NameClass])
-> SLA
[NameClass] (NameClass, [NameClass]) (NameClass, [NameClass])
-> SLA [NameClass] Pattern (NameClass, [NameClass])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
((NameClass, [NameClass]) -> Bool)
-> SLA
[NameClass] (NameClass, [NameClass]) (NameClass, [NameClass])
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ (NameClass
nc, [NameClass]
liste) -> NameClass -> [NameClass] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem NameClass
nc [NameClass]
liste)
)
( (Pattern -> NameClass) -> SLA [NameClass] Pattern NameClass
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Pattern -> NameClass
getNameClassFromPattern
SLA [NameClass] Pattern NameClass
-> SLA [NameClass] NameClass PatternTree
-> SLA [NameClass] Pattern PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(NameClass -> PatternTree) -> SLA [NameClass] NameClass PatternTree
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\NameClass
nc -> [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree ([Char]
"reference to element " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NameClass -> [Char]
forall a. Show a => a -> [Char]
show NameClass
nc) [])
)
( ([NameClass] -> Pattern -> [NameClass])
-> SLA [NameClass] Pattern Pattern
forall b. ([NameClass] -> b -> [NameClass]) -> SLA [NameClass] b b
forall s (a :: * -> * -> *) b.
ArrowState s a =>
(s -> b -> s) -> a b b
changeState (\ [NameClass]
s Pattern
p -> (Pattern -> NameClass
getNameClassFromPattern Pattern
p) NameClass -> [NameClass] -> [NameClass]
forall a. a -> [a] -> [a]
: [NameClass]
s)
SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern PatternTree
-> SLA [NameClass] Pattern PatternTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
[Char] -> SLA [NameClass] Pattern PatternTree
createPatternTreeFromElement [Char]
"element"
)
mapping2PatternTree :: String -> [(Prefix, Uri)] -> PatternTree
mapping2PatternTree :: [Char] -> ParamList -> PatternTree
mapping2PatternTree [Char]
name ParamList
mapping
= [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
name ((Datatype -> PatternTree) -> ParamList -> NTrees [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
a, [Char]
b) -> [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree ([Char]
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
b) []) ParamList
mapping)
datatype2PatternTree :: Datatype -> PatternTree
datatype2PatternTree :: Datatype -> PatternTree
datatype2PatternTree Datatype
dt
= [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree (Datatype -> [Char]
datatype2String Datatype
dt) []
context2PatternTree :: Context -> PatternTree
context2PatternTree :: Context -> PatternTree
context2PatternTree ([Char]
base, ParamList
mapping)
= [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree [Char]
"context" [ [Char] -> NTrees [Char] -> PatternTree
forall a. a -> NTrees a -> NTree a
NTree ([Char]
"base-uri = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
base) []
, [Char] -> ParamList -> PatternTree
mapping2PatternTree [Char]
"namespace environment" ParamList
mapping
]
xmlTreeToPatternFormatedString :: LA XmlTree String
xmlTreeToPatternFormatedString :: LA XmlTree [Char]
xmlTreeToPatternFormatedString
= LA XmlTree Pattern
createPatternFromXmlTree
LA XmlTree Pattern -> LA Pattern [Char] -> LA XmlTree [Char]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
[NameClass] -> SLA [NameClass] Pattern [Char] -> LA Pattern [Char]
forall (a :: * -> * -> *) s b c.
ArrowList a =>
s -> SLA s b c -> a b c
fromSLA [] SLA [NameClass] Pattern [Char]
patternToFormatedString
patternToFormatedString :: SLA [NameClass] Pattern String
patternToFormatedString :: SLA [NameClass] Pattern [Char]
patternToFormatedString
= [IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])]
-> SLA [NameClass] Pattern [Char]
forall b c d.
[IfThen (SLA [NameClass] b c) (SLA [NameClass] b d)]
-> SLA [NameClass] b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
[ (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxEmpty SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> ([Char] -> SLA [NameClass] Pattern [Char]
forall c b. c -> SLA [NameClass] b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA [Char]
" empty ")
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxNotAllowed SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> ((Pattern -> [Char]) -> SLA [NameClass] Pattern [Char]
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Pattern -> [Char]) -> SLA [NameClass] Pattern [Char])
-> (Pattern -> [Char]) -> SLA [NameClass] Pattern [Char]
forall a b. (a -> b) -> a -> b
$ \ (NotAllowed ErrMessage
errorEnv) -> ErrMessage -> [Char]
forall a. Show a => a -> [Char]
show ErrMessage
errorEnv)
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxText SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> ([Char] -> SLA [NameClass] Pattern [Char]
forall c b. c -> SLA [NameClass] b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA [Char]
" text ")
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxChoice SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern [Char]
children2FormatedString [Char]
"choice"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxInterleave SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern [Char]
children2FormatedString [Char]
"interleave"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxGroup SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern [Char]
children2FormatedString [Char]
"group"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxOneOrMore SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern [Char]
children2FormatedString [Char]
"oneOrMore"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxList SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern [Char]
children2FormatedString [Char]
"list"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxData SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern [Char]
data2FormatedString
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxDataExcept SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern [Char]
dataExcept2FormatedString
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxValue SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern [Char]
value2FormatedString
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxAttribute SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern [Char]
createFormatedStringFromElement [Char]
"attribute"
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxElement SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> SLA [NameClass] Pattern [Char]
element2FormatedString
, (Pattern -> Bool) -> SLA [NameClass] Pattern Pattern
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA Pattern -> Bool
isRelaxAfter SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char]
-> IfThen
(SLA [NameClass] Pattern Pattern) (SLA [NameClass] Pattern [Char])
forall a b. a -> b -> IfThen a b
:-> [Char] -> SLA [NameClass] Pattern [Char]
children2FormatedString [Char]
"after"
]
children2FormatedString :: String -> SLA [NameClass] Pattern String
children2FormatedString :: [Char] -> SLA [NameClass] Pattern [Char]
children2FormatedString [Char]
name
= SLA [NameClass] Pattern [Char] -> SLA [NameClass] Pattern [[Char]]
forall b c. SLA [NameClass] b c -> SLA [NameClass] b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ((Pattern -> [Pattern]) -> SLA [NameClass] Pattern Pattern
forall b c. (b -> [c]) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL Pattern -> [Pattern]
getChildrenPattern SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char] -> SLA [NameClass] Pattern [Char]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SLA [NameClass] Pattern [Char]
patternToFormatedString)
SLA [NameClass] Pattern [[Char]]
-> ([[Char]] -> [Char]) -> SLA [NameClass] Pattern [Char]
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^
(\ [[Char]]
l -> [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
formatStringListPatt [[Char]]
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") " )
data2FormatedString :: SLA [NameClass] Pattern String
data2FormatedString :: SLA [NameClass] Pattern [Char]
data2FormatedString
= (Pattern -> [Char]) -> SLA [NameClass] Pattern [Char]
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ( \ (Data Datatype
datatype ParamList
paramList) ->
[Char]
"Data " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Datatype -> [Char]
datatype2String Datatype
datatype [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char] -> ParamList -> [Char]
mapping2String [Char]
"parameter" ParamList
paramList [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
)
dataExcept2FormatedString :: SLA [NameClass] Pattern String
dataExcept2FormatedString :: SLA [NameClass] Pattern [Char]
dataExcept2FormatedString
= (Pattern -> [Char]) -> SLA [NameClass] Pattern [Char]
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ( \ (DataExcept Datatype
datatype ParamList
paramList Pattern
_) ->
[Char]
"DataExcept " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Datatype -> [Char]
forall a. Show a => a -> [Char]
show Datatype
datatype [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char] -> ParamList -> [Char]
mapping2String [Char]
"parameter" ParamList
paramList [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n "
)
SLA [NameClass] Pattern [Char]
-> SLA [NameClass] Pattern [Char]
-> SLA [NameClass] Pattern Datatype
forall b c c'.
SLA [NameClass] b c
-> SLA [NameClass] b c' -> SLA [NameClass] b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
( (Pattern -> Pattern) -> SLA [NameClass] Pattern Pattern
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ (DataExcept Datatype
_ ParamList
_ Pattern
p) -> Pattern
p) SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char] -> SLA [NameClass] Pattern [Char]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SLA [NameClass] Pattern [Char]
patternToFormatedString )
SLA [NameClass] Pattern Datatype
-> SLA [NameClass] Datatype [Char]
-> SLA [NameClass] Pattern [Char]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
([Char] -> [Char] -> [Char]) -> SLA [NameClass] Datatype [Char]
forall b1 b2 c. (b1 -> b2 -> c) -> SLA [NameClass] (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++)
value2FormatedString :: SLA [NameClass] Pattern String
value2FormatedString :: SLA [NameClass] Pattern [Char]
value2FormatedString
= (Pattern -> [Char]) -> SLA [NameClass] Pattern [Char]
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Pattern -> [Char]) -> SLA [NameClass] Pattern [Char])
-> (Pattern -> [Char]) -> SLA [NameClass] Pattern [Char]
forall a b. (a -> b) -> a -> b
$ \(Value Datatype
datatype [Char]
val Context
context) ->
[Char]
"Value = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
val [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Datatype -> [Char]
datatype2String Datatype
datatype [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Context -> [Char]
context2String Context
context [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
element2FormatedString :: SLA [NameClass] Pattern String
element2FormatedString :: SLA [NameClass] Pattern [Char]
element2FormatedString
= SLA [NameClass] Pattern (NameClass, [NameClass])
-> SLA [NameClass] Pattern [Char]
-> SLA [NameClass] Pattern [Char]
-> SLA [NameClass] Pattern [Char]
forall b c d.
SLA [NameClass] b c
-> SLA [NameClass] b d
-> SLA [NameClass] b d
-> SLA [NameClass] b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( ((Pattern -> NameClass) -> SLA [NameClass] Pattern NameClass
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Pattern -> NameClass
getNameClassFromPattern SLA [NameClass] Pattern NameClass
-> SLA [NameClass] Pattern [NameClass]
-> SLA [NameClass] Pattern (NameClass, [NameClass])
forall b c c'.
SLA [NameClass] b c
-> SLA [NameClass] b c' -> SLA [NameClass] b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SLA [NameClass] Pattern [NameClass]
forall b. SLA [NameClass] b [NameClass]
forall s (a :: * -> * -> *) b. ArrowState s a => a b s
getState)
SLA [NameClass] Pattern (NameClass, [NameClass])
-> SLA
[NameClass] (NameClass, [NameClass]) (NameClass, [NameClass])
-> SLA [NameClass] Pattern (NameClass, [NameClass])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
((NameClass, [NameClass]) -> Bool)
-> SLA
[NameClass] (NameClass, [NameClass]) (NameClass, [NameClass])
forall b. (b -> Bool) -> SLA [NameClass] b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ (NameClass
nc, [NameClass]
liste) -> NameClass -> [NameClass] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem NameClass
nc [NameClass]
liste)
)
( (Pattern -> NameClass) -> SLA [NameClass] Pattern NameClass
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Pattern -> NameClass
getNameClassFromPattern
SLA [NameClass] Pattern NameClass
-> (NameClass -> [Char]) -> SLA [NameClass] Pattern [Char]
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^
( \NameClass
nc -> [Char]
"reference to element " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NameClass -> [Char]
nameClassToString NameClass
nc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " )
)
( ([NameClass] -> Pattern -> [NameClass])
-> SLA [NameClass] Pattern Pattern
forall b. ([NameClass] -> b -> [NameClass]) -> SLA [NameClass] b b
forall s (a :: * -> * -> *) b.
ArrowState s a =>
(s -> b -> s) -> a b b
changeState (\ [NameClass]
s Pattern
p -> (Pattern -> NameClass
getNameClassFromPattern Pattern
p) NameClass -> [NameClass] -> [NameClass]
forall a. a -> [a] -> [a]
: [NameClass]
s)
SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char] -> SLA [NameClass] Pattern [Char]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
[Char] -> SLA [NameClass] Pattern [Char]
createFormatedStringFromElement [Char]
"element"
)
createFormatedStringFromElement :: String -> SLA [NameClass] Pattern String
createFormatedStringFromElement :: [Char] -> SLA [NameClass] Pattern [Char]
createFormatedStringFromElement [Char]
name
= ( (Pattern -> NameClass) -> SLA [NameClass] Pattern NameClass
forall b c. (b -> c) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Pattern -> NameClass
getNameClassFromPattern
SLA [NameClass] Pattern NameClass
-> SLA [NameClass] Pattern [Char]
-> SLA [NameClass] Pattern (NameClass, [Char])
forall b c c'.
SLA [NameClass] b c
-> SLA [NameClass] b c' -> SLA [NameClass] b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
( SLA [NameClass] Pattern [Char] -> SLA [NameClass] Pattern [[Char]]
forall b c. SLA [NameClass] b c -> SLA [NameClass] b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ((Pattern -> [Pattern]) -> SLA [NameClass] Pattern Pattern
forall b c. (b -> [c]) -> SLA [NameClass] b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL Pattern -> [Pattern]
getChildrenPattern SLA [NameClass] Pattern Pattern
-> SLA [NameClass] Pattern [Char] -> SLA [NameClass] Pattern [Char]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SLA [NameClass] Pattern [Char]
patternToFormatedString)
SLA [NameClass] Pattern [[Char]]
-> ([[Char]] -> [Char]) -> SLA [NameClass] Pattern [Char]
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^
[[Char]] -> [Char]
formatStringListId
)
)
SLA [NameClass] Pattern (NameClass, [Char])
-> SLA [NameClass] (NameClass, [Char]) [Char]
-> SLA [NameClass] Pattern [Char]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(NameClass -> [Char] -> [Char])
-> SLA [NameClass] (NameClass, [Char]) [Char]
forall b1 b2 c. (b1 -> b2 -> c) -> SLA [NameClass] (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 (\ NameClass
nc [Char]
rl -> [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ NameClass -> [Char]
nameClassToString NameClass
nc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rl [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
mapping2String :: String -> [(Prefix, Uri)] -> String
mapping2String :: [Char] -> ParamList -> [Char]
mapping2String [Char]
name ParamList
mapping
= [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
([Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
formatStringList [Char] -> [Char]
forall a. a -> a
id [Char]
", " ((Datatype -> [Char]) -> ParamList -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
a, [Char]
b) -> [Char]
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
b) ParamList
mapping)
datatype2String :: Datatype -> String
datatype2String :: Datatype -> [Char]
datatype2String ([Char]
lib, [Char]
localName)
= [Char]
"datatypelibrary = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
getLib [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", type = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
localName
where
getLib :: [Char]
getLib = if [Char]
lib [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" then [Char]
relaxNamespace else [Char]
lib
context2String :: Context -> String
context2String :: Context -> [Char]
context2String ([Char]
base, ParamList
mapping)
= [Char]
"context (base-uri = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
base [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char] -> ParamList -> [Char]
mapping2String [Char]
"namespace environment" ParamList
mapping [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"