-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.XMLSchema.DataTypeLibW3C
   Copyright  : Copyright (C) 2005-2010 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable
   Version    : $Id$

   Datatype library for the W3C XML schema datatypes

-}

-- ------------------------------------------------------------

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

-- ------------------------------------------------------------

-- | The main entry point to the W3C XML schema datatype library.
--
-- The 'DTC' constructor exports the list of supported datatypes and params.
-- It also exports the specialized functions to validate a XML instance value with
-- respect to a datatype.
w3cDatatypeLib :: DatatypeLibrary
w3cDatatypeLib :: DatatypeLibrary
w3cDatatypeLib = (String
w3cNS, DatatypeAllows
-> DatatypeEqual -> AllowedDatatypes -> DatatypeCheck
DTC DatatypeAllows
datatypeAllowsW3C DatatypeEqual
datatypeEqualW3C AllowedDatatypes
w3cDatatypes)


-- | All supported datatypes of the library
w3cDatatypes :: AllowedDatatypes
w3cDatatypes :: AllowedDatatypes
w3cDatatypes = [ (String
xsd_string,                   AllowedParams
stringParams)
               , (String
xsd_normalizedString,         AllowedParams
stringParams)
               , (String
xsd_token,                    AllowedParams
stringParams)
               , (String
xsd_language,                 AllowedParams
stringParams)
               , (String
xsd_NMTOKEN,                  AllowedParams
stringParams)
               , (String
xsd_NMTOKENS,                 AllowedParams
listParams  )
               , (String
xsd_Name,                     AllowedParams
stringParams)
               , (String
xsd_NCName,                   AllowedParams
stringParams)
               , (String
xsd_ID,                       AllowedParams
stringParams)
               , (String
xsd_IDREF,                    AllowedParams
stringParams)
               , (String
xsd_IDREFS,                   AllowedParams
listParams  )
               , (String
xsd_ENTITY,                   AllowedParams
stringParams)
               , (String
xsd_ENTITIES,                 AllowedParams
listParams  )
               , (String
xsd_anyURI,                   AllowedParams
stringParams)
               , (String
xsd_QName,                    AllowedParams
stringParams)
               , (String
xsd_NOTATION,                 AllowedParams
stringParams)
               , (String
xsd_hexBinary,                AllowedParams
stringParams)
               , (String
xsd_base64Binary,             AllowedParams
stringParams)
               , (String
xsd_decimal,                  AllowedParams
decimalParams)
               , (String
xsd_integer,                  AllowedParams
integerParams)
               , (String
xsd_nonPositiveInteger,       AllowedParams
integerParams)
               , (String
xsd_negativeInteger,          AllowedParams
integerParams)
               , (String
xsd_nonNegativeInteger,       AllowedParams
integerParams)
               , (String
xsd_positiveInteger,          AllowedParams
integerParams)
               , (String
xsd_long,                     AllowedParams
integerParams)
               , (String
xsd_int,                      AllowedParams
integerParams)
               , (String
xsd_short,                    AllowedParams
integerParams)
               , (String
xsd_byte,                     AllowedParams
integerParams)
               , (String
xsd_unsignedLong,             AllowedParams
integerParams)
               , (String
xsd_unsignedInt,              AllowedParams
integerParams)
               , (String
xsd_unsignedShort,            AllowedParams
integerParams)
               , (String
xsd_unsignedByte,             AllowedParams
integerParams)
               ]

-- ----------------------------------------

-- | List of allowed params for the string datatypes
stringParams    :: AllowedParams
stringParams :: AllowedParams
stringParams    = String
xsd_pattern String -> AllowedParams -> AllowedParams
forall a. a -> [a] -> [a]
: ((String, String -> String -> Bool) -> String)
-> [(String, String -> String -> Bool)] -> AllowedParams
forall a b. (a -> b) -> [a] -> [b]
map (String, String -> String -> Bool) -> String
forall a b. (a, b) -> a
fst [(String, String -> String -> Bool)]
fctTableString

-- ----------------------------------------

patternValid    :: ParamList -> CheckString
patternValid :: ParamList -> CheckString
patternValid ParamList
params
    = (CheckString -> CheckString -> CheckString)
