module Text.XML.HXT.RelaxNG.DataTypeLibMysql
( mysqlNS
, mysqlDatatypeLib
)
where
import Text.XML.HXT.RelaxNG.DataTypeLibUtils
import Data.Maybe
mysqlNS :: String
mysqlNS = "http://www.mysql.com"
mysqlDatatypeLib :: DatatypeLibrary
mysqlDatatypeLib = (mysqlNS, DTC datatypeAllowsMysql datatypeEqualMysql mysqlDatatypes)
mysqlDatatypes :: AllowedDatatypes
mysqlDatatypes = [
("SIGNED-TINYINT", numericParams)
, ("UNSIGNED-TINYINT", numericParams)
, ("SIGNED-SMALLINT", numericParams)
, ("UNSIGNED-SMALLINT", numericParams)
, ("SIGNED-MEDIUMINT", numericParams)
, ("UNSIGNED-MEDIUMINT", numericParams)
, ("SIGNED-INT", numericParams)
, ("UNSIGNED-INT", numericParams)
, ("SIGNED-BIGINT", numericParams)
, ("UNSIGNED-BIGINT", numericParams)
, ("CHAR", stringParams)
, ("VARCHAR", stringParams)
, ("BINARY", stringParams)
, ("VARBINARY", stringParams)
, ("TINYTEXT", stringParams)
, ("TINYBLOB", stringParams)
, ("TEXT", stringParams)
, ("BLOB", stringParams)
, ("MEDIUMTEXT", stringParams)
, ("MEDIUMBLOB", stringParams)
, ("LONGTEXT", stringParams)
, ("LONGBLOB", stringParams)
]
stringTypes :: [String]
stringTypes = [ "CHAR"
, "VARCHAR"
, "BINARY"
, "VARBINARY"
, "TINYTEXT"
, "TINYBLOB"
, "TEXT"
, "BLOB"
, "MEDIUMTEXT"
, "MEDIUMBLOB"
, "LONGTEXT"
, "LONGBLOB"
]
numericTypes :: [String]
numericTypes = [ "SIGNED-TINYINT"
, "UNSIGNED-TINYINT"
, "SIGNED-SMALLINT"
, "UNSIGNED-SMALLINT"
, "SIGNED-MEDIUMINT"
, "UNSIGNED-MEDIUMINT"
, "SIGNED-INT"
, "UNSIGNED-INT"
, "SIGNED-BIGINT"
, "UNSIGNED-BIGINT"
]
numericParams :: AllowedParams
numericParams = [ rng_maxExclusive
, rng_minExclusive
, rng_maxInclusive
, rng_minInclusive
]
stringParams :: AllowedParams
stringParams = [ rng_length
, rng_maxLength
, rng_minLength
]
datatypeAllowsMysql :: DatatypeAllows
datatypeAllowsMysql d params value _
= performCheck check value
where
check
| isJust ndt = checkNum (fromJust ndt)
| isJust sdt = checkStr (fromJust sdt)
| otherwise = failure $ errorMsgDataTypeNotAllowed mysqlNS d params
checkNum r = uncurry (numberValid d) r params
checkStr r = uncurry (stringValid d) r params
ndt = lookup d $
[ ("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 = lookup d $
[ ("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 d s1 _ s2 _
= performCheck check (s1, s2)
where
cmp nf = arr (\ (x1, x2) -> (nf x1, nf x2))
>>>
assert (uncurry (==)) (uncurry $ errorMsgEqual d)
check
| d `elem` stringTypes = cmp id
| d `elem` numericTypes = cmp normalizeNumber
| otherwise = failure $ const (errorMsgDataTypeNotAllowed0 mysqlNS d)