module Text.XML.HXT.RelaxNG.DataTypeLibMysql
( mysqlNS
, mysqlDatatypeLib
)
where
import Text.XML.HXT.RelaxNG.DataTypeLibUtils
import Data.Maybe
mysqlNS :: String
mysqlNS :: String
mysqlNS = "http://www.mysql.com"
mysqlDatatypeLib :: DatatypeLibrary
mysqlDatatypeLib :: DatatypeLibrary
mysqlDatatypeLib = (String
mysqlNS, DatatypeAllows
-> DatatypeEqual -> AllowedDatatypes -> DatatypeCheck
DTC DatatypeAllows
datatypeAllowsMysql DatatypeEqual
datatypeEqualMysql AllowedDatatypes
mysqlDatatypes)
mysqlDatatypes :: AllowedDatatypes
mysqlDatatypes :: AllowedDatatypes
mysqlDatatypes = [
("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)
, ("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)
]
stringTypes :: [String]
stringTypes :: AllowedParams
stringTypes = [ "CHAR"
, "VARCHAR"
, "BINARY"
, "VARBINARY"
, "TINYTEXT"
, "TINYBLOB"
, "TEXT"
, "BLOB"
, "MEDIUMTEXT"
, "MEDIUMBLOB"
, "LONGTEXT"
, "LONGBLOB"
]
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"
]
numericParams :: AllowedParams
numericParams :: AllowedParams
numericParams = [ String
rng_maxExclusive
, String
rng_minExclusive
, String
rng_maxInclusive
, String
rng_minInclusive
]
stringParams :: AllowedParams
stringParams :: AllowedParams
stringParams = [ String
rng_length
, String
rng_maxLength
, String
rng_minLength
]
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))
]
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)