-> CheckString -> [CheckString] -> CheckString
forall a b. (a -> b -> b) -> b -> [a] -> b
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
. ((String, String) -> CheckString) -> ParamList -> [CheckString]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> CheckString
paramPatternValid (ParamList -> CheckString) -> ParamList -> CheckString
forall a b. (a -> b) -> a -> b
$ ParamList
params
      where
      paramPatternValid :: (String, String) -> CheckString
paramPatternValid (String
pn, String
pv)
          | String
pn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xsd_pattern   = (String -> Bool) -> (String -> String) -> CheckString
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert (String -> String -> Bool
patParamValid String
pv) (String -> String -> String -> String
errorMsgParam String
pn String
pv)
          | Bool
otherwise           = CheckString
forall a. CheckA a a
ok

patParamValid :: String -> String -> Bool
patParamValid :: String -> String -> Bool
patParamValid String
regex String
a
    | GenRegex String -> Bool
forall s. GenRegex s -> Bool
isZero GenRegex String
ex = Bool
False
    | Bool
otherwise = GenRegex String -> String -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex String
ex String
a
    where
    ex :: GenRegex String
ex = String -> GenRegex String
forall s. StringLike s => s -> GenRegex s
parseRegex String
regex

-- ----------------------------------------

-- | List of allowed params for the decimal datatypes

decimalParams   :: AllowedParams
decimalParams :: AllowedParams
decimalParams   = String
xsd_pattern String -> AllowedParams -> AllowedParams
forall a. a -> [a] -> [a]
: ((String, String -> Rational -> Bool) -> String)
-> [(String, String -> Rational -> Bool)] -> AllowedParams
forall a b. (a -> b) -> [a] -> [b]
map (String, String -> Rational -> Bool) -> String
forall a b. (a, b) -> a
fst [(String, String -> Rational -> Bool)]
fctTableDecimal

fctTableDecimal :: [(String, String -> Rational -> Bool)]
fctTableDecimal :: [(String, String -> Rational -> Bool)]
fctTableDecimal
    = [ (String
xsd_maxExclusive,   (Rational -> Rational -> Bool) -> String -> Rational -> Bool
cvd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
(>))
      , (String
xsd_minExclusive,   (Rational -> Rational -> Bool) -> String -> Rational -> Bool
cvd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
(<))
      , (String
xsd_maxInclusive,   (Rational -> Rational -> Bool) -> String -> Rational -> Bool
cvd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
(>=))
      , (String
xsd_minInclusive,   (Rational -> Rational -> Bool) -> String -> Rational -> Bool
cvd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
(<=))
      , (String
xsd_totalDigits,    (Int -> Rational -> Bool) -> String -> Rational -> Bool
cvi (\ Int
l Rational
v ->    Rational -> Int
totalDigits Rational
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l))
      , (String
xsd_fractionDigits, (Int -> Rational -> Bool) -> String -> 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) -> String -> Rational -> Bool
cvd Rational -> Rational -> Bool
op      = \ String
x Rational
y -> String -> Bool
isDecimal String
x Bool -> Bool -> Bool
&& String -> Rational
readDecimal String
x Rational -> Rational -> Bool
`op` Rational
y

    cvi         :: (Int -> Rational -> Bool) -> (String -> Rational -> Bool)
    cvi :: (Int -> Rational -> Bool) -> String -> Rational -> Bool
cvi Int -> Rational -> Bool
op      = \ String
x Rational
y -> String -> Bool
isNumber String
x Bool -> Bool -> Bool
&& String -> Int
forall a. Read a => String -> a
read String
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 a b. (a -> b -> b) -> b -> [a] -> b
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
. ((String, String) -> CheckA Rational Rational)
-> ParamList -> [CheckA Rational Rational]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> CheckA Rational Rational
paramDecimalValid (ParamList -> CheckA Rational Rational)
-> ParamList -> CheckA Rational Rational
forall a b. (a -> b) -> a -> b
$ ParamList
params
    where
    paramDecimalValid :: (String, String) -> CheckA Rational Rational
paramDecimalValid (String
pn, String
pv)
        = (Rational -> Bool)
-> (Rational -> String) -> CheckA Rational Rational
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert
          (((String -> Rational -> Bool)
-> Maybe (String -> Rational -> Bool) -> String -> Rational -> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Rational -> Bool) -> String -> Rational -> Bool
forall a b. a -> b -> a
const ((Rational -> Bool) -> String -> Rational -> Bool)
-> (Bool -> Rational -> Bool) -> Bool -> String -> Rational -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Rational -> Bool
forall a b. a -> b -> a
const (Bool -> String -> Rational -> Bool)
-> Bool -> String -> Rational -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
True) (Maybe (String -> Rational -> Bool) -> String -> Rational -> Bool)
-> ([(String, String -> Rational -> Bool)]
    -> Maybe (String -> Rational -> Bool))
-> [(String, String -> Rational -> Bool)]
-> String
-> Rational
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [(String, String -> Rational -> Bool)]
-> Maybe (String -> Rational -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pn ([(String, String -> Rational -> Bool)]
 -> String -> Rational -> Bool)
-> [(String, String -> Rational -> Bool)]
-> String
-> Rational
-> Bool
forall a b. (a -> b) -> a -> b
$ [(String, String -> Rational -> Bool)]
fctTableDecimal) String
pv)
          (String -> String -> String -> String
errorMsgParam String
pn String
pv (String -> String) -> (Rational -> String) -> Rational -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> String
showDecimal)

