-- |
-- 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 = "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
                   ("SIGNED-TINYINT", AllowedParams
numericParams)
                 , ("UNSIGNED-TINYINT", AllowedParams
numericParams)
                 , ("SIGNED-SMALLINT", AllowedParams
numericParams)
                 , ("UNSIGNED-SMALLINT", AllowedParams
numericParams)
                 , ("SIGNED-MEDIUMINT", AllowedParams
numericParams)
                 , ("UNSIGNED-MEDIUMINT", AllowedParams
numericParams)
                 , ("SIGNED-INT", AllowedParams
numericParams)
                 , ("UNSIGNED-INT", AllowedParams
numericParams)
                 , ("SIGNED-BIGINT", AllowedParams
numericParams)
                 , ("UNSIGNED-BIGINT", AllowedParams
numericParams)

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


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


-- | List of supported numeric datatypes
numericTypes :: [String]
numericTypes :: AllowedParams
numericTypes = [ "SIGNED-TINYINT"
               , "UNSIGNED-TINYINT"
               , "SIGNED-SMALLINT"
               , "UNSIGNED-SMALLINT"
               , "SIGNED-MEDIUMINT"
               , "UNSIGNED-MEDIUMINT"
               , "SIGNED-INT"
               , "UNSIGNED-INT"
               , "SIGNED-BIGINT"
               , "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 d :: String
d params :: ParamList
params value :: String
value _
    = 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 r :: (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 r :: (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
$
          [ ("SIGNED-TINYINT", ((-128), 127))
          , ("UNSIGNED-TINYINT", (0, 255))
          , ("SIGNED-SMALLINT", ((-32768), 32767))
          , ("UNSIGNED-SMALLINT", (0, 65535))
          , ("SIGNED-MEDIUMINT", ((-8388608), 8388607))
          , ("UNSIGNED-MEDIUMINT", (0, 16777215))
          , ("SIGNED-INT", ((-2147483648), 2147483647))
          , ("UNSIGNED-INT", (0, 4294967295))
          , ("SIGNED-BIGINT", ((-9223372036854775808), 9223372036854775807))
          , ("UNSIGNED-BIGINT", (0, 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
$
          [ ("CHAR", (0, 255))
          , ("VARCHAR", (0, 65535))
          , ("BINARY", (0, 255))
          , ("VARBINARY", (0, 65535))
          , ("TINYTEXT", (0, 256))
          , ("TINYBLOB", (0, 256))
          , ("TEXT", (0, 65536))
          , ("BLOB", (0, 65536))
          , ("MEDIUMTEXT", (0, 16777216))
          , ("MEDIUMBLOB", (0, 16777216))
          , ("LONGTEXT", (0, 4294967296))
          , ("LONGBLOB", (0, 4294967296))
          ]

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

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

datatypeEqualMysql :: DatatypeEqual
datatypeEqualMysql :: DatatypeEqual
datatypeEqualMysql d :: String
d s1 :: String
s1 _ s2 :: String
s2 _
    = 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 nf :: t -> String
nf    = ((t, t) -> (String, String)) -> CheckA (t, t) (String, String)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ (x1 :: t
x1, x2 :: 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 (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 (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)

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