    -- |
    -- 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 b c a. (b -> c) -> (a -> b) -> a -> 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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    e1
                                                                      then String
    e2
                                                                      else
                                                                      if String -> Bool
    forall a. [a] -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
    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 b c a. (b -> c) -> (a -> b) -> a -> c
    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 b c. (b -> c) -> CheckA b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr a -> a
    forall a. 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 a. [a] -> 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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([String] -> Int) -> (String -> [String]) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    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 a. 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 a. 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 a. [a] -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
    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 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
    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 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
    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 b c a. (b -> c) -> (a -> b) -> a -> c
    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

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