module Text.XML.HXT.RelaxNG.DataTypeLibraries
( datatypeLibraries
, datatypeEqual
, datatypeAllows
)
where
import Text.XML.HXT.DOM.Interface
( relaxNamespace
)
import Text.XML.HXT.RelaxNG.DataTypeLibUtils
import Text.XML.HXT.RelaxNG.DataTypeLibMysql
( mysqlDatatypeLib )
import Text.XML.HXT.RelaxNG.XMLSchema.DataTypeLibW3C
( w3cDatatypeLib )
import Data.Maybe
( fromJust )
datatypeLibraries :: DatatypeLibraries
datatypeLibraries :: DatatypeLibraries
datatypeLibraries
= [ DatatypeLibrary
relaxDatatypeLib
, DatatypeLibrary
relaxDatatypeLib'
, DatatypeLibrary
mysqlDatatypeLib
, DatatypeLibrary
w3cDatatypeLib
]
datatypeEqual :: Uri -> DatatypeEqual
datatypeEqual :: String -> DatatypeEqual
datatypeEqual String
uri String
d String
s1 Context
c1 String
s2 Context
c2
= if String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
uri ((DatatypeLibrary -> String) -> DatatypeLibraries -> [String]
forall a b. (a -> b) -> [a] -> [b]
map DatatypeLibrary -> String
forall a b. (a, b) -> a
fst DatatypeLibraries
datatypeLibraries)
then DatatypeEqual
dtEqFct String
d String
s1 Context
c1 String
s2 Context
c2
else String -> Maybe String
forall a. a -> Maybe a
Just ( String
"Unknown DatatypeLibrary " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
uri )
where
DTC DatatypeAllows
_ DatatypeEqual
dtEqFct AllowedDatatypes
_ = Maybe DatatypeCheck -> DatatypeCheck
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DatatypeCheck -> DatatypeCheck)
-> Maybe DatatypeCheck -> DatatypeCheck
forall a b. (a -> b) -> a -> b
$ String -> DatatypeLibraries -> Maybe DatatypeCheck
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
uri DatatypeLibraries
datatypeLibraries
datatypeAllows :: Uri -> DatatypeAllows
datatypeAllows :: String -> DatatypeAllows
datatypeAllows String
uri String
d ParamList
params String
s1 Context
c1
= if String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
uri ((DatatypeLibrary -> String) -> DatatypeLibraries -> [String]
forall a b. (a -> b) -> [a] -> [b]
map DatatypeLibrary -> String
forall a b. (a, b) -> a
fst DatatypeLibraries
datatypeLibraries)
then DatatypeAllows
dtAllowFct String
d ParamList
params String
s1 Context
c1
else String -> Maybe String
forall a. a -> Maybe a
Just ( String
"Unknown DatatypeLibrary " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
uri )
where
DTC DatatypeAllows
dtAllowFct DatatypeEqual
_ AllowedDatatypes
_ = Maybe DatatypeCheck -> DatatypeCheck
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DatatypeCheck -> DatatypeCheck)
-> Maybe DatatypeCheck -> DatatypeCheck
forall a b. (a -> b) -> a -> b
$ String -> DatatypeLibraries -> Maybe DatatypeCheck
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
uri DatatypeLibraries
datatypeLibraries
relaxDatatypeLib :: DatatypeLibrary
relaxDatatypeLib :: DatatypeLibrary
relaxDatatypeLib = (String
relaxNamespace, DatatypeAllows
-> DatatypeEqual -> AllowedDatatypes -> DatatypeCheck
DTC DatatypeAllows
datatypeAllowsRelax DatatypeEqual
datatypeEqualRelax AllowedDatatypes
relaxDatatypes)
relaxDatatypeLib' :: DatatypeLibrary
relaxDatatypeLib' :: DatatypeLibrary
relaxDatatypeLib' = (String
"", DatatypeAllows
-> DatatypeEqual -> AllowedDatatypes -> DatatypeCheck
DTC DatatypeAllows
datatypeAllowsRelax DatatypeEqual
datatypeEqualRelax AllowedDatatypes
relaxDatatypes)
relaxDatatypes :: AllowedDatatypes
relaxDatatypes :: AllowedDatatypes
relaxDatatypes
= ((String, String -> String -> Bool) -> (String, [String]))
-> [(String, String -> String -> Bool)] -> AllowedDatatypes
forall a b. (a -> b) -> [a] -> [b]
map ( (\ String
x -> (String
x, [])) (String -> (String, [String]))
-> ((String, String -> String -> Bool) -> String)
-> (String, String -> String -> Bool)
-> (String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String -> String -> Bool) -> String
forall a b. (a, b) -> a
fst ) [(String, String -> String -> Bool)]
relaxDatatypeTable
datatypeAllowsRelax :: DatatypeAllows
datatypeAllowsRelax :: DatatypeAllows
datatypeAllowsRelax String
d ParamList
p String
v Context
_
= Maybe String
-> ((String -> String -> Bool) -> Maybe String)
-> Maybe (String -> String -> Bool)
-> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe String
notAllowed' (String -> String -> Bool) -> Maybe String
forall {p} {a}. p -> Maybe a
allowed (Maybe (String -> String -> Bool) -> Maybe String)
-> ([(String, String -> String -> Bool)]
-> Maybe (String -> String -> Bool))
-> [(String, String -> String -> Bool)]
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [(String, String -> String -> Bool)]
-> Maybe (String -> String -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
d ([(String, String -> String -> Bool)] -> Maybe String)
-> [(String, String -> String -> Bool)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [(String, String -> String -> Bool)]
relaxDatatypeTable
where
notAllowed' :: Maybe String
notAllowed'
= String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String -> ParamList -> String -> String
errorMsgDataTypeNotAllowed String
relaxNamespace String
d ParamList
p String
v
allowed :: p -> Maybe a
allowed p
_
= Maybe a
forall a. Maybe a
Nothing
datatypeEqualRelax :: DatatypeEqual
datatypeEqualRelax :: DatatypeEqual
datatypeEqualRelax String
d String
s1 Context
_ String
s2 Context
_
= Maybe String
-> ((String -> String -> Bool) -> Maybe String)
-> Maybe (String -> String -> Bool)
-> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe String
notAllowed' (String -> String -> Bool) -> Maybe String
checkValues (Maybe (String -> String -> Bool) -> Maybe String)
-> ([(String, String -> String -> Bool)]
-> Maybe (String -> String -> Bool))
-> [(String, String -> String -> Bool)]
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [(String, String -> String -> Bool)]
-> Maybe (String -> String -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
d ([(String, String -> String -> Bool)] -> Maybe String)
-> [(String, String -> String -> Bool)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [(String, String -> String -> Bool)]
relaxDatatypeTable
where
notAllowed' :: Maybe String
notAllowed'
= String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String
errorMsgDataTypeNotAllowed2 String
relaxNamespace String
d String
s1 String
s2
checkValues :: (String -> String -> Bool) -> Maybe String
checkValues String -> String -> Bool
predicate
= if String -> String -> Bool
predicate String
s1 String
s2
then Maybe String
forall a. Maybe a
Nothing
else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
errorMsgEqual String
d String
s1 String
s2
relaxDatatypeTable :: [(String, String -> String -> Bool)]
relaxDatatypeTable :: [(String, String -> String -> Bool)]
relaxDatatypeTable
= [ (String
"string", String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==))
, (String
"token", \ String
s1 String
s2 -> String -> String
normalizeWhitespace String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> String
normalizeWhitespace String
s2 )
]