content: -- |
  -- 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 = "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)
  
  -- ------------------------------------------------------------
  