-- |
-- exports helper functions for the integration of new datatype-libraries

module Text.XML.HXT.RelaxNG.DataTypeLibUtils
  ( errorMsgEqual
  , errorMsgDataTypeNotAllowed
  , errorMsgDataTypeNotAllowed0
  , errorMsgDataTypeNotAllowed2
  , errorMsgDataLibQName
  , errorMsgParam

  , rng_length
  , rng_maxLength
  , rng_minLength
   ,rng_maxExclusive
  , rng_minExclusive
  , rng_maxInclusive
  , rng_minInclusive

  , module Control.Arrow
  , module Text.XML.HXT.DOM.Util
  , module Text.XML.HXT.RelaxNG.Utils
  , module Text.XML.HXT.RelaxNG.DataTypes

  , FunctionTable

  , stringValidFT       -- generalized checkString
  , fctTableString      -- minLength, maxLenght, length
  , fctTableList        -- minLength, maxLenght, length

  , stringValid         -- checkString
  , numberValid         -- checkNumeric

  , numParamValid

  , CheckA              -- Check datatype
  , CheckString         -- CheckA String String
  , CheckInteger        -- CheckA Integer Integer

  , performCheck        -- run a CheckA
  , ok                  -- always true
  , failure             -- create an error meesage
  , assert              -- create a primitive check from a predicate
  , assertMaybe         -- create a primitive check from a maybe
  , checkWith           -- convert value before checking
  )

where
import Prelude hiding (id, (.))

import Control.Category
import Control.Arrow

import Data.Maybe

import Text.XML.HXT.DOM.Util

import Text.XML.HXT.RelaxNG.DataTypes
import Text.XML.HXT.RelaxNG.Utils

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

newtype CheckA a b      = C { forall a b. CheckA a b -> a -> Either String b
runCheck :: a -> Either String b }

instance Category CheckA where
    id :: forall a. CheckA a a
id          = (a -> Either String a) -> CheckA a a
forall a b. (a -> Either String b) -> CheckA a b
C ((a -> Either String a) -> CheckA a a)
-> (a -> Either String a) -> CheckA a a
forall a b. (a -> b) -> a -> b
$ a -> Either String a
forall a b. b -> Either a b
Right

    CheckA b c
f2 . :: forall b c a. CheckA b c -> CheckA a b -> CheckA a c
. CheckA a b
f1     = (a -> Either String c) -> CheckA a c
forall a b. (a -> Either String b) -> CheckA a b
C ((a -> Either String c) -> CheckA a c)
-> (a -> Either String c) -> CheckA a c
forall a b. (a -> b) -> a -> b
$                           -- logical and: f1 and f2 must hold
                  \ a
x -> case CheckA a b -> a -> Either String b
forall a b. CheckA a b -> a -> Either String b
runCheck CheckA a b
f1 a
x of
                         Right b
y        -> CheckA b c -> b -> Either String c
forall a b. CheckA a b -> a -> Either String b
runCheck CheckA b c
f2 b
y
                         Left  String
e        -> String -> Either String c
forall a b. a -> Either a b
Left String
e

instance Arrow CheckA where
    arr :: forall b c. (b -> c) -> CheckA b c
arr b -> c
f       = (b -> Either String c) -> CheckA b c
forall a b. (a -> Either String b) -> CheckA a b
C ( c -> Either String c
forall a b. b -> Either a b
Right (c -> Either String c) -> (b -> c) -> b -> Either String c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> c
f )               -- unit: no check, always o.k., just a conversion

    first :: forall b c d. CheckA b c -> CheckA (b, d) (c, d)