-- ----------------------------------------

-- | List of allowed params for the decimal and integer datatypes

integerParams   :: AllowedParams
integerParams :: AllowedParams
integerParams   = String
xsd_pattern String -> AllowedParams -> AllowedParams
forall a. a -> [a] -> [a]
: ((String, String -> Integer -> Bool) -> String)
-> [(String, String -> Integer -> Bool)] -> AllowedParams
forall a b. (a -> b) -> [a] -> [b]
map (String, String -> Integer -> Bool) -> String
forall a b. (a, b) -> a
fst [(String, String -> Integer -> Bool)]
fctTableInteger

fctTableInteger :: [(String, String -> Integer -> Bool)]
fctTableInteger :: [(String, String -> Integer -> Bool)]
fctTableInteger
    = [ (String
xsd_maxExclusive,   (Integer -> Integer -> Bool) -> String -> Integer -> Bool
cvi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>))
      , (String
xsd_minExclusive,   (Integer -> Integer -> Bool) -> String -> Integer -> Bool
cvi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<))
      , (String
xsd_maxInclusive,   (Integer -> Integer -> Bool) -> String -> Integer -> Bool
cvi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>=))
      , (String
xsd_minInclusive,   (Integer -> Integer -> Bool) -> String -> Integer -> Bool
cvi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=))
      , (String
xsd_totalDigits,    (Integer -> Integer -> Bool) -> String -> Integer -> Bool
cvi (\ Integer
l Integer
v -> Integer -> Integer
forall {t}. (Ord t, Num t, Show t) => t -> 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) -> String -> Integer -> Bool
cvi Integer -> Integer -> Bool
op      = \ String
x Integer
y -> String -> Bool
isNumber String
x Bool -> Bool -> Bool
&& String -> Integer
forall a. Read a => String -> a
read String
x Integer -> Integer -> Bool
`op` Integer
y

    totalD :: t -> Integer
totalD t
i
        | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0     = t -> Integer
totalD (t
0t -> t -> t
forall a. Num a => a -> a -> a
-t
i)
        | Bool
otherwise = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (t -> Int) -> t -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (t -> String) -> t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall a. Show a => a -> String
show (t -> Integer) -> t -> Integer
forall a b. (a -> b) -> a -> b
$ t
i

integerValid    :: DatatypeName -> ParamList -> CheckA Integer Integer
integerValid :: String -> ParamList -> CheckA Integer Integer
integerValid String
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 a b. (a -> b -> b) -> b -> [a] -> b
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
. ((String, String) -> CheckA Integer Integer)
-> ParamList -> [CheckA Integer Integer]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> 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 -> String) -> CheckA Integer Integer
forall a. (a -> Bool) -> (a -> String) -> 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)
-> ([(String, Integer -> Bool)] -> Maybe (Integer -> Bool))
-> [(String, Integer -> Bool)]
-> Integer
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, Integer -> Bool)] -> Maybe (Integer -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
datatype ([(String, Integer -> Bool)] -> Integer -> Bool)
-> [(String, Integer -> Bool)] -> Integer -> Bool
forall a b. (a -> b) -> a -> b
$ [(String, Integer -> Bool)]
integerRangeTable)
          (\ Integer
v -> ( String
"Datatype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
datatype String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
" with value = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
v String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
" not in integer value range"
                  )
          )
    paramIntegerValid :: (String, String) -> CheckA Integer Integer
