-- |
-- 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)

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