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