module Text.XML.HXT.RelaxNG.XMLSchema.DataTypeLibW3C
( module Text.XML.HXT.XMLSchema.DataTypeLibW3CNames
, w3cDatatypeLib
)
where
import Data.Maybe
import Data.Ratio
import Network.URI (isURIReference)
import Text.Regex.XMLSchema.Generic (Regex, isZero,
matchRE,
parseRegex)
import Text.XML.HXT.DOM.QualifiedName (isNCName, isWellformedQualifiedName)
import Text.XML.HXT.XMLSchema.DataTypeLibW3CNames
import Text.XML.HXT.RelaxNG.DataTypeLibUtils
w3cDatatypeLib :: DatatypeLibrary
w3cDatatypeLib :: DatatypeLibrary
w3cDatatypeLib = (DatatypeName
w3cNS, DatatypeAllows
-> DatatypeEqual -> AllowedDatatypes -> DatatypeCheck
DTC DatatypeAllows
datatypeAllowsW3C DatatypeEqual
datatypeEqualW3C AllowedDatatypes
w3cDatatypes)
w3cDatatypes :: AllowedDatatypes
w3cDatatypes :: AllowedDatatypes
w3cDatatypes = [ (DatatypeName
xsd_string, AllowedParams
stringParams)
, (DatatypeName
xsd_normalizedString, AllowedParams
stringParams)
, (DatatypeName
xsd_token, AllowedParams
stringParams)
, (DatatypeName
xsd_language, AllowedParams
stringParams)
, (DatatypeName
xsd_NMTOKEN, AllowedParams
stringParams)
, (DatatypeName
xsd_NMTOKENS, AllowedParams
listParams )
, (DatatypeName
xsd_Name, AllowedParams
stringParams)
, (DatatypeName
xsd_NCName, AllowedParams
stringParams)
, (DatatypeName
xsd_ID, AllowedParams
stringParams)
, (DatatypeName
xsd_IDREF, AllowedParams
stringParams)
, (DatatypeName
xsd_IDREFS, AllowedParams
listParams )
, (DatatypeName
xsd_ENTITY, AllowedParams
stringParams)
, (DatatypeName
xsd_ENTITIES, AllowedParams
listParams )
, (DatatypeName
xsd_anyURI, AllowedParams
stringParams)
, (DatatypeName
xsd_QName, AllowedParams
stringParams)
, (DatatypeName
xsd_NOTATION, AllowedParams
stringParams)
, (DatatypeName
xsd_hexBinary, AllowedParams
stringParams)
, (DatatypeName
xsd_base64Binary, AllowedParams
stringParams)
, (DatatypeName
xsd_decimal, AllowedParams
decimalParams)
, (DatatypeName
xsd_integer, AllowedParams
integerParams)
, (DatatypeName
xsd_nonPositiveInteger, AllowedParams
integerParams)
, (DatatypeName
xsd_negativeInteger, AllowedParams
integerParams)
, (DatatypeName
xsd_nonNegativeInteger, AllowedParams
integerParams)
, (DatatypeName
xsd_positiveInteger, AllowedParams
integerParams)
, (DatatypeName
xsd_long, AllowedParams
integerParams)
, (DatatypeName
xsd_int, AllowedParams
integerParams)
, (DatatypeName
xsd_short, AllowedParams
integerParams)
, (DatatypeName
xsd_byte, AllowedParams
integerParams)
, (DatatypeName
xsd_unsignedLong, AllowedParams
integerParams)
, (DatatypeName
xsd_unsignedInt, AllowedParams
integerParams)
, (DatatypeName
xsd_unsignedShort, AllowedParams
integerParams)
, (DatatypeName
xsd_unsignedByte, AllowedParams
integerParams)
]
stringParams :: AllowedParams
stringParams :: AllowedParams
stringParams = DatatypeName
xsd_pattern DatatypeName -> AllowedParams -> AllowedParams
forall a. a -> [a] -> [a]
: ((DatatypeName, DatatypeName -> DatatypeName -> Bool)
-> DatatypeName)
-> [(DatatypeName, DatatypeName -> DatatypeName -> Bool)]
-> AllowedParams
forall a b. (a -> b) -> [a] -> [b]
map (DatatypeName, DatatypeName -> DatatypeName -> Bool)
-> DatatypeName
forall a b. (a, b) -> a
fst [(DatatypeName, DatatypeName -> DatatypeName -> Bool)]
fctTableString
patternValid :: ParamList -> CheckString
patternValid :: ParamList -> CheckString
patternValid ParamList
params
= (CheckString -> CheckString -> CheckString)
-> CheckString -> [CheckString] -> CheckString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>) CheckString
forall a. CheckA a a
ok ([CheckString] -> CheckString)
-> (ParamList -> [CheckString]) -> ParamList -> CheckString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DatatypeName, DatatypeName) -> CheckString)
-> ParamList -> [CheckString]
forall a b. (a -> b) -> [a] -> [b]
map (DatatypeName, DatatypeName) -> CheckString
paramPatternValid (ParamList -> CheckString) -> ParamList -> CheckString
forall a b. (a -> b) -> a -> b
$ ParamList
params
where
paramPatternValid :: (DatatypeName, DatatypeName) -> CheckString
paramPatternValid (DatatypeName
pn, DatatypeName
pv)
| DatatypeName
pn DatatypeName -> DatatypeName -> Bool
forall a. Eq a => a -> a -> Bool
== DatatypeName
xsd_pattern = (DatatypeName -> Bool)
-> (DatatypeName -> DatatypeName) -> CheckString
forall a. (a -> Bool) -> (a -> DatatypeName) -> CheckA a a
assert (DatatypeName -> DatatypeName -> Bool
patParamValid DatatypeName
pv) (DatatypeName -> DatatypeName -> DatatypeName -> DatatypeName
errorMsgParam DatatypeName
pn DatatypeName
pv)
| Bool
otherwise = CheckString
forall a. CheckA a a
ok
patParamValid :: String -> String -> Bool
patParamValid :: DatatypeName -> DatatypeName -> Bool
patParamValid DatatypeName
regex DatatypeName
a
| GenRegex DatatypeName -> Bool
forall s. GenRegex s -> Bool
isZero GenRegex DatatypeName
ex = Bool
False
| Bool
otherwise = GenRegex DatatypeName -> DatatypeName -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex DatatypeName
ex DatatypeName
a
where
ex :: GenRegex DatatypeName
ex = DatatypeName -> GenRegex DatatypeName
forall s. StringLike s => s -> GenRegex s
parseRegex DatatypeName
regex
decimalParams :: AllowedParams
decimalParams :: AllowedParams
decimalParams = DatatypeName
xsd_pattern DatatypeName -> AllowedParams -> AllowedParams
forall a. a -> [a] -> [a]
: ((DatatypeName, DatatypeName -> Rational -> Bool) -> DatatypeName)
-> [(DatatypeName, DatatypeName -> Rational -> Bool)]
-> AllowedParams
forall a b. (a -> b) -> [a] -> [b]
map (DatatypeName, DatatypeName -> Rational -> Bool) -> DatatypeName
forall a b. (a, b) -> a
fst [(DatatypeName, DatatypeName -> Rational -> Bool)]
fctTableDecimal
fctTableDecimal :: [(String, String -> Rational -> Bool)]
fctTableDecimal :: [(DatatypeName, DatatypeName -> Rational -> Bool)]
fctTableDecimal
= [ (DatatypeName
xsd_maxExclusive, (Rational -> Rational -> Bool) -> DatatypeName -> Rational -> Bool
cvd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
(>))
, (DatatypeName
xsd_minExclusive, (Rational -> Rational -> Bool) -> DatatypeName -> Rational -> Bool
cvd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
(<))
, (DatatypeName
xsd_maxInclusive, (Rational -> Rational -> Bool) -> DatatypeName -> Rational -> Bool
cvd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
(>=))
, (DatatypeName
xsd_minInclusive, (Rational -> Rational -> Bool) -> DatatypeName -> Rational -> Bool
cvd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
(<=))
, (DatatypeName
xsd_totalDigits, (Int -> Rational -> Bool) -> DatatypeName -> Rational -> Bool
cvi (\ Int
l Rational
v -> Rational -> Int
totalDigits Rational
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l))
, (DatatypeName
xsd_fractionDigits, (Int -> Rational -> Bool) -> DatatypeName -> Rational -> Bool
cvi (\ Int
l Rational
v -> Rational -> Int
fractionDigits Rational
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l))
]
where
cvd :: (Rational -> Rational -> Bool) -> (String -> Rational -> Bool)
cvd :: (Rational -> Rational -> Bool) -> DatatypeName -> Rational -> Bool
cvd Rational -> Rational -> Bool
op = \ DatatypeName
x Rational
y -> DatatypeName -> Bool
isDecimal DatatypeName
x Bool -> Bool -> Bool
&& DatatypeName -> Rational
readDecimal DatatypeName
x Rational -> Rational -> Bool
`op` Rational
y
cvi :: (Int -> Rational -> Bool) -> (String -> Rational -> Bool)
cvi :: (Int -> Rational -> Bool) -> DatatypeName -> Rational -> Bool
cvi Int -> Rational -> Bool
op = \ DatatypeName
x Rational
y -> DatatypeName -> Bool
isNumber DatatypeName
x Bool -> Bool -> Bool
&& DatatypeName -> Int
forall a. Read a => DatatypeName -> a
read DatatypeName
x Int -> Rational -> Bool
`op` Rational
y
decimalValid :: ParamList -> CheckA Rational Rational
decimalValid :: ParamList -> CheckA Rational Rational
decimalValid ParamList
params
= (CheckA Rational Rational
-> CheckA Rational Rational -> CheckA Rational Rational)
-> CheckA Rational Rational
-> [CheckA Rational Rational]
-> CheckA Rational Rational
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CheckA Rational Rational
-> CheckA Rational Rational -> CheckA Rational Rational
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>) CheckA Rational Rational
forall a. CheckA a a
ok ([CheckA Rational Rational] -> CheckA Rational Rational)
-> (ParamList -> [CheckA Rational Rational])
-> ParamList
-> CheckA Rational Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DatatypeName, DatatypeName) -> CheckA Rational Rational)
-> ParamList -> [CheckA Rational Rational]
forall a b. (a -> b) -> [a] -> [b]
map (DatatypeName, DatatypeName) -> CheckA Rational Rational
paramDecimalValid (ParamList -> CheckA Rational Rational)
-> ParamList -> CheckA Rational Rational
forall a b. (a -> b) -> a -> b
$ ParamList
params
where
paramDecimalValid :: (DatatypeName, DatatypeName) -> CheckA Rational Rational
paramDecimalValid (DatatypeName
pn, DatatypeName
pv)
= (Rational -> Bool)
-> (Rational -> DatatypeName) -> CheckA Rational Rational
forall a. (a -> Bool) -> (a -> DatatypeName) -> CheckA a a
assert
(((DatatypeName -> Rational -> Bool)
-> Maybe (DatatypeName -> Rational -> Bool)
-> DatatypeName
-> Rational
-> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Rational -> Bool) -> DatatypeName -> Rational -> Bool
forall a b. a -> b -> a
const ((Rational -> Bool) -> DatatypeName -> Rational -> Bool)
-> (Bool -> Rational -> Bool)
-> Bool
-> DatatypeName
-> Rational
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Rational -> Bool
forall a b. a -> b -> a
const (Bool -> DatatypeName -> Rational -> Bool)
-> Bool -> DatatypeName -> Rational -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
True) (Maybe (DatatypeName -> Rational -> Bool)
-> DatatypeName -> Rational -> Bool)
-> ([(DatatypeName, DatatypeName -> Rational -> Bool)]
-> Maybe (DatatypeName -> Rational -> Bool))
-> [(DatatypeName, DatatypeName -> Rational -> Bool)]
-> DatatypeName
-> Rational
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName
-> [(DatatypeName, DatatypeName -> Rational -> Bool)]
-> Maybe (DatatypeName -> Rational -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DatatypeName
pn ([(DatatypeName, DatatypeName -> Rational -> Bool)]
-> DatatypeName -> Rational -> Bool)
-> [(DatatypeName, DatatypeName -> Rational -> Bool)]
-> DatatypeName
-> Rational
-> Bool
forall a b. (a -> b) -> a -> b
$ [(DatatypeName, DatatypeName -> Rational -> Bool)]
fctTableDecimal) DatatypeName
pv)
(DatatypeName -> DatatypeName -> DatatypeName -> DatatypeName
errorMsgParam DatatypeName
pn DatatypeName
pv (DatatypeName -> DatatypeName)
-> (Rational -> DatatypeName) -> Rational -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> DatatypeName
showDecimal)
integerParams :: AllowedParams
integerParams :: AllowedParams
integerParams = DatatypeName
xsd_pattern DatatypeName -> AllowedParams -> AllowedParams
forall a. a -> [a] -> [a]
: ((DatatypeName, DatatypeName -> Integer -> Bool) -> DatatypeName)
-> [(DatatypeName, DatatypeName -> Integer -> Bool)]
-> AllowedParams
forall a b. (a -> b) -> [a] -> [b]
map (DatatypeName, DatatypeName -> Integer -> Bool) -> DatatypeName
forall a b. (a, b) -> a
fst [(DatatypeName, DatatypeName -> Integer -> Bool)]
fctTableInteger
fctTableInteger :: [(String, String -> Integer -> Bool)]
fctTableInteger :: [(DatatypeName, DatatypeName -> Integer -> Bool)]
fctTableInteger
= [ (DatatypeName
xsd_maxExclusive, (Integer -> Integer -> Bool) -> DatatypeName -> Integer -> Bool
cvi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>))
, (DatatypeName
xsd_minExclusive, (Integer -> Integer -> Bool) -> DatatypeName -> Integer -> Bool
cvi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<))
, (DatatypeName
xsd_maxInclusive, (Integer -> Integer -> Bool) -> DatatypeName -> Integer -> Bool
cvi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>=))
, (DatatypeName
xsd_minInclusive, (Integer -> Integer -> Bool) -> DatatypeName -> Integer -> Bool
cvi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=))
, (DatatypeName
xsd_totalDigits, (Integer -> Integer -> Bool) -> DatatypeName -> Integer -> Bool
cvi (\ Integer
l Integer
v -> Integer -> Integer
forall {a}. (Ord a, Num a, Show a) => a -> Integer
totalD Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
l))
]
where
cvi :: (Integer -> Integer -> Bool) -> (String -> Integer -> Bool)
cvi :: (Integer -> Integer -> Bool) -> DatatypeName -> Integer -> Bool
cvi Integer -> Integer -> Bool
op = \ DatatypeName
x Integer
y -> DatatypeName -> Bool
isNumber DatatypeName
x Bool -> Bool -> Bool
&& DatatypeName -> Integer
forall a. Read a => DatatypeName -> a
read DatatypeName
x Integer -> Integer -> Bool
`op` Integer
y
totalD :: a -> Integer
totalD a
i
| a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a -> Integer
totalD (a
0a -> a -> a
forall a. Num a => a -> a -> a
-a
i)
| Bool
otherwise = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (a -> Int) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (DatatypeName -> Int) -> (a -> DatatypeName) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DatatypeName
forall a. Show a => a -> DatatypeName
show (a -> Integer) -> a -> Integer
forall a b. (a -> b) -> a -> b
$ a
i
integerValid :: DatatypeName -> ParamList -> CheckA Integer Integer
integerValid :: DatatypeName -> ParamList -> CheckA Integer Integer
integerValid DatatypeName
datatype ParamList
params
= CheckA Integer Integer
assertInRange
CheckA Integer Integer
-> CheckA Integer Integer -> CheckA Integer Integer
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
((CheckA Integer Integer
-> CheckA Integer Integer -> CheckA Integer Integer)
-> CheckA Integer Integer
-> [CheckA Integer Integer]
-> CheckA Integer Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CheckA Integer Integer
-> CheckA Integer Integer -> CheckA Integer Integer
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>) CheckA Integer Integer
forall a. CheckA a a
ok ([CheckA Integer Integer] -> CheckA Integer Integer)
-> (ParamList -> [CheckA Integer Integer])
-> ParamList
-> CheckA Integer Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DatatypeName, DatatypeName) -> CheckA Integer Integer)
-> ParamList -> [CheckA Integer Integer]
forall a b. (a -> b) -> [a] -> [b]
map (DatatypeName, DatatypeName) -> CheckA Integer Integer
paramIntegerValid (ParamList -> CheckA Integer Integer)
-> ParamList -> CheckA Integer Integer
forall a b. (a -> b) -> a -> b
$ ParamList
params)
where
assertInRange :: CheckA Integer Integer
assertInRange :: CheckA Integer Integer
assertInRange
= (Integer -> Bool)
-> (Integer -> DatatypeName) -> CheckA Integer Integer
forall a. (a -> Bool) -> (a -> DatatypeName) -> CheckA a a
assert
((Integer -> Bool) -> Maybe (Integer -> Bool) -> Integer -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Bool -> Integer -> Bool
forall a b. a -> b -> a
const Bool
True) (Maybe (Integer -> Bool) -> Integer -> Bool)
-> ([(DatatypeName, Integer -> Bool)] -> Maybe (Integer -> Bool))
-> [(DatatypeName, Integer -> Bool)]
-> Integer
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName
-> [(DatatypeName, Integer -> Bool)] -> Maybe (Integer -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DatatypeName
datatype ([(DatatypeName, Integer -> Bool)] -> Integer -> Bool)
-> [(DatatypeName, Integer -> Bool)] -> Integer -> Bool
forall a b. (a -> b) -> a -> b
$ [(DatatypeName, Integer -> Bool)]
integerRangeTable)
(\ Integer
v -> ( DatatypeName
"Datatype " DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName -> DatatypeName
forall a. Show a => a -> DatatypeName
show DatatypeName
datatype DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++
DatatypeName
" with value = " DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ Integer -> DatatypeName
forall a. Show a => a -> DatatypeName
show Integer
v DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++
DatatypeName
" not in integer value range"
)
)
paramIntegerValid :: (DatatypeName, DatatypeName) -> CheckA Integer Integer
paramIntegerValid (DatatypeName
pn, DatatypeName
pv)
= (Integer -> Bool)
-> (Integer -> DatatypeName) -> CheckA Integer Integer
forall a. (a -> Bool) -> (a -> DatatypeName) -> CheckA a a
assert
(((DatatypeName -> Integer -> Bool)
-> Maybe (DatatypeName -> Integer -> Bool)
-> DatatypeName
-> Integer
-> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Integer -> Bool) -> DatatypeName -> Integer -> Bool
forall a b. a -> b -> a
const ((Integer -> Bool) -> DatatypeName -> Integer -> Bool)
-> (Bool -> Integer -> Bool)
-> Bool
-> DatatypeName
-> Integer
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Integer -> Bool
forall a b. a -> b -> a
const (Bool -> DatatypeName -> Integer -> Bool)
-> Bool -> DatatypeName -> Integer -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
True) (Maybe (DatatypeName -> Integer -> Bool)
-> DatatypeName -> Integer -> Bool)
-> ([(DatatypeName, DatatypeName -> Integer -> Bool)]
-> Maybe (DatatypeName -> Integer -> Bool))
-> [(DatatypeName, DatatypeName -> Integer -> Bool)]
-> DatatypeName
-> Integer
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName
-> [(DatatypeName, DatatypeName -> Integer -> Bool)]
-> Maybe (DatatypeName -> Integer -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DatatypeName
pn ([(DatatypeName, DatatypeName -> Integer -> Bool)]
-> DatatypeName -> Integer -> Bool)
-> [(DatatypeName, DatatypeName -> Integer -> Bool)]
-> DatatypeName
-> Integer
-> Bool
forall a b. (a -> b) -> a -> b
$ [(DatatypeName, DatatypeName -> Integer -> Bool)]
fctTableInteger) DatatypeName
pv)
(DatatypeName -> DatatypeName -> DatatypeName -> DatatypeName
errorMsgParam DatatypeName
pn DatatypeName
pv (DatatypeName -> DatatypeName)
-> (Integer -> DatatypeName) -> Integer -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DatatypeName
forall a. Show a => a -> DatatypeName
show)
integerRangeTable :: [(String, Integer -> Bool)]
integerRangeTable :: [(DatatypeName, Integer -> Bool)]
integerRangeTable = [ (DatatypeName
xsd_integer, Bool -> Integer -> Bool
forall a b. a -> b -> a
const Bool
True)
, (DatatypeName
xsd_nonPositiveInteger, (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=Integer
0) )
, (DatatypeName
xsd_negativeInteger, ( Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
0) )
, (DatatypeName
xsd_nonNegativeInteger, (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>=Integer
0) )
, (DatatypeName
xsd_positiveInteger, ( Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
0) )
, (DatatypeName
xsd_long, Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inR Integer
9223372036854775808)
, (DatatypeName
xsd_int, Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inR Integer
2147483648)
, (DatatypeName
xsd_short, Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inR Integer
32768)
, (DatatypeName
xsd_byte, Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inR Integer
128)
, (DatatypeName
xsd_unsignedLong, Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inP Integer
18446744073709551616)
, (DatatypeName
xsd_unsignedInt, Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inP Integer
4294967296)
, (DatatypeName
xsd_unsignedShort, Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inP Integer
65536)
, (DatatypeName
xsd_unsignedByte, Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inP Integer
256)
]
where
inR :: a -> a -> Bool
inR a
b a
i = (a
0 a -> a -> a
forall a. Num a => a -> a -> a
- a
b) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
i Bool -> Bool -> Bool
&& a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b
inP :: a -> a -> Bool
inP a
b a
i = a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
i Bool -> Bool -> Bool
&& a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b
listParams :: AllowedParams
listParams :: AllowedParams
listParams = DatatypeName
xsd_pattern DatatypeName -> AllowedParams -> AllowedParams
forall a. a -> [a] -> [a]
: ((DatatypeName, DatatypeName -> DatatypeName -> Bool)
-> DatatypeName)
-> [(DatatypeName, DatatypeName -> DatatypeName -> Bool)]
-> AllowedParams
forall a b. (a -> b) -> [a] -> [b]
map (DatatypeName, DatatypeName -> DatatypeName -> Bool)
-> DatatypeName
forall a b. (a, b) -> a
fst [(DatatypeName, DatatypeName -> DatatypeName -> Bool)]
fctTableList
listValid :: DatatypeName -> ParamList -> CheckString
listValid :: DatatypeName -> ParamList -> CheckString
listValid DatatypeName
d = [(DatatypeName, DatatypeName -> DatatypeName -> Bool)]
-> DatatypeName -> Integer -> Integer -> ParamList -> CheckString
stringValidFT [(DatatypeName, DatatypeName -> DatatypeName -> Bool)]
fctTableList DatatypeName
d Integer
0 (-Integer
1)
isNameList :: (String -> Bool) -> String -> Bool
isNameList :: (DatatypeName -> Bool) -> DatatypeName -> Bool
isNameList DatatypeName -> Bool
p DatatypeName
w
= Bool -> Bool
not (AllowedParams -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null AllowedParams
ts) Bool -> Bool -> Bool
&& (DatatypeName -> Bool) -> AllowedParams -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DatatypeName -> Bool
p AllowedParams
ts
where
ts :: AllowedParams
ts = DatatypeName -> AllowedParams
words DatatypeName
w
rex :: String -> Regex
rex :: DatatypeName -> GenRegex DatatypeName
rex DatatypeName
regex
| GenRegex DatatypeName -> Bool
forall s. GenRegex s -> Bool
isZero GenRegex DatatypeName
ex = DatatypeName -> GenRegex DatatypeName
forall a. HasCallStack => DatatypeName -> a
error (DatatypeName -> GenRegex DatatypeName)
-> DatatypeName -> GenRegex DatatypeName
forall a b. (a -> b) -> a -> b
$ DatatypeName
"syntax error in regexp " DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName -> DatatypeName
forall a. Show a => a -> DatatypeName
show DatatypeName
regex
| Bool
otherwise = GenRegex DatatypeName
ex
where
ex :: GenRegex DatatypeName
ex = DatatypeName -> GenRegex DatatypeName
forall s. StringLike s => s -> GenRegex s
parseRegex DatatypeName
regex
rexLanguage
, rexHexBinary
, rexBase64Binary
, rexDecimal
, rexInteger :: Regex
rexLanguage :: GenRegex DatatypeName
rexLanguage = DatatypeName -> GenRegex DatatypeName
rex DatatypeName
"[A-Za-z]{1,8}(-[A-Za-z]{1,8})*"
rexHexBinary :: GenRegex DatatypeName
rexHexBinary = DatatypeName -> GenRegex DatatypeName
rex DatatypeName
"([A-Fa-f0-9]{2})*"
rexBase64Binary :: GenRegex DatatypeName
rexBase64Binary = DatatypeName -> GenRegex DatatypeName
rex (DatatypeName -> GenRegex DatatypeName)
-> DatatypeName -> GenRegex DatatypeName
forall a b. (a -> b) -> a -> b
$
DatatypeName
"(" DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName
b64 DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName
"{4})*((" DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName
b64 DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName
"{2}==)|(" DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName
b64 DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName
"{3}=)|)"
where
b64 :: DatatypeName
b64 = DatatypeName
"[A-Za-z0-9+/]"
rexDecimal :: GenRegex DatatypeName
rexDecimal = DatatypeName -> GenRegex DatatypeName
rex DatatypeName
"(\\+|-)?(([0-9]+(\\.[0-9]*)?)|(\\.[0-9]+))"
rexInteger :: GenRegex DatatypeName
rexInteger = DatatypeName -> GenRegex DatatypeName
rex DatatypeName
"(\\+|-)?[0-9]+"
isLanguage
, isHexBinary
, isBase64Binary
, isDecimal
, isInteger :: String -> Bool
isLanguage :: DatatypeName -> Bool
isLanguage = GenRegex DatatypeName -> DatatypeName -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex DatatypeName
rexLanguage
isHexBinary :: DatatypeName -> Bool
isHexBinary = GenRegex DatatypeName -> DatatypeName -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex DatatypeName
rexHexBinary
isBase64Binary :: DatatypeName -> Bool
isBase64Binary = GenRegex DatatypeName -> DatatypeName -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex DatatypeName
rexBase64Binary
isDecimal :: DatatypeName -> Bool
isDecimal = GenRegex DatatypeName -> DatatypeName -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex DatatypeName
rexDecimal
isInteger :: DatatypeName -> Bool
isInteger = GenRegex DatatypeName -> DatatypeName -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex DatatypeName
rexInteger
normBase64 :: String -> String
normBase64 :: DatatypeName -> DatatypeName
normBase64 = (Char -> Bool) -> DatatypeName -> DatatypeName
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isB64
where
isB64 :: Char -> Bool
isB64 Char
c = ( Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')
Bool -> Bool -> Bool
||
( Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z')
Bool -> Bool -> Bool
||
( Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'='
readDecimal
, readDecimal' :: String -> Rational
readDecimal :: DatatypeName -> Rational
readDecimal (Char
'+':DatatypeName
s) = DatatypeName -> Rational
readDecimal' DatatypeName
s
readDecimal (Char
'-':DatatypeName
s) = Rational -> Rational
forall a. Num a => a -> a
negate (DatatypeName -> Rational
readDecimal' DatatypeName
s)
readDecimal DatatypeName
s = DatatypeName -> Rational
readDecimal' DatatypeName
s
readDecimal' :: DatatypeName -> Rational
readDecimal' DatatypeName
s
| Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)
| Bool
otherwise = (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Integer
f Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (DatatypeName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length DatatypeName
fs))))
where
(DatatypeName
ns, DatatypeName
fs') = (Char -> Bool) -> DatatypeName -> (DatatypeName, DatatypeName)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') DatatypeName
s
fs :: DatatypeName
fs = Int -> DatatypeName -> DatatypeName
forall a. Int -> [a] -> [a]
drop Int
1 DatatypeName
fs'
f :: Integer
f :: Integer
f | DatatypeName -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null DatatypeName
fs = Integer
0
| Bool
otherwise = DatatypeName -> Integer
forall a. Read a => DatatypeName -> a
read DatatypeName
fs
n :: Integer
n :: Integer
n | DatatypeName -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null DatatypeName
ns = Integer
0
| Bool
otherwise = DatatypeName -> Integer
forall a. Read a => DatatypeName -> a
read DatatypeName
ns
totalDigits
, totalDigits'
, fractionDigits :: Rational -> Int
totalDigits :: Rational -> Int
totalDigits Rational
r
| Rational
r Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = Int
0
| Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 = Rational -> Int
totalDigits' (Rational -> Int) -> (Rational -> Rational) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. Num a => a -> a
negate (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Rational
r
| Bool
otherwise = Rational -> Int
totalDigits' (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Rational
r
totalDigits' :: Rational -> Int
totalDigits' Rational
r
| Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = DatatypeName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (DatatypeName -> Int)
-> (Rational -> DatatypeName) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DatatypeName
forall a. Show a => a -> DatatypeName
show (Integer -> DatatypeName)
-> (Rational -> Integer) -> Rational -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Integer
forall a. Ratio a -> a
numerator (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Rational
r
| Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< (Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
1) = (\ Int
x -> Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> Int) -> (Rational -> Int) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Int
totalDigits' (Rational -> Int) -> (Rational -> Rational) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
1)) (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Rational
r
| Bool
otherwise = Rational -> Int
totalDigits' (Rational -> Int) -> (Rational -> Rational) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)) (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Rational
r
fractionDigits :: Rational -> Int
fractionDigits Rational
r
| Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Int
0
| Bool
otherwise = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Rational -> Int) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Int
fractionDigits (Rational -> Int) -> (Rational -> Rational) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)) (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Rational
r
showDecimal
, showDecimal' :: Rational -> String
showDecimal :: Rational -> DatatypeName
showDecimal Rational
d
| Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 = (Char
'-'Char -> DatatypeName -> DatatypeName
forall a. a -> [a] -> [a]
:) (DatatypeName -> DatatypeName)
-> (Rational -> DatatypeName) -> Rational -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> DatatypeName
showDecimal' (Rational -> DatatypeName)
-> (Rational -> Rational) -> Rational -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. Num a => a -> a
negate (Rational -> DatatypeName) -> Rational -> DatatypeName
forall a b. (a -> b) -> a -> b
$ Rational
d
| Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
1 = Int -> DatatypeName -> DatatypeName
forall a. Int -> [a] -> [a]
drop Int
1 (DatatypeName -> DatatypeName)
-> (Rational -> DatatypeName) -> Rational -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> DatatypeName
showDecimal' (Rational -> DatatypeName)
-> (Rational -> Rational) -> Rational -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
1)) (Rational -> DatatypeName) -> Rational -> DatatypeName
forall a b. (a -> b) -> a -> b
$ Rational
d
| Bool
otherwise = Rational -> DatatypeName
showDecimal' (Rational -> DatatypeName) -> Rational -> DatatypeName
forall a b. (a -> b) -> a -> b
$ Rational
d
showDecimal' :: Rational -> DatatypeName
showDecimal' Rational
d
| Rational -> Integer
forall a. Ratio a -> a
denominator Rational
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Integer -> DatatypeName
forall a. Show a => a -> DatatypeName
show (Integer -> DatatypeName)
-> (Rational -> Integer) -> Rational -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Integer
forall a. Ratio a -> a
numerator (Rational -> DatatypeName) -> Rational -> DatatypeName
forall a b. (a -> b) -> a -> b
$ Rational
d
| Bool
otherwise = Int -> Rational -> DatatypeName
forall {a}. (Integral a, Show a) => Int -> Ratio a -> DatatypeName
times10 Int
0 (Rational -> DatatypeName) -> Rational -> DatatypeName
forall a b. (a -> b) -> a -> b
$ Rational
d
where
times10 :: Int -> Ratio a -> DatatypeName
times10 Int
i' Ratio a
d'
| Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
d' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = let
(DatatypeName
x, DatatypeName
y) = Int -> DatatypeName -> (DatatypeName, DatatypeName)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i' (DatatypeName -> (DatatypeName, DatatypeName))
-> (Ratio a -> DatatypeName)
-> Ratio a
-> (DatatypeName, DatatypeName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName -> DatatypeName
forall a. [a] -> [a]
reverse (DatatypeName -> DatatypeName)
-> (Ratio a -> DatatypeName) -> Ratio a -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DatatypeName
forall a. Show a => a -> DatatypeName
show (a -> DatatypeName) -> (Ratio a -> a) -> Ratio a -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio a -> a
forall a. Ratio a -> a
numerator (Ratio a -> (DatatypeName, DatatypeName))
-> Ratio a -> (DatatypeName, DatatypeName)
forall a b. (a -> b) -> a -> b
$ Ratio a
d'
in
DatatypeName -> DatatypeName
forall a. [a] -> [a]
reverse DatatypeName
y DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName
"." DatatypeName -> DatatypeName -> DatatypeName
forall a. [a] -> [a] -> [a]
++ DatatypeName -> DatatypeName
forall a. [a] -> [a]
reverse DatatypeName
x
| Bool
otherwise = Int -> Ratio a -> DatatypeName
times10 (Int
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ratio a
d' Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
* (a
10 a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
1))
datatypeAllowsW3C :: DatatypeAllows
datatypeAllowsW3C :: DatatypeAllows
datatypeAllowsW3C DatatypeName
d ParamList
params DatatypeName
value Context
_
= CheckString -> DatatypeName -> Maybe DatatypeName
forall a b. CheckA a b -> a -> Maybe DatatypeName
performCheck CheckString
check DatatypeName
value
where
validString :: (DatatypeName -> DatatypeName) -> CheckString
validString DatatypeName -> DatatypeName
normFct
= CheckString
validPattern
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(DatatypeName -> DatatypeName) -> CheckString
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr DatatypeName -> DatatypeName
normFct
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
CheckString
validLength
validNormString :: CheckString
validNormString
= (DatatypeName -> DatatypeName) -> CheckString
validString DatatypeName -> DatatypeName
normalizeWhitespace
validPattern :: CheckString
validPattern
= ParamList -> CheckString
patternValid ParamList
params
validLength :: CheckString
validLength
= DatatypeName -> Integer -> Integer -> ParamList -> CheckString
stringValid DatatypeName
d Integer
0 (-Integer
1) ParamList
params
validList :: CheckString
validList
= CheckString
validPattern
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(DatatypeName -> DatatypeName) -> CheckString
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr DatatypeName -> DatatypeName
normalizeWhitespace
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
CheckString
validListLength
validListLength :: CheckString
validListLength
= DatatypeName -> ParamList -> CheckString
listValid DatatypeName
d ParamList
params
validName :: (DatatypeName -> Bool) -> CheckString
validName DatatypeName -> Bool
isN
= (DatatypeName -> Bool) -> CheckString
assertW3C DatatypeName -> Bool
isN
validNCName :: CheckString
validNCName
= CheckString
validNormString CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
validName DatatypeName -> Bool
isNCName
validQName :: CheckString
validQName
= CheckString
validNormString CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
validName DatatypeName -> Bool
isWellformedQualifiedName
validDecimal :: CheckString
validDecimal
= (DatatypeName -> DatatypeName) -> CheckString
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr DatatypeName -> DatatypeName
normalizeWhitespace
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(DatatypeName -> Bool) -> CheckString
assertW3C DatatypeName -> Bool
isDecimal
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(DatatypeName -> Rational)
-> CheckA Rational Rational -> CheckString
forall a b c. (a -> b) -> CheckA b c -> CheckA a a
checkWith DatatypeName -> Rational
readDecimal (ParamList -> CheckA Rational Rational
decimalValid ParamList
params)
validInteger :: DatatypeName -> CheckString
validInteger DatatypeName
inRange
= CheckString
validPattern
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(DatatypeName -> DatatypeName) -> CheckString
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr DatatypeName -> DatatypeName
normalizeWhitespace
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(DatatypeName -> Bool) -> CheckString
assertW3C DatatypeName -> Bool
isInteger
CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(DatatypeName -> Integer) -> CheckA Integer Integer -> CheckString
forall a b c. (a -> b) -> CheckA b c -> CheckA a a
checkWith DatatypeName -> Integer
forall a. Read a => DatatypeName -> a
read (DatatypeName -> ParamList -> CheckA Integer Integer
integerValid DatatypeName
inRange ParamList
params)
check :: CheckString
check :: CheckString
check = CheckString -> Maybe CheckString -> CheckString
forall a. a -> Maybe a -> a
fromMaybe CheckString
forall {b}. CheckA DatatypeName b
notFound (Maybe CheckString -> CheckString)
-> ([(DatatypeName, CheckString)] -> Maybe CheckString)
-> [(DatatypeName, CheckString)]
-> CheckString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName -> [(DatatypeName, CheckString)] -> Maybe CheckString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DatatypeName
d ([(DatatypeName, CheckString)] -> CheckString)
-> [(DatatypeName, CheckString)] -> CheckString
forall a b. (a -> b) -> a -> b
$ [(DatatypeName, CheckString)]
checks
notFound :: CheckA DatatypeName b
notFound = (DatatypeName -> DatatypeName) -> CheckA DatatypeName b
forall a b. (a -> DatatypeName) -> CheckA a b
failure ((DatatypeName -> DatatypeName) -> CheckA DatatypeName b)
-> (DatatypeName -> DatatypeName) -> CheckA DatatypeName b
forall a b. (a -> b) -> a -> b
$ DatatypeName
-> DatatypeName -> ParamList -> DatatypeName -> DatatypeName
errorMsgDataTypeNotAllowed DatatypeName
w3cNS DatatypeName
d ParamList
params
checks :: [(String, CheckA String String)]
checks :: [(DatatypeName, CheckString)]
checks = [ (DatatypeName
xsd_string, (DatatypeName -> DatatypeName) -> CheckString
validString DatatypeName -> DatatypeName
forall a. a -> a
id)
, (DatatypeName
xsd_normalizedString, (DatatypeName -> DatatypeName) -> CheckString
validString DatatypeName -> DatatypeName
normalizeBlanks)
, (DatatypeName
xsd_token, CheckString
validNormString)
, (DatatypeName
xsd_language, CheckString
validNormString CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
assertW3C DatatypeName -> Bool
isLanguage)
, (DatatypeName
xsd_NMTOKEN, CheckString
validNormString CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
validName DatatypeName -> Bool
isNmtoken)
, (DatatypeName
xsd_NMTOKENS, CheckString
validList CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
validName ((DatatypeName -> Bool) -> DatatypeName -> Bool
isNameList DatatypeName -> Bool
isNmtoken))
, (DatatypeName
xsd_Name, CheckString
validNormString CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
validName DatatypeName -> Bool
isName)
, (DatatypeName
xsd_NCName, CheckString
validNCName)
, (DatatypeName
xsd_ID, CheckString
validNCName)
, (DatatypeName
xsd_IDREF, CheckString
validNCName)
, (DatatypeName
xsd_IDREFS, CheckString
validList CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
validName ((DatatypeName -> Bool) -> DatatypeName -> Bool
isNameList DatatypeName -> Bool
isNCName))
, (DatatypeName
xsd_ENTITY, CheckString
validNCName)
, (DatatypeName
xsd_ENTITIES, CheckString
validList CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
validName ((DatatypeName -> Bool) -> DatatypeName -> Bool
isNameList DatatypeName -> Bool
isNCName))
, (DatatypeName
xsd_anyURI, (DatatypeName -> Bool) -> CheckString
validName DatatypeName -> Bool
isURIReference CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> DatatypeName) -> CheckString
validString DatatypeName -> DatatypeName
escapeURI)
, (DatatypeName
xsd_QName, CheckString
validQName)
, (DatatypeName
xsd_NOTATION, CheckString
validQName)
, (DatatypeName
xsd_hexBinary, (DatatypeName -> DatatypeName) -> CheckString
validString DatatypeName -> DatatypeName
forall a. a -> a
id CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
assertW3C DatatypeName -> Bool
isHexBinary)
, (DatatypeName
xsd_base64Binary, (DatatypeName -> DatatypeName) -> CheckString
validString DatatypeName -> DatatypeName
normBase64 CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DatatypeName -> Bool) -> CheckString
assertW3C DatatypeName -> Bool
isBase64Binary)
, (DatatypeName
xsd_decimal, CheckString
validPattern CheckString -> CheckString -> CheckString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> CheckString
validDecimal)
, (DatatypeName
xsd_integer, DatatypeName -> CheckString
validInteger DatatypeName
xsd_integer)
, (DatatypeName
xsd_nonPositiveInteger, DatatypeName -> CheckString
validInteger DatatypeName
xsd_nonPositiveInteger)
, (DatatypeName
xsd_negativeInteger, DatatypeName -> CheckString
validInteger DatatypeName
xsd_negativeInteger)
, (DatatypeName
xsd_nonNegativeInteger, DatatypeName -> CheckString
validInteger DatatypeName
xsd_nonNegativeInteger)
, (DatatypeName
xsd_positiveInteger, DatatypeName -> CheckString
validInteger DatatypeName
xsd_positiveInteger)
, (DatatypeName
xsd_long, DatatypeName -> CheckString
validInteger DatatypeName
xsd_long)
, (DatatypeName
xsd_int, DatatypeName -> CheckString
validInteger DatatypeName
xsd_int)
, (DatatypeName
xsd_short, DatatypeName -> CheckString
validInteger DatatypeName
xsd_short)
, (DatatypeName
xsd_byte, DatatypeName -> CheckString
validInteger DatatypeName
xsd_byte)
, (DatatypeName
xsd_unsignedLong, DatatypeName -> CheckString
validInteger DatatypeName
xsd_unsignedLong)
, (DatatypeName
xsd_unsignedInt, DatatypeName -> CheckString
validInteger DatatypeName
xsd_unsignedInt)
, (DatatypeName
xsd_unsignedShort, DatatypeName -> CheckString
validInteger DatatypeName
xsd_unsignedShort)
, (DatatypeName
xsd_unsignedByte, DatatypeName -> CheckString
validInteger DatatypeName
xsd_unsignedByte)
]
assertW3C :: (DatatypeName -> Bool) -> CheckString
assertW3C DatatypeName -> Bool
p = (DatatypeName -> Bool)
-> (DatatypeName -> DatatypeName) -> CheckString
forall a. (a -> Bool) -> (a -> DatatypeName) -> CheckA a a
assert DatatypeName -> Bool
p DatatypeName -> DatatypeName
errW3C
errW3C :: DatatypeName -> DatatypeName
errW3C = DatatypeName -> DatatypeName -> DatatypeName -> DatatypeName
errorMsgDataLibQName DatatypeName
w3cNS DatatypeName
d
datatypeEqualW3C :: DatatypeEqual
datatypeEqualW3C :: DatatypeEqual
datatypeEqualW3C DatatypeName
d DatatypeName
s1 Context
_ DatatypeName
s2 Context
_
= CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
-> (DatatypeName, DatatypeName) -> Maybe DatatypeName
forall a b. CheckA a b -> a -> Maybe DatatypeName
performCheck CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
check (DatatypeName
s1, DatatypeName
s2)
where
check :: CheckA (String, String) (String, String)
check :: CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
check = CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
-> ((DatatypeName -> DatatypeName)
-> CheckA
(DatatypeName, DatatypeName) (DatatypeName, DatatypeName))
-> Maybe (DatatypeName -> DatatypeName)
-> CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
forall {a} {b}. CheckA a b
notFound (DatatypeName -> DatatypeName)
-> CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
forall {t}.
(t -> DatatypeName) -> CheckA (t, t) (DatatypeName, DatatypeName)
found (Maybe (DatatypeName -> DatatypeName)
-> CheckA
(DatatypeName, DatatypeName) (DatatypeName, DatatypeName))
-> ([(DatatypeName, DatatypeName -> DatatypeName)]
-> Maybe (DatatypeName -> DatatypeName))
-> [(DatatypeName, DatatypeName -> DatatypeName)]
-> CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName
-> [(DatatypeName, DatatypeName -> DatatypeName)]
-> Maybe (DatatypeName -> DatatypeName)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DatatypeName
d ([(DatatypeName, DatatypeName -> DatatypeName)]
-> CheckA
(DatatypeName, DatatypeName) (DatatypeName, DatatypeName))
-> [(DatatypeName, DatatypeName -> DatatypeName)]
-> CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
forall a b. (a -> b) -> a -> b
$ [(DatatypeName, DatatypeName -> DatatypeName)]
norm
notFound :: CheckA a b
notFound = (a -> DatatypeName) -> CheckA a b
forall a b. (a -> DatatypeName) -> CheckA a b
failure ((a -> DatatypeName) -> CheckA a b)
-> (a -> DatatypeName) -> CheckA a b
forall a b. (a -> b) -> a -> b
$ DatatypeName -> a -> DatatypeName
forall a b. a -> b -> a
const (DatatypeName -> DatatypeName -> DatatypeName
errorMsgDataTypeNotAllowed0 DatatypeName
w3cNS DatatypeName
d)
found :: (t -> DatatypeName) -> CheckA (t, t) (DatatypeName, DatatypeName)
found t -> DatatypeName
nf = ((t, t) -> (DatatypeName, DatatypeName))
-> CheckA (t, t) (DatatypeName, DatatypeName)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ (t
x1, t
x2) -> (t -> DatatypeName
nf t
x1, t -> DatatypeName
nf t
x2))
CheckA (t, t) (DatatypeName, DatatypeName)
-> CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
-> CheckA (t, t) (DatatypeName, DatatypeName)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
((DatatypeName, DatatypeName) -> Bool)
-> ((DatatypeName, DatatypeName) -> DatatypeName)
-> CheckA (DatatypeName, DatatypeName) (DatatypeName, DatatypeName)
forall a. (a -> Bool) -> (a -> DatatypeName) -> CheckA a a
assert ((DatatypeName -> DatatypeName -> Bool)
-> (DatatypeName, DatatypeName) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DatatypeName -> DatatypeName -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ((DatatypeName -> DatatypeName -> DatatypeName)
-> (DatatypeName, DatatypeName) -> DatatypeName
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((DatatypeName -> DatatypeName -> DatatypeName)
-> (DatatypeName, DatatypeName) -> DatatypeName)
-> (DatatypeName -> DatatypeName -> DatatypeName)
-> (DatatypeName, DatatypeName)
-> DatatypeName
forall a b. (a -> b) -> a -> b
$ DatatypeName -> DatatypeName -> DatatypeName -> DatatypeName
errorMsgEqual DatatypeName
d)
norm :: [(DatatypeName, DatatypeName -> DatatypeName)]
norm = [ (DatatypeName
xsd_string, DatatypeName -> DatatypeName
forall a. a -> a
id )
, (DatatypeName
xsd_normalizedString, DatatypeName -> DatatypeName
normalizeBlanks )
, (DatatypeName
xsd_token, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_language, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_NMTOKEN, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_NMTOKENS, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_Name, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_NCName, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_ID, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_IDREF, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_IDREFS, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_ENTITY, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_ENTITIES, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_anyURI, DatatypeName -> DatatypeName
escapeURI (DatatypeName -> DatatypeName)
-> (DatatypeName -> DatatypeName) -> DatatypeName -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_QName, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_NOTATION, DatatypeName -> DatatypeName
normalizeWhitespace )
, (DatatypeName
xsd_hexBinary, DatatypeName -> DatatypeName
forall a. a -> a
id )
, (DatatypeName
xsd_base64Binary, DatatypeName -> DatatypeName
normBase64 )
, (DatatypeName
xsd_decimal, Rational -> DatatypeName
forall a. Show a => a -> DatatypeName
show (Rational -> DatatypeName)
-> (DatatypeName -> Rational) -> DatatypeName -> DatatypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName -> Rational
readDecimal (DatatypeName -> Rational)
-> (DatatypeName -> DatatypeName) -> DatatypeName -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeName -> DatatypeName
normalizeWhitespace )
]