paramIntegerValid (String
pn, String
pv)
        = (Integer -> Bool) -> (Integer -> String) -> CheckA Integer Integer
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert
          (((String -> Integer -> Bool)
-> Maybe (String -> Integer -> Bool) -> String -> Integer -> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Integer -> Bool) -> String -> Integer -> Bool
forall a b. a -> b -> a
const ((Integer -> Bool) -> String -> Integer -> Bool)
-> (Bool -> Integer -> Bool) -> Bool -> String -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Integer -> Bool
forall a b. a -> b -> a
const (Bool -> String -> Integer -> Bool)
-> Bool -> String -> Integer -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
True) (Maybe (String -> Integer -> Bool) -> String -> Integer -> Bool)
-> ([(String, String -> Integer -> Bool)]
    -> Maybe (String -> Integer -> Bool))
-> [(String, String -> Integer -> Bool)]
-> String
-> Integer
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [(String, String -> Integer -> Bool)]
-> Maybe (String -> Integer -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pn ([(String, String -> Integer -> Bool)]
 -> String -> Integer -> Bool)
-> [(String, String -> Integer -> Bool)]
-> String
-> Integer
-> Bool
forall a b. (a -> b) -> a -> b
$ [(String, String -> Integer -> Bool)]
fctTableInteger) String
pv)
          (String -> String -> String -> String
errorMsgParam String
pn String
pv (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show)

integerRangeTable       :: [(String, Integer -> Bool)]
integerRangeTable :: [(String, Integer -> Bool)]
integerRangeTable       = [ (String
xsd_integer,               Bool -> Integer -> Bool
forall a b. a -> b -> a
const Bool
True)
                          , (String
xsd_nonPositiveInteger,    (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=Integer
0)   )
                          , (String
xsd_negativeInteger,       ( Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
0)   )
                          , (String
xsd_nonNegativeInteger,    (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>=Integer
0)   )
                          , (String
xsd_positiveInteger,       ( Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
0)   )
                          , (String
xsd_long,                  Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inR Integer
9223372036854775808)
                          , (String
xsd_int,                   Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inR Integer
2147483648)
                          , (String
xsd_short,                 Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inR Integer
32768)
                          , (String
xsd_byte,                  Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inR Integer
128)
                          , (String
xsd_unsignedLong,          Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inP Integer
18446744073709551616)
                          , (String
xsd_unsignedInt,           Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inP Integer
4294967296)
                          , (String
xsd_unsignedShort,         Integer -> Integer -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
inP Integer
65536)
                          , (String
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

-- ----------------------------------------

-- | List of allowed params for the list datatypes

listParams      :: AllowedParams
listParams :: AllowedParams
listParams      = String
xsd_pattern String -> AllowedParams -> AllowedParams
forall a. a -> [a] -> [a]
: ((String, String -> String -> Bool) -> String)
-> [(String, String -> String -> Bool)] -> AllowedParams
forall a b. (a -> b) -> [a] -> [b]
map (String, String -> String -> Bool) -> String
forall a b. (a, b) -> a
fst [(String, String -> String -> Bool)]
fctTableList

listValid       :: DatatypeName -> ParamList -> CheckString
listValid :: String -> ParamList -> CheckString
listValid String
d     = [(String, String -> String -> Bool)]
-> String -> Integer -> Integer -> ParamList -> CheckString
stringValidFT [(String, String -> String -> Bool)]
fctTableList String
d Integer
0 (-Integer
1)

-- ----------------------------------------

isNameList      :: (String -> Bool) -> String -> Bool
isNameList :: (String -> Bool) -> String -> Bool
isNameList String -> Bool
p String
w
    = Bool -> Bool
not (AllowedParams -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null AllowedParams
ts) Bool -> Bool -> Bool
&& (String -> Bool) -> AllowedParams -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
p AllowedParams
ts
      where
      ts :: AllowedParams
ts = String -> AllowedParams
words String
w

-- ----------------------------------------

rex             :: String -> Regex
rex :: String -> GenRegex String
rex String
regex
    | GenRegex String -> Bool
forall s. GenRegex s -> Bool
isZero GenRegex String
ex = String -> GenRegex String
forall a. HasCallStack => String -> a
error (String -> GenRegex String) -> String -> GenRegex String
forall a b. (a -> b) -> a -> b
$ String
"syntax error in regexp " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
regex
    | Bool
otherwise = GenRegex String
ex
    where
    ex :: GenRegex String
ex = String -> GenRegex String
forall s. StringLike s => s -> GenRegex s
parseRegex String
regex

-- ----------------------------------------

rexLanguage
  , rexHexBinary
  , rexBase64Binary
  , rexDecimal
  , rexInteger  :: Regex

rexLanguage :: GenRegex String
rexLanguage     = String -> GenRegex String
rex String
"[A-Za-z]{1,8}(-[A-Za-z]{1,8})*"
rexHexBinary :: GenRegex String
rexHexBinary    = String -> GenRegex String
rex String
"([A-Fa-f0-9]{2})*"
rexBase64Binary :: GenRegex String
rexBase64Binary = String -> GenRegex String
rex (String -> GenRegex String) -> String -> GenRegex String
forall a b. (a -> b) -> a -> b
$
                  String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b64 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{4})*((" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b64 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{2}==)|(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b64 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{3}=)|)"
                  where
                  b64 :: String
b64     = String
"[A-Za-z0-9+/]"
rexDecimal :: GenRegex String
rexDecimal      = String -> GenRegex String
rex String
"(\\+|-)?(([0-9]+(\\.[0-9]*)?)|(\\.[0-9]+))"
rexInteger :: GenRegex String
rexInteger      = String -> GenRegex String
rex String
"(\\+|-)?[0-9]+"

isLanguage
  , isHexBinary
  , isBase64Binary
  , isDecimal
  , isInteger   :: String -> Bool

isLanguage :: String -> Bool
isLanguage      = GenRegex String -> String -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex String
rexLanguage
isHexBinary :: String -> Bool
isHexBinary     = GenRegex String -> String -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex String
rexHexBinary
isBase64Binary :: String -> Bool
isBase64Binary  = GenRegex String -> String -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex String
rexBase64Binary
isDecimal :: String -> Bool
isDecimal       = GenRegex String -> String -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex String
rexDecimal
isInteger :: String -> Bool
isInteger       = GenRegex String -> String -> Bool
forall s. StringLike s => GenRegex s -> s -> Bool
matchRE GenRegex String
rexInteger

-- ----------------------------------------

normBase64      :: String -> String
normBase64 :: String -> String
normBase64      = (Char -> Bool) -> String -> String
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 :: String -> Rational
readDecimal (Char
'+':String
s)     = String -> Rational
readDecimal' String
s
readDecimal (Char
'-':String
s)     = Rational -> Rational
forall a. Num a => a -> a
negate (String -> Rational
readDecimal' String
s)
readDecimal      String
s      = String -> Rational
readDecimal' String
s

readDecimal' :: String -> Rational
readDecimal' String
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 (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fs))))
    where
    (String
ns, String
fs') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') String
s
    fs :: String
fs = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
fs'

    f :: Integer
    f :: Integer
f | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fs         = Integer
0
      | Bool
otherwise       = String -> Integer
forall a. Read a => String -> a
read String
fs
    n :: Integer
    n :: Integer
n | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ns         = Integer
0
      | Bool
otherwise       = String -> Integer
forall a. Read a => String -> a
read String
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        = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (Rational -> String) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (Rational -> Integer) -> Rational -> String
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 -> String
showDecimal Rational
d
    | Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0     = (Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Rational -> String) -> Rational -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> String
showDecimal' (Rational -> String)
-> (Rational -> Rational) -> Rational -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. Num a => a -> a
negate    (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ Rational
d
    | Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
1     = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (Rational -> String) -> Rational -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> String
showDecimal' (Rational -> String)
-> (Rational -> Rational) -> Rational -> String
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 -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ Rational
d
    | Bool
otherwise =          Rational -> String
showDecimal'             (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ Rational
d

showDecimal' :: Rational -> String
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 -> String
forall a. Show a => a -> String
show (Integer -> String) -> (Rational -> Integer) -> Rational -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Integer
forall a. Ratio a -> a
numerator (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ Rational
d
    | Bool
otherwise                 = Int -> Rational -> String
forall {a}. (Integral a, Show a) => Int -> Ratio a -> String
times10 Int
0        (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ Rational
d
    where
    times10 :: Int -> Ratio a -> String
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
                                  (String
x, String
y) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i' (String -> (String, String))
-> (Ratio a -> String) -> Ratio a -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (Ratio a -> String) -> Ratio a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> String) -> (Ratio a -> a) -> Ratio a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio a -> a
forall a. Ratio a -> a
numerator (Ratio a -> (String, String)) -> Ratio a -> (String, String)
forall a b. (a -> b) -> a -> b
$ Ratio a
d'
                                  in
                                  String -> String
forall a. [a] -> [a]
reverse String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
reverse String
x
        | Bool
otherwise             = Int -> Ratio a -> String
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))

-- ----------------------------------------

-- | Tests whether a XML instance value matches a data-pattern.
-- (see also: 'stringValid')

datatypeAllowsW3C :: DatatypeAllows
datatypeAllowsW3C :: DatatypeAllows
datatypeAllowsW3C String
d ParamList
params String
value Context
_
    = CheckString -> String -> Maybe String
forall a b. CheckA a b -> a -> Maybe String
performCheck CheckString
check String
value
    where
    validString :: (String -> String) -> CheckString
validString String -> String
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
>>>
          (String -> String) -> CheckString
forall b c. (b -> c) -> CheckA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr String -> String
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
        = (String -> String) -> CheckString
validString String -> String
normalizeWhitespace

    validPattern :: CheckString
validPattern
        = ParamList -> CheckString
patternValid ParamList
params

    validLength :: CheckString
validLength
        = String -> Integer -> Integer -> ParamList -> CheckString
stringValid String
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
>>>
          (String -> String) -> CheckString
forall b c. (b -> c) -> CheckA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr String -> String
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
        = String -> ParamList -> CheckString
listValid String
d ParamList
params

    validName :: (String -> Bool) -> CheckString
validName String -> Bool
isN
        = (String -> Bool) -> CheckString
assertW3C String -> 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
>>> (String -> Bool) -> CheckString
validName String -> 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
>>> (String -> Bool) -> CheckString
validName String -> Bool
isWellformedQualifiedName

    validDecimal :: CheckString
validDecimal
        = (String -> String) -> CheckString
forall b c. (b -> c) -> CheckA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr String -> String
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
>>>
          (String -> Bool) -> CheckString
assertW3C String -> 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
>>>
          (String -> Rational) -> CheckA Rational Rational -> CheckString
forall a b c. (a -> b) -> CheckA b c -> CheckA a a
checkWith String -> Rational
readDecimal (ParamList -> CheckA Rational Rational
decimalValid ParamList
params)

    validInteger :: String -> CheckString
validInteger String
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
>>>
          (String -> String) -> CheckString
forall b c. (b -> c) -> CheckA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr String -> String
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
>>>
          (String -> Bool) -> CheckString
assertW3C String -> 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
>>>
          (String -> Integer) -> CheckA Integer Integer -> CheckString
forall a b c. (a -> b) -> CheckA b c -> CheckA a a
checkWith String -> Integer
forall a. Read a => String -> a
read (String -> ParamList -> CheckA Integer Integer
integerValid String
inRange ParamList
params)

    check       :: CheckString
    check :: CheckString
check       = CheckString -> Maybe CheckString -> CheckString
forall a. a -> Maybe a -> a
fromMaybe CheckString
forall {b}. CheckA String b
notFound (Maybe CheckString -> CheckString)
-> ([(String, CheckString)] -> Maybe CheckString)
-> [(String, CheckString)]
-> CheckString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, CheckString)] -> Maybe CheckString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
d ([(String, CheckString)] -> CheckString)
-> [(String, CheckString)] -> CheckString
forall a b. (a -> b) -> a -> b
$ [(String, CheckString)]
checks

    notFound :: CheckA String b
