    -- |
    -- Datatype library for the MySQL datatypes
    --

    module Text.XML.HXT.RelaxNG.DataTypeLibMysql
      ( mysqlNS
      , mysqlDatatypeLib
      )
    where

    import Text.XML.HXT.RelaxNG.DataTypeLibUtils

    import Data.Maybe

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

    -- | Namespace of the MySQL datatype library

    mysqlNS :: String
    mysqlNS :: String
    mysqlNS = String
    "http://www.mysql.com"

    -- | The main entry point to the MySQL 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.

    mysqlDatatypeLib :: DatatypeLibrary
    mysqlDatatypeLib :: DatatypeLibrary
    mysqlDatatypeLib = (String
    mysqlNS, DatatypeAllows
    -> DatatypeEqual -> AllowedDatatypes -> DatatypeCheck
    DTC DatatypeAllows
    datatypeAllowsMysql DatatypeEqual
    datatypeEqualMysql AllowedDatatypes
    mysqlDatatypes)

    -- | All supported datatypes of the library
    mysqlDatatypes :: AllowedDatatypes
    mysqlDatatypes :: AllowedDatatypes
    mysqlDatatypes = [ -- numeric types
                       (String
    "SIGNED-TINYINT", AllowedParams
    numericParams)
                     , (String
    "UNSIGNED-TINYINT", AllowedParams
    numericParams)
                     , (String
    "SIGNED-SMALLINT", AllowedParams
    numericParams)
                     , (String
    "UNSIGNED-SMALLINT", AllowedParams
    numericParams)
                     , (String
    "SIGNED-MEDIUMINT", AllowedParams
    numericParams)
                     , (String
    "UNSIGNED-MEDIUMINT", AllowedParams
    numericParams)
                     , (String
    "SIGNED-INT", AllowedParams
    numericParams)
                     , (String
    "UNSIGNED-INT", AllowedParams
    numericParams)
                     , (String
    "SIGNED-BIGINT", AllowedParams
    numericParams)
                     , (String
    "UNSIGNED-BIGINT", AllowedParams
    numericParams)

                     -- string types
                     , (String
    "CHAR", AllowedParams
    stringParams)
                     , (String
    "VARCHAR", AllowedParams
    stringParams)
                     , (String
    "BINARY", AllowedParams
    stringParams)
                     , (String
    "VARBINARY", AllowedParams
    stringParams)
                     , (String
    "TINYTEXT", AllowedParams
    stringParams)
                     , (String
    "TINYBLOB", AllowedParams
    stringParams)
                     , (String
    "TEXT", AllowedParams
    stringParams)
                     , (String
    "BLOB", AllowedParams
    stringParams)
                     , (String
    "MEDIUMTEXT", AllowedParams
    stringParams)
                     , (String
    "MEDIUMBLOB", AllowedParams
    stringParams)
                     , (String
    "LONGTEXT", AllowedParams
    stringParams)
                     , (String
    "LONGBLOB", AllowedParams
    stringParams)
                     ]

    -- | List of supported string datatypes
    stringTypes :: [String]
    stringTypes :: AllowedParams
    stringTypes = [ String
    "CHAR"
                  , String
    "VARCHAR"
                  , String
    "BINARY"
                  , String
    "VARBINARY"
                  , String
    "TINYTEXT"
                  , String
    "TINYBLOB"
                  , String
    "TEXT"
                  , String
    "BLOB"
                  , String
    "MEDIUMTEXT"
                  , String
    "MEDIUMBLOB"
                  , String
    "LONGTEXT"
                  , String
    "LONGBLOB"
                  ]

    -- | List of supported numeric datatypes
    numericTypes :: [String]
    numericTypes :: AllowedParams
    numericTypes = [ String
    "SIGNED-TINYINT"
                   , String
    "UNSIGNED-TINYINT"
                   , String
    "SIGNED-SMALLINT"
                   , String
    "UNSIGNED-SMALLINT"
                   , String
    "SIGNED-MEDIUMINT"
                   , String
    "UNSIGNED-MEDIUMINT"
                   , String
    "SIGNED-INT"
                   , String
    "UNSIGNED-INT"
                   , String
    "SIGNED-BIGINT"
                   , String
    "UNSIGNED-BIGINT"
                   ]

    -- | List of allowed params for the numeric datatypes
    numericParams :: AllowedParams
    numericParams :: AllowedParams
    numericParams = [ String
    rng_maxExclusive
                    , String
    rng_minExclusive
                    , String
    rng_maxInclusive
                    , String
    rng_minInclusive
                    ]

    -- | List of allowed params for the string datatypes
    stringParams :: AllowedParams
    stringParams :: AllowedParams
    stringParams = [ String
    rng_length
                   , String
    rng_maxLength
                   , String
    rng_minLength
                   ]

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

    datatypeAllowsMysql :: DatatypeAllows
    datatypeAllowsMysql :: DatatypeAllows
    datatypeAllowsMysql String
    d ParamList
    params String
    value Context
    _
        = CheckA String String -> String -> Maybe String
    forall a b. CheckA a b -> a -> Maybe String
    performCheck CheckA String String
    check String
    value
        where
        check :: CheckA String String
    check
            | Maybe (Integer, Integer) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (Integer, Integer)
    ndt    = (Integer, Integer) -> CheckA String String
    checkNum (Maybe (Integer, Integer) -> (Integer, Integer)
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe (Integer, Integer)
    ndt)
            | Maybe (Integer, Integer) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (Integer, Integer)
    sdt    = (Integer, Integer) -> CheckA String String
    checkStr (Maybe (Integer, Integer) -> (Integer, Integer)
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe (Integer, Integer)
    sdt)
            | Bool
    otherwise     = (String -> String) -> CheckA String String
    forall a b. (a -> String) -> CheckA a b
    failure ((String -> String) -> CheckA String String)
    -> (String -> String) -> CheckA String String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> ParamList -> String -> String
    errorMsgDataTypeNotAllowed String
    mysqlNS String
    d ParamList
    params
        checkNum :: (Integer, Integer) -> CheckA String String
    checkNum (Integer, Integer)
    r  = (Integer -> Integer -> ParamList -> CheckA String String)
    -> (Integer, Integer) -> ParamList -> CheckA String String
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (String -> Integer -> Integer -> ParamList -> CheckA String String
    numberValid String
    d) (Integer, Integer)
    r ParamList
    params
        checkStr :: (Integer, Integer) -> CheckA String String
    checkStr (Integer, Integer)
    r  = (Integer -> Integer -> ParamList -> CheckA String String)
    -> (Integer, Integer) -> ParamList -> CheckA String String
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (String -> Integer -> Integer -> ParamList -> CheckA String String
    stringValid String
    d) (Integer, Integer)
    r ParamList
    params
        ndt :: Maybe (Integer, Integer)
    ndt = String
    -> [(String, (Integer, Integer))] -> Maybe (Integer, Integer)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    d ([(String, (Integer, Integer))] -> Maybe (Integer, Integer))
    -> [(String, (Integer, Integer))] -> Maybe (Integer, Integer)
    forall a b. (a -> b) -> a -> b
    $
              [ (String
    "SIGNED-TINYINT", ((-Integer
    128), Integer
    127))
              , (String
    "UNSIGNED-TINYINT", (Integer
    0, Integer
    255))
              , (String
    "SIGNED-SMALLINT", ((-Integer
    32768), Integer
    32767))
              , (String
    "UNSIGNED-SMALLINT", (Integer
    0, Integer
    65535))
              , (String
    "SIGNED-MEDIUMINT", ((-Integer
    8388608), Integer
    8388607))
              , (String
    "UNSIGNED-MEDIUMINT", (Integer
    0, Integer
    16777215))
              , (String
    "SIGNED-INT", ((-Integer
    2147483648), Integer
    2147483647))
              , (String
    "UNSIGNED-INT", (Integer
    0, Integer
    4294967295))
              , (String
    "SIGNED-BIGINT", ((-Integer
    9223372036854775808), Integer
    9223372036854775807))
              , (String
    "UNSIGNED-BIGINT", (Integer
    0, Integer
    18446744073709551615))
              ]
        sdt :: Maybe (Integer, Integer)
    sdt = String
    -> [(String, (Integer, Integer))] -> Maybe (Integer, Integer)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    d ([(String, (Integer, Integer))] -> Maybe (Integer, Integer))
    -> [(String, (Integer, Integer))] -> Maybe (Integer, Integer)
    forall a b. (a -> b) -> a -> b
    $
              [ (String
    "CHAR", (Integer
    0, Integer
    255))
              , (String
    "VARCHAR", (Integer
    0, Integer
    65535))
              , (String
    "BINARY", (Integer
    0, Integer
    255))
              , (String
    "VARBINARY", (Integer
    0, Integer
    65535))
              , (String
    "TINYTEXT", (Integer
    0, Integer
    256))
              , (String
    "TINYBLOB", (Integer
    0, Integer
    256))
              , (String
    "TEXT", (Integer
    0, Integer
    65536))
              , (String
    "BLOB", (Integer
    0, Integer
    65536))
              , (String
    "MEDIUMTEXT", (Integer
    0, Integer
    16777216))
              , (String
    "MEDIUMBLOB", (Integer
    0, Integer
    16777216))
              , (String
    "LONGTEXT", (Integer
    0, Integer
    4294967296))
              , (String
    "LONGBLOB", (Integer
    0, Integer
    4294967296))
              ]

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

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

    datatypeEqualMysql :: DatatypeEqual
    datatypeEqualMysql :: DatatypeEqual
    datatypeEqualMysql 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
          cmp :: (t -> String) -> CheckA (t, t) (String, String)
    cmp 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))
                      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)
          check :: CheckA (String, String) (String, String)
    check
              | String
    d String -> AllowedParams -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` AllowedParams
    stringTypes        = (String -> String) -> CheckA (String, String) (String, String)
    forall {t}. (t -> String) -> CheckA (t, t) (String, String)
    cmp String -> String
    forall a. a -> a
    id
              | String
    d String -> AllowedParams -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` AllowedParams
    numericTypes       = (String -> String) -> CheckA (String, String) (String, String)
    forall {t}. (t -> String) -> CheckA (t, t) (String, String)
    cmp String -> String
    normalizeNumber
              | Bool
    otherwise                   = ((String, String) -> String)
    -> CheckA (String, String) (String, String)
    forall a b. (a -> String) -> CheckA a b
    failure (((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) -> String
    forall a b. a -> b -> a
    const (String -> String -> String
    errorMsgDataTypeNotAllowed0 String
    mysqlNS String
    d)

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