first CheckA b c
f1    = ((b, d) -> Either String (c, d)) -> CheckA (b, d) (c, d)
forall a b. (a -> Either String b) -> CheckA a b
C (((b, d) -> Either String (c, d)) -> CheckA (b, d) (c, d))
-> ((b, d) -> Either String (c, d)) -> CheckA (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$                           -- check 1. component of a pair
                  \ ~(b
x1, d
x2) -> case CheckA b c -> b -> Either String c
forall a b. CheckA a b -> a -> Either String b
runCheck CheckA b c
f1 b
x1 of
                                 Right c
y1       -> (c, d) -> Either String (c, d)
forall a b. b -> Either a b
Right (c
y1, d
x2)
                                 Left  String
e        -> String -> Either String (c, d)
forall a b. a -> Either a b
Left  String
e

    second :: forall b c d. CheckA b c -> CheckA (d, b) (d, c)
second CheckA b c
f2   = ((d, b) -> Either String (d, c)) -> CheckA (d, b) (d, c)
forall a b. (a -> Either String b) -> CheckA a b
C (((d, b) -> Either String (d, c)) -> CheckA (d, b) (d, c))
-> ((d, b) -> Either String (d, c)) -> CheckA (d, b) (d, c)
forall a b. (a -> b) -> a -> b
$                           -- check 2. component of a pair
                  \ ~(d
x1, b
x2) -> case CheckA b c -> b -> Either String c
forall a b. CheckA a b -> a -> Either String b
runCheck CheckA b c
f2 b
x2 of
                                 Right c
y2       -> (d, c) -> Either String (d, c)
forall a b. b -> Either a b
Right (d
x1, c
y2)
                                 Left  String
e        -> String -> Either String (d, c)
forall a b. a -> Either a b
Left  String
e



instance ArrowZero CheckA where
    zeroArrow :: forall b c. CheckA b c
zeroArrow   = (b -> Either String c) -> CheckA b c
forall a b. (a -> Either String b) -> CheckA a b
C ((b -> Either String c) -> CheckA b c)
-> (b -> Either String c) -> CheckA b c
forall a b. (a -> b) -> a -> b
$ Either String c -> b -> Either String c
forall a b. a -> b -> a
const (String -> Either String c
forall a b. a -> Either a b
Left String
"")           -- always false: zero

instance ArrowPlus CheckA where
    CheckA b c
f1 <+> :: forall b c. CheckA b c -> CheckA b c -> CheckA b c
<+> CheckA b c
f2   = (b -> Either String c) -> CheckA b c
forall a b. (a -> Either String b) -> CheckA a b
C ((b -> Either String c) -> CheckA b c)
-> (b -> Either String c) -> CheckA b c
forall a b. (a -> b) -> a -> b
$                           -- logical or
                  \ b
x -> case CheckA b c -> b -> Either String c
forall a b. CheckA a b -> a -> Either String b
runCheck CheckA b c
f1 b
x of
                         Right c
y1       -> c -> Either String c
forall a b. b -> Either a b
Right c
y1
                         Left  String
e1       -> case CheckA b c -> b -> Either String c
forall a b. CheckA a b -> a -> Either String b
runCheck CheckA b c
f2 b
x of
                                           Right c
y2     -> c -> Either String c
forall a b. b -> Either a b
Right c
y2
                                           Left  String
e2     -> String -> Either String c
forall a b. a -> Either a b
Left ( if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
e1
                                                                  then String
e2
                                                                  else
                                                                  if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
e2
                                                                  then String
e1
                                                                  else String
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" or " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e2
                                                                )

type CheckString        = CheckA String String
type CheckInteger       = CheckA Integer Integer

-- | run a check and deliver Just an error message or Nothing

performCheck    :: CheckA a b -> a -> Maybe String
performCheck :: forall a b. CheckA a b -> a -> Maybe String
performCheck CheckA a b
c  = (String -> Maybe String)
-> (b -> Maybe String) -> Either String b -> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Maybe String
forall a. a -> Maybe a
Just (Maybe String -> b -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) (Either String b -> Maybe String)
-> (a -> Either String b) -> a -> Maybe String
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CheckA a b -> a -> Either String b
forall a b. CheckA a b -> a -> Either String b
runCheck CheckA a b
c

-- | always failure

failure         :: (a -> String) -> CheckA a b
failure :: forall a b. (a -> String) -> CheckA a b
failure a -> String
msg     = (a -> Either String b) -> CheckA a b
forall a b. (a -> Either String b) -> CheckA a b
C (String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> (a -> String) -> a -> Either String b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
msg)

-- | every thing is fine

ok              :: CheckA a a
ok :: forall a. CheckA a a
ok              = (a -> a) -> CheckA a a
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | perform a simple check with a predicate p,
--   when the predicate holds, assert acts as identity,
--   else an error message is generated

assert  :: (a -> Bool) -> (a -> String) -> CheckA a a
assert :: forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert a -> Bool
p a -> String
msg    = (a -> Either String a) -> CheckA a a
forall a b. (a -> Either String b) -> CheckA a b
C ((a -> Either String a) -> CheckA a a)
-> (a -> Either String a) -> CheckA a a
forall a b. (a -> b) -> a -> b
$ \ a
x -> if a -> Bool
p a
x then a -> Either String a
forall a b. b -> Either a b
Right a
x else String -> Either String a
forall a b. a -> Either a b
Left (a -> String
msg a
x)

-- | perform a simple check with a Maybe function, Nothing indicates error

assertMaybe     :: (a -> Maybe b) -> (a -> String) -> CheckA a b
assertMaybe :: forall a b. (a -> Maybe b) -> (a -> String) -> CheckA a b
assertMaybe a -> Maybe b
f a -> String
msg
    = (a -> Either String b) -> CheckA a b
forall a b. (a -> Either String b) -> CheckA a b
C ((a -> Either String b) -> CheckA a b)
-> (a -> Either String b) -> CheckA a b
forall a b. (a -> b) -> a -> b
$ \ a
x -> case a -> Maybe b
f a
x of
                 Maybe b
Nothing        -> String -> Either String b
forall a b. a -> Either a b
Left (a -> String
msg a
x)
                 Just b
y         -> b -> Either String b
forall a b. b -> Either a b
Right b
y

-- | perform a check, but convert the value before checking

checkWith       :: (a -> b) -> CheckA b c -> CheckA a a
checkWith :: forall a b c. (a -> b) -> CheckA b c -> CheckA a a
checkWith a -> b
f CheckA b c
c   = (a -> Either String a) -> CheckA a a
forall a b. (a -> Either String b) -> CheckA a b
C ((a -> Either String a) -> CheckA a a)
-> (a -> Either String a) -> CheckA a a
forall a b. (a -> b) -> a -> b
$
                  \ a
x -> case CheckA b c -> b -> Either String c
forall a b. CheckA a b -> a -> Either String b
runCheck CheckA b c
c (a -> b
f a
x) of
                         Right c
_        -> a -> Either String a
forall a b. b -> Either a b
Right a
x
                         Left  String
e        -> String -> Either String a
forall a b. a -> Either a b
Left  String
e

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

-- RelaxNG attribute names

rng_length, rng_maxLength, rng_minLength
 ,rng_maxExclusive, rng_minExclusive, rng_maxInclusive, rng_minInclusive :: String

rng_length :: String
rng_length              = String
"length"
rng_maxLength :: String
rng_maxLength           = String
"maxLength"
rng_minLength :: String
rng_minLength           = String
"minLength"

rng_maxExclusive :: String
rng_maxExclusive        = String
"maxExclusive"
rng_minExclusive :: String
rng_minExclusive        = String
"minExclusive"
rng_maxInclusive :: String
rng_maxInclusive        = String
"maxInclusive"
rng_minInclusive :: String
rng_minInclusive        = String
"minInclusive"

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

-- | Function table type

type FunctionTable      = [(String, String -> String -> Bool)]

-- | Function table for numeric tests,
-- XML document value is first operand, schema value second

fctTableNum :: (Ord a, Num a) => [(String, a -> a -> Bool)]
fctTableNum :: forall a. (Ord a, Num a) => [(String, a -> a -> Bool)]
fctTableNum
    = [ (String
rng_maxExclusive, a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<))
      , (String
rng_minExclusive, a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>))
      , (String
rng_maxInclusive, a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=))
      , (String
rng_minInclusive, a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=))
      ]