notFound    = (String -> String) -> CheckA String b
forall a b. (a -> String) -> CheckA a b
failure ((String -> String) -> CheckA String b)
-> (String -> String) -> CheckA String b
forall a b. (a -> b) -> a -> b
$ String -> String -> ParamList -> String -> String
errorMsgDataTypeNotAllowed String
w3cNS String
d ParamList
params

    checks      :: [(String, CheckA String String)]
    checks :: [(String, CheckString)]
checks      = [ (String
xsd_string,                (String -> String) -> CheckString
validString String -> String
forall a. a -> a
id)
                  , (String
xsd_normalizedString,      (String -> String) -> CheckString
validString String -> String
normalizeBlanks)
                  , (String
xsd_token,                 CheckString
validNormString)
                  , (String
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
>>> (String -> Bool) -> CheckString
assertW3C String -> Bool
isLanguage)
                  , (String
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
>>> (String -> Bool) -> CheckString
validName String -> Bool
isNmtoken)
                  , (String
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
>>> (String -> Bool) -> CheckString
validName ((String -> Bool) -> String -> Bool
isNameList String -> Bool
isNmtoken))
                  , (String
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
>>> (String -> Bool) -> CheckString
validName String -> Bool
isName)
                  , (String
xsd_NCName,                CheckString
validNCName)
                  , (String
xsd_ID,                    CheckString
validNCName)
                  , (String
xsd_IDREF,                 CheckString
validNCName)
                  , (String
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
>>> (String -> Bool) -> CheckString
validName ((String -> Bool) -> String -> Bool
isNameList String -> Bool
isNCName))
                  , (String
xsd_ENTITY,                CheckString
validNCName)
                  , (String
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
>>> (String -> Bool) -> CheckString
validName ((String -> Bool) -> String -> Bool
isNameList String -> Bool
isNCName))
                  , (String
xsd_anyURI,                (String -> Bool) -> CheckString
validName String -> 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
>>> (String -> String) -> CheckString
validString String -> String
escapeURI)
                  , (String
xsd_QName,                 CheckString
validQName)
                  , (String
xsd_NOTATION,              CheckString
validQName)
                  , (String
xsd_hexBinary,             (String -> String) -> CheckString
validString String -> String
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
>>> (String -> Bool) -> CheckString
assertW3C String -> Bool
isHexBinary)
                  , (String
xsd_base64Binary,          (String -> String) -> CheckString
validString String -> String
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
>>> (String -> Bool) -> CheckString
assertW3C String -> Bool
isBase64Binary)
                  , (String
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)
                  , (String
xsd_integer,               String -> CheckString
validInteger String
xsd_integer)
                  , (String
xsd_nonPositiveInteger,    String -> CheckString
validInteger String
xsd_nonPositiveInteger)
                  , (String
xsd_negativeInteger,       String -> CheckString
validInteger String
xsd_negativeInteger)
                  , (String
xsd_nonNegativeInteger,    String -> CheckString
validInteger String
xsd_nonNegativeInteger)
                  , (String
xsd_positiveInteger,       String -> CheckString
validInteger String
xsd_positiveInteger)
                  , (String
xsd_long,                  String -> CheckString
validInteger String
xsd_long)
                  , (String
xsd_int,                   String -> CheckString
validInteger String
xsd_int)
                  , (String
xsd_short,                 String -> CheckString
validInteger String
xsd_short)
                  , (String
xsd_byte,                  String -> CheckString
validInteger String
xsd_byte)
                  , (String
xsd_unsignedLong,          String -> CheckString
validInteger String
xsd_unsignedLong)
                  , (String
xsd_unsignedInt,           String -> CheckString
validInteger String
xsd_unsignedInt)
                  , (String
xsd_unsignedShort,         String -> CheckString
validInteger String
xsd_unsignedShort)
                  , (String
xsd_unsignedByte,          String -> CheckString
validInteger String
xsd_unsignedByte)
                  ]
    assertW3C :: (String -> Bool) -> CheckString
assertW3C String -> Bool
p = (String -> Bool) -> (String -> String) -> CheckString
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert String -> Bool
p String -> String
errW3C
    errW3C :: String -> String
errW3C      = String -> String -> String -> String
errorMsgDataLibQName String
w3cNS String
d

-- ----------------------------------------

-- | Tests whether a XML instance value matches a value-pattern.

datatypeEqualW3C :: DatatypeEqual
datatypeEqualW3C :: DatatypeEqual
datatypeEqualW3C String
d String
s1 Context
_ String
s2 Context
_
    = CheckA (String, String) (String, String)
-> (String, String) -> Maybe String
forall a b. CheckA a b -> a -> Maybe String
performCheck CheckA (String, String) (String, String)
check (String
s1, String
s2)
    where
    check       :: CheckA (String, String) (String, String)
    check :: CheckA (String, String) (String, String)
check       = CheckA (String, String) (String, String)
-> ((String -> String) -> CheckA (String, String) (String, String))
-> Maybe (String -> String)
-> CheckA (String, String) (String, String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CheckA (String, String) (String, String)
forall {a} {b}. CheckA a b
notFound (String -> String) -> CheckA (String, String) (String, String)
forall {t}. (t -> String) -> CheckA (t, t) (String, String)
found (Maybe (String -> String)
 -> CheckA (String, String) (String, String))
-> ([(String, String -> String)] -> Maybe (String -> String))
-> [(String, String -> String)]
-> CheckA (String, String) (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String -> String)] -> Maybe (String -> String)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
d ([(String, String -> String)]
 -> CheckA (String, String) (String, String))
-> [(String, String -> String)]
-> CheckA (String, String) (String, String)
forall a b. (a -> b) -> a -> b
$ [(String, String -> String)]
norm

    notFound :: CheckA a b
notFound    = (a -> String) -> CheckA a b
forall a b. (a -> String) -> CheckA a b
failure ((a -> String) -> CheckA a b) -> (a -> String) -> CheckA a b
forall a b. (a -> b) -> a -> b
$ String -> a -> String
forall a b. a -> b -> a
const (String -> String -> String
errorMsgDataTypeNotAllowed0 String
w3cNS String
d)

    found :: (t -> String) -> CheckA (t, t) (String, String)
found t -> String
nf    = ((t, t) -> (String, String)) -> CheckA (t, t) (String, String)
forall b c. (b -> c) -> CheckA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ (t
x1, t
x2) -> (t -> String
nf t
x1, t -> String
nf t
x2))                    -- normalize both values
                  CheckA (t, t) (String, String)
-> CheckA (String, String) (String, String)
-> CheckA (t, t) (String, String)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                  ((String, String) -> Bool)
-> ((String, String) -> String)
-> CheckA (String, String) (String, String)
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert ((String -> String -> Bool) -> (String, String) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ((String -> String -> String) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> String -> String) -> (String, String) -> String)
-> (String -> String -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
errorMsgEqual String
d)     -- and check on (==)

    norm :: [(String, String -> String)]
norm = [ (String
xsd_string,               String -> String
forall a. a -> a
id                      )
           , (String
xsd_normalizedString,     String -> String
normalizeBlanks         )
           , (String
xsd_token,                String -> String
normalizeWhitespace     )
           , (String
xsd_language,             String -> String
normalizeWhitespace     )
           , (String
xsd_NMTOKEN,              String -> String
normalizeWhitespace     )
           , (String
xsd_NMTOKENS,             String -> String
normalizeWhitespace     )
           , (String
xsd_Name,                 String -> String
normalizeWhitespace     )
           , (String
xsd_NCName,               String -> String
normalizeWhitespace     )
           , (String
xsd_ID,                   String -> String
normalizeWhitespace     )
           , (String
xsd_IDREF,                String -> String
normalizeWhitespace     )
           , (String
xsd_IDREFS,               String -> String
normalizeWhitespace     )
           , (String
xsd_ENTITY,               String -> String
normalizeWhitespace     )
           , (String
xsd_ENTITIES,             String -> String
normalizeWhitespace     )
           , (String
xsd_anyURI,               String -> String
escapeURI (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
normalizeWhitespace )
           , (String
xsd_QName,                String -> String
normalizeWhitespace     )
           , (String
xsd_NOTATION,             String -> String
normalizeWhitespace     )
           , (String
xsd_hexBinary,            String -> String
forall a. a -> a
id                      )
           , (String
xsd_base64Binary,         String -> String
normBase64              )
           , (String
xsd_decimal,              Rational -> String
forall a. Show a => a -> String
show (Rational -> String) -> (String -> Rational) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Rational
readDecimal (String -> Rational) -> (String -> String) -> String -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
normalizeWhitespace        )
           ]

-- ----------------------------------------