-- |
-- Datatype library for the MySQL datatypes
--
-- $Id: DataTypeLibMysql.hs,v 1.1 2005/09/02 17:09:39 hxml Exp $

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 = "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 = (mysqlNS, DTC datatypeAllowsMysql datatypeEqualMysql mysqlDatatypes)


-- | All supported datatypes of the library
mysqlDatatypes :: AllowedDatatypes
mysqlDatatypes = [ -- numeric types
                   ("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)

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


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


-- | List of supported numeric datatypes
numericTypes :: [String]
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 = [ rng_maxExclusive
                , rng_minExclusive
                , rng_maxInclusive
                , rng_minInclusive
                ]


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

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

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

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

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

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)

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