-- | Function table for string tests,
-- XML document value is first operand, schema value second
fctTableString :: FunctionTable
fctTableString :: FunctionTable
fctTableString
    = [ (String
rng_length,    ((Integer -> Integer -> Bool) -> String -> String -> Bool
numParamValid Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==)))
      , (String
rng_maxLength, ((Integer -> Integer -> Bool) -> String -> String -> Bool
numParamValid Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=)))
      , (String
rng_minLength, ((Integer -> Integer -> Bool) -> String -> String -> Bool
numParamValid Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>=)))
      ]

-- | Function table for list tests,
-- XML document value is first operand, schema value second

fctTableList :: FunctionTable
fctTableList :: FunctionTable
fctTableList
    = [ (String
rng_length,    ((Integer -> Integer -> Bool) -> String -> String -> Bool
listParamValid Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==)))
      , (String
rng_maxLength, ((Integer -> Integer -> Bool) -> String -> String -> Bool
listParamValid Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=)))
      , (String
rng_minLength, ((Integer -> Integer -> Bool) -> String -> String -> Bool
listParamValid Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>=)))
      ]

{- |
tests whether a string value matches a numeric param

valid example:

> <data type="CHAR"> <param name="maxLength">5</param> </data>

invalid example:

> <data type="CHAR"> <param name="minLength">foo</param> </data>

-}

numParamValid :: (Integer -> Integer -> Bool) -> String -> String -> Bool
numParamValid :: (Integer -> Integer -> Bool) -> String -> String -> Bool
numParamValid Integer -> Integer -> Bool
fct String
a String
b
  = String -> Bool
isNumber String
b
    Bool -> Bool -> Bool
&&
    ( Int -> Integer
forall a. Integral a => a -> Integer
toInteger (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a) Integer -> Integer -> Bool
`fct` (String -> Integer
forall a. Read a => String -> a
read String
b) )

{- |
tests whether a list value matches a length constraint

valid example:

> <data type="IDREFS"> <param name="maxLength">5</param> </data>

invalid example:

> <data type="IDREFS"> <param name="minLength">foo</param> </data>

-}

listParamValid :: (Integer -> Integer -> Bool) -> String -> String -> Bool
listParamValid :: (Integer -> Integer -> Bool) -> String -> String -> Bool
listParamValid Integer -> Integer -> Bool
fct String
a String
b
  = String -> Bool
isNumber String
b
    Bool -> Bool -> Bool
&&
    ( Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> [String]
words (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
a) Integer -> Integer -> Bool
`fct` (String -> Integer
forall a. Read a => String -> a
read String
b) )

-- ------------------------------------------------------------
-- new check functions

{- |
Tests whether a \"string\" datatype value is between the lower and
upper bound of the datatype and matches all parameters.

All tests are performed on the string value.

   * 1.parameter  :  datatype

   - 2.parameter  :  lower bound of the datatype range

   - 3.parameter  :  upper bound of the datatype range (-1 = no upper bound)

   - 4.parameter  :  list of parameters

   - 5.parameter  :  datatype value to be checked

   - return : Just \"Errormessage\" in case of an error, else Nothing

-}

stringValid     :: DatatypeName -> Integer -> Integer -> ParamList -> CheckString
stringValid :: String -> Integer -> Integer -> ParamList -> CheckString
stringValid     = FunctionTable
-> String -> Integer -> Integer -> ParamList -> CheckString
stringValidFT FunctionTable
fctTableString

stringValidFT :: FunctionTable -> DatatypeName -> Integer -> Integer -> ParamList -> CheckString
stringValidFT :: FunctionTable
-> String -> Integer -> Integer -> ParamList -> CheckString
stringValidFT FunctionTable
ft String
datatype Integer
lowerBound Integer
upperBound ParamList
params
    = (String -> Bool) -> (String -> String) -> CheckString
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert String -> Bool
forall {t :: * -> *} {a}. Foldable t => t a -> Bool
boundsOK String -> String
boundsErr
      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
>>>
      ParamList -> CheckString
paramsStringValid ParamList
params
    where
    boundsOK :: t a -> Bool
boundsOK t a
v
        = ( (Integer
lowerBound Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)
            Bool -> Bool -> Bool
||
            (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
v) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
lowerBound)
          )
          Bool -> Bool -> Bool
&&
          ( (Integer
upperBound Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (-Integer
1))
            Bool -> Bool -> Bool
||
            (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
v) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
upperBound)
          )

    boundsErr :: String -> String
boundsErr String
v
        = String
"Length of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" chars) out of range: "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
lowerBound String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" .. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
upperBound
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for datatype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
datatype

    paramStringValid :: (LocalName, String) -> CheckString
    paramStringValid :: (String, String) -> CheckString
paramStringValid (String
pn, String
pv)
        = (String -> Bool) -> (String -> String) -> CheckString
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert String -> Bool
paramOK (String -> String -> String -> String
errorMsgParam String
pn String
pv)
          where
          paramOK :: String -> Bool
paramOK String
v  = String -> String -> String -> Bool
paramFct String
pn String
v String
pv
          paramFct :: String -> String -> String -> Bool
paramFct String
n = (String -> String -> Bool)
-> Maybe (String -> String -> Bool) -> String -> String -> Bool
forall a. a -> Maybe a -> a
fromMaybe ((String -> Bool) -> String -> String -> Bool
forall a b. a -> b -> a
const ((String -> Bool) -> String -> String -> Bool)
-> (Bool -> String -> Bool) -> Bool -> String -> String -> Bool
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bool -> String -> Bool
forall a b. a -> b -> a
const (Bool -> String -> String -> Bool)
-> Bool -> String -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
True) (Maybe (String -> String -> Bool) -> String -> String -> Bool)
-> Maybe (String -> String -> Bool) -> String -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String -> FunctionTable -> Maybe (String -> String -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n FunctionTable
ft

    paramsStringValid :: ParamList -> CheckString
    paramsStringValid :: ParamList -> CheckString
paramsStringValid
        = (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 {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((String, String) -> CheckString) -> ParamList -> [CheckString]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> CheckString
paramStringValid

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

{- |
Tests whether a \"numeric\" datatype value is between the lower and upper
bound of the datatype and matches all parameters.

First, the string value is parsed into a numeric representation.
If no error occur, all following tests are performed on the numeric value.

   * 1.parameter  :  datatype

   - 2.parameter  :  lower bound of the datatype range

   - 3.parameter  :  upper bound of the datatype range (-1 = no upper bound)

   - 4.parameter  :  list of parameters

   - 5.parameter  :  datatype value to be checked

   - return : Just \"Errormessage\" in case of an error, else Nothing

-}

numberValid :: DatatypeName -> Integer -> Integer -> ParamList -> CheckString
numberValid :: String -> Integer -> Integer -> ParamList -> CheckString
numberValid String
datatype Integer
lowerBound Integer
upperBound ParamList
params
    = (String -> Bool) -> (String -> String) -> CheckString
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert String -> Bool
isNumber String -> String
numErr
      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 ( (Integer -> Bool) -> (Integer -> String) -> CheckA Integer Integer
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert Integer -> Bool
inRange Integer -> String
forall a. Show a => a -> String
rangeErr
                       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
>>>
                       ParamList -> CheckA Integer Integer
paramsNumValid ParamList
params
                     )
    where
    inRange     :: Integer -> Bool
    inRange :: Integer -> Bool
inRange Integer
x   = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
lowerBound
                  Bool -> Bool -> Bool
&&
                  Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
upperBound

    rangeErr :: a -> String
rangeErr a
v  = ( String
"Value = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of range: "
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
lowerBound String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" .. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
upperBound
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for datatype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
datatype
                  )
    numErr :: String -> String
numErr String
v
        = String
"Value = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a number"

paramsNumValid  :: ParamList -> CheckInteger
paramsNumValid :: ParamList -> CheckA Integer Integer
paramsNumValid
    = (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 {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((String, String) -> CheckA Integer Integer)
-> ParamList -> [CheckA Integer Integer]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> CheckA Integer Integer
paramNumValid

paramNumValid   :: (LocalName, String) -> CheckInteger
paramNumValid :: (String, String) -> CheckA Integer Integer
paramNumValid (String
pn, String
pv)
    = (Integer -> Bool) -> (Integer -> String) -> CheckA Integer Integer
forall a. (a -> Bool) -> (a -> String) -> CheckA a a
assert Integer -> Bool
forall {a}. (Ord a, Num a, Read a) => a -> Bool
paramOK (String -> String -> String -> String
errorMsgParam String
pn String
pv (String -> String) -> (Integer -> String) -> Integer -> String
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> String
forall a. Show a => a -> String
show)
    where
    paramOK :: a -> Bool
paramOK  a
v = String -> Bool
isNumber String
pv
                 Bool -> Bool -> Bool
&&
                 String -> a -> a -> Bool
forall {a}. (Ord a, Num a) => String -> a -> a -> Bool
paramFct String
pn a
v (String -> a
forall a. Read a => String -> a
read String
pv)
    paramFct :: String -> a -> a -> Bool
paramFct String
n = Maybe (a -> a -> Bool) -> a -> a -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (a -> a -> Bool) -> a -> a -> Bool)
-> Maybe (a -> a -> Bool) -> a -> a -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [(String, a -> a -> Bool)] -> Maybe (a -> a -> Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n [(String, a -> a -> Bool)]
forall a. (Ord a, Num a) => [(String, a -> a -> Bool)]
fctTableNum

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

{- |
Error Message for the equality test of two datatype values

   * 1.parameter  :  datatype

   - 2.parameter  :  datatype value

   - 3.parameter  :  datatype value

example:

> errorMsgEqual "Int" "21" "42" -> "Datatype Int with value = 21 expected, but value = 42 found"

-}

errorMsgParam   :: LocalName -> String -> String -> String
errorMsgParam :: String -> String -> String -> String
errorMsgParam String
pn String
pv String
v
    = ( String
"Parameter restriction: \""
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pv
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" does not hold for value = \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
      )

errorMsgEqual :: DatatypeName -> String -> String -> String
errorMsgEqual :: String -> String -> String -> String
errorMsgEqual String
d String
s1 String
s2
    = ( String
"Datatype" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" with value = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" expected, but value = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" found"
      )
errorMsgDataTypeNotAllowed :: String -> String -> [(String, String)] -> String -> String
errorMsgDataTypeNotAllowed :: String -> String -> ParamList -> String -> String
errorMsgDataTypeNotAllowed String
l String
t ParamList
p String
v
    = ( String
"Datatype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with parameter(s) " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        ParamList -> String
formatStringListPairs ParamList
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and value = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" not allowed for DatatypeLibrary " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
l
      )

errorMsgDataTypeNotAllowed0 :: String -> String -> String
errorMsgDataTypeNotAllowed0 :: String -> String -> String
errorMsgDataTypeNotAllowed0 String
l String
t
    = ( String
"Datatype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" not allowed for DatatypeLibrary " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
l
      )
errorMsgDataTypeNotAllowed2 :: String -> String -> String -> String -> String
errorMsgDataTypeNotAllowed2 :: String -> String -> String -> String -> String
errorMsgDataTypeNotAllowed2 String
l String
t String
v1 String
v2
    = ( String
"Datatype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" with values = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
v1 String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
v2 String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" not allowed for DatatypeLibrary " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
l
      )

errorMsgDataLibQName :: String -> String -> String -> String
errorMsgDataLibQName :: String -> String -> String -> String
errorMsgDataLibQName String
l String
n String
v
    = String -> String
forall a. Show a => a -> String
show String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for DatatypeLibrary " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l

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