{-# LINE 1 "DB/HSQL/MySQL/Type.hsc" #-}
module DB.HSQL.MySQL.Type where
{-# LINE 2 "DB/HSQL/MySQL/Type.hsc" #-}

import Foreign(Ptr)
import Foreign.C(CString,CULong)

import Database.HSQL.Types


{-# LINE 9 "DB/HSQL/MySQL/Type.hsc" #-}

-- |
type MYSQL = Ptr ()

type MYSQL_RES = Ptr ()

type MYSQL_FIELD = Ptr ()

type MYSQL_ROW = Ptr CString

type MYSQL_LENGTHS = Ptr CULong

-- |
mkSqlType :: Int -> Int -> Int -> SqlType
mkSqlType (254)     size _	   = SqlChar size
{-# LINE 24 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (253) size _    = SqlVarChar size
{-# LINE 25 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (0)    size prec = SqlNumeric size prec
{-# LINE 26 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (2)      _    _    = SqlSmallInt
{-# LINE 27 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (9)      _    _    = SqlMedInt
{-# LINE 28 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (3)       _    _    = SqlInteger
{-# LINE 29 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (4)      _    _	   = SqlReal
{-# LINE 30 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (5)     _    _    = SqlDouble
{-# LINE 31 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (1)       _    _    = SqlTinyInt
{-# LINE 32 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (8)   _    _    = SqlBigInt
{-# LINE 33 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (10)       _    _    = SqlDate
{-# LINE 34 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (11)       _    _    = SqlTime
{-# LINE 35 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (7)  _    _    = SqlTimeStamp
{-# LINE 36 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (12)   _    _    = SqlDateTime
{-# LINE 37 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (13)       _    _    = SqlYear
{-# LINE 38 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (252)       _    _    = SqlBLOB
{-# LINE 39 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (248)        _    _    = SqlSET
{-# LINE 40 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType (247)       _    _    = SqlENUM
{-# LINE 41 "DB/HSQL/MySQL/Type.hsc" #-}
mkSqlType tp                             _    _    = SqlUnknown tp