{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Database.MySQL.Protocol.ColumnDef where
import Data.Binary
import Data.Binary.Get
import Data.Binary.Parser
import Data.Binary.Put
import Data.Bits ((.&.))
import Data.ByteString (ByteString)
import Database.MySQL.Protocol.Packet
data ColumnDef = ColumnDef
{
ColumnDef -> ByteString
columnDB :: !ByteString
, ColumnDef -> ByteString
columnTable :: !ByteString
, ColumnDef -> ByteString
columnOrigTable :: !ByteString
, ColumnDef -> ByteString
columnName :: !ByteString
, ColumnDef -> ByteString
columnOrigName :: !ByteString
, ColumnDef -> Word16
columnCharSet :: !Word16
, ColumnDef -> Word32
columnLength :: !Word32
, ColumnDef -> FieldType
columnType :: !FieldType
, ColumnDef -> Word16
columnFlags :: !Word16
, ColumnDef -> Word8
columnDecimals :: !Word8
} deriving (Int -> ColumnDef -> ShowS
[ColumnDef] -> ShowS
ColumnDef -> String
(Int -> ColumnDef -> ShowS)
-> (ColumnDef -> String)
-> ([ColumnDef] -> ShowS)
-> Show ColumnDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnDef -> ShowS
showsPrec :: Int -> ColumnDef -> ShowS
$cshow :: ColumnDef -> String
show :: ColumnDef -> String
$cshowList :: [ColumnDef] -> ShowS
showList :: [ColumnDef] -> ShowS
Show, ColumnDef -> ColumnDef -> Bool
(ColumnDef -> ColumnDef -> Bool)
-> (ColumnDef -> ColumnDef -> Bool) -> Eq ColumnDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnDef -> ColumnDef -> Bool
== :: ColumnDef -> ColumnDef -> Bool
$c/= :: ColumnDef -> ColumnDef -> Bool
/= :: ColumnDef -> ColumnDef -> Bool
Eq)
getField :: Get ColumnDef
getField :: Get ColumnDef
getField = ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word16
-> Word32
-> FieldType
-> Word16
-> Word8
-> ColumnDef
ColumnDef
(ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word16
-> Word32
-> FieldType
-> Word16
-> Word8
-> ColumnDef)
-> Get ByteString
-> Get
(ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word16
-> Word32
-> FieldType
-> Word16
-> Word8
-> ColumnDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get ()
skipN Int
4
Get () -> Get ByteString -> Get ByteString
forall a b. Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ByteString
getLenEncBytes)
Get
(ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word16
-> Word32
-> FieldType
-> Word16
-> Word8
-> ColumnDef)
-> Get ByteString
-> Get
(ByteString
-> ByteString
-> ByteString
-> Word16
-> Word32
-> FieldType
-> Word16
-> Word8
-> ColumnDef)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getLenEncBytes
Get
(ByteString
-> ByteString
-> ByteString
-> Word16
-> Word32
-> FieldType
-> Word16
-> Word8
-> ColumnDef)
-> Get ByteString
-> Get
(ByteString
-> ByteString
-> Word16
-> Word32
-> FieldType
-> Word16
-> Word8
-> ColumnDef)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getLenEncBytes
Get
(ByteString
-> ByteString
-> Word16
-> Word32
-> FieldType
-> Word16
-> Word8
-> ColumnDef)
-> Get ByteString
-> Get
(ByteString
-> Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getLenEncBytes
Get
(ByteString
-> Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get ByteString
-> Get
(Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getLenEncBytes
Get (Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get ()
-> Get
(Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
forall a b. Get a -> Get b -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Get ()
skipN Int
1
Get (Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get Word16
-> Get (Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le
Get (Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get Word32 -> Get (FieldType -> Word16 -> Word8 -> ColumnDef)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32le
Get (FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get FieldType -> Get (Word16 -> Word8 -> ColumnDef)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldType
getFieldType
Get (Word16 -> Word8 -> ColumnDef)
-> Get Word16 -> Get (Word8 -> ColumnDef)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le
Get (Word8 -> ColumnDef) -> Get Word8 -> Get ColumnDef
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
Get ColumnDef -> Get () -> Get ColumnDef
forall a b. Get a -> Get b -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Get ()
skipN Int
2
{-# INLINE getField #-}
putField :: ColumnDef -> Put
putField :: ColumnDef -> Put
putField (ColumnDef ByteString
db ByteString
tbl ByteString
otbl ByteString
name ByteString
oname Word16
charset Word32
len FieldType
typ Word16
flags Word8
dec) = do
ByteString -> Put
putLenEncBytes ByteString
"def"
ByteString -> Put
putLenEncBytes ByteString
db
ByteString -> Put
putLenEncBytes ByteString
tbl
ByteString -> Put
putLenEncBytes ByteString
otbl
ByteString -> Put
putLenEncBytes ByteString
name
ByteString -> Put
putLenEncBytes ByteString
oname
Word16 -> Put
putWord16le Word16
charset
Word32 -> Put
putWord32le Word32
len
FieldType -> Put
putFieldType FieldType
typ
Word16 -> Put
putWord16le Word16
flags
Word8 -> Put
putWord8 Word8
dec
Word16 -> Put
putWord16le Word16
0X0000
{-# INLINE putField #-}
instance Binary ColumnDef where
get :: Get ColumnDef
get = Get ColumnDef
getField
{-# INLINE get #-}
put :: ColumnDef -> Put
put = ColumnDef -> Put
putField
{-# INLINE put #-}
newtype FieldType = FieldType Word8 deriving (Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldType -> ShowS
showsPrec :: Int -> FieldType -> ShowS
$cshow :: FieldType -> String
show :: FieldType -> String
$cshowList :: [FieldType] -> ShowS
showList :: [FieldType] -> ShowS
Show, FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
/= :: FieldType -> FieldType -> Bool
Eq)
mySQLTypeDecimal, mySQLTypeTiny, mySQLTypeShort, mySQLTypeLong, mySQLTypeFloat :: FieldType
mySQLTypeDouble, mySQLTypeNull, mySQLTypeTimestamp, mySQLTypeLongLong, mySQLTypeInt24 :: FieldType
mySQLTypeDate, mySQLTypeTime, mySQLTypeDateTime, mySQLTypeYear, mySQLTypeNewDate, mySQLTypeVarChar :: FieldType
mySQLTypeBit, mySQLTypeTimestamp2, mySQLTypeDateTime2, mySQLTypeTime2, mySQLTypeNewDecimal :: FieldType
mySQLTypeEnum, mySQLTypeSet, mySQLTypeTinyBlob, mySQLTypeMediumBlob, mySQLTypeLongBlob :: FieldType
mySQLTypeBlob, mySQLTypeVarString, mySQLTypeString, mySQLTypeGeometry :: FieldType
mySQLTypeDecimal :: FieldType
mySQLTypeDecimal = Word8 -> FieldType
FieldType Word8
0x00
mySQLTypeTiny :: FieldType
mySQLTypeTiny = Word8 -> FieldType
FieldType Word8
0x01
mySQLTypeShort :: FieldType
mySQLTypeShort = Word8 -> FieldType
FieldType Word8
0x02
mySQLTypeLong :: FieldType
mySQLTypeLong = Word8 -> FieldType
FieldType Word8
0x03
mySQLTypeFloat :: FieldType
mySQLTypeFloat = Word8 -> FieldType
FieldType Word8
0x04
mySQLTypeDouble :: FieldType
mySQLTypeDouble = Word8 -> FieldType
FieldType Word8
0x05
mySQLTypeNull :: FieldType
mySQLTypeNull = Word8 -> FieldType
FieldType Word8
0x06
mySQLTypeTimestamp :: FieldType
mySQLTypeTimestamp = Word8 -> FieldType
FieldType Word8
0x07
mySQLTypeLongLong :: FieldType
mySQLTypeLongLong = Word8 -> FieldType
FieldType Word8
0x08
mySQLTypeInt24 :: FieldType
mySQLTypeInt24 = Word8 -> FieldType
FieldType Word8
0x09
mySQLTypeDate :: FieldType
mySQLTypeDate = Word8 -> FieldType
FieldType Word8
0x0a
mySQLTypeTime :: FieldType
mySQLTypeTime = Word8 -> FieldType
FieldType Word8
0x0b
mySQLTypeDateTime :: FieldType
mySQLTypeDateTime = Word8 -> FieldType
FieldType Word8
0x0c
mySQLTypeYear :: FieldType
mySQLTypeYear = Word8 -> FieldType
FieldType Word8
0x0d
mySQLTypeNewDate :: FieldType
mySQLTypeNewDate = Word8 -> FieldType
FieldType Word8
0x0e
mySQLTypeVarChar :: FieldType
mySQLTypeVarChar = Word8 -> FieldType
FieldType Word8
0x0f
mySQLTypeBit :: FieldType
mySQLTypeBit = Word8 -> FieldType
FieldType Word8
0x10
mySQLTypeTimestamp2 :: FieldType
mySQLTypeTimestamp2 = Word8 -> FieldType
FieldType Word8
0x11
mySQLTypeDateTime2 :: FieldType
mySQLTypeDateTime2 = Word8 -> FieldType
FieldType Word8
0x12
mySQLTypeTime2 :: FieldType
mySQLTypeTime2 = Word8 -> FieldType
FieldType Word8
0x13
mySQLTypeNewDecimal :: FieldType
mySQLTypeNewDecimal = Word8 -> FieldType
FieldType Word8
0xf6
mySQLTypeEnum :: FieldType
mySQLTypeEnum = Word8 -> FieldType
FieldType Word8
0xf7
mySQLTypeSet :: FieldType
mySQLTypeSet = Word8 -> FieldType
FieldType Word8
0xf8
mySQLTypeTinyBlob :: FieldType
mySQLTypeTinyBlob = Word8 -> FieldType
FieldType Word8
0xf9
mySQLTypeMediumBlob :: FieldType
mySQLTypeMediumBlob = Word8 -> FieldType
FieldType Word8
0xfa
mySQLTypeLongBlob :: FieldType
mySQLTypeLongBlob = Word8 -> FieldType
FieldType Word8
0xfb
mySQLTypeBlob :: FieldType
mySQLTypeBlob = Word8 -> FieldType
FieldType Word8
0xfc
mySQLTypeVarString :: FieldType
mySQLTypeVarString = Word8 -> FieldType
FieldType Word8
0xfd
mySQLTypeString :: FieldType
mySQLTypeString = Word8 -> FieldType
FieldType Word8
0xfe
mySQLTypeGeometry :: FieldType
mySQLTypeGeometry = Word8 -> FieldType
FieldType Word8
0xff
getFieldType :: Get FieldType
getFieldType :: Get FieldType
getFieldType = Word8 -> FieldType
FieldType (Word8 -> FieldType) -> Get Word8 -> Get FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
{-# INLINE getFieldType #-}
putFieldType :: FieldType -> Put
putFieldType :: FieldType -> Put
putFieldType (FieldType Word8
t) = Word8 -> Put
putWord8 Word8
t
{-# INLINE putFieldType #-}
instance Binary FieldType where
get :: Get FieldType
get = Get FieldType
getFieldType
{-# INLINE get #-}
put :: FieldType -> Put
put = FieldType -> Put
putFieldType
{-# INLINE put #-}
#define NOT_NULL_FLAG 1
#define PRI_KEY_FLAG 2
#define UNIQUE_KEY_FLAG 4
#define MULT_KEY_FLAG 8
#define BLOB_FLAG 16
#define UNSIGNED_FLAG 32
#define ZEROFILL_FLAG 64
#define BINARY_FLAG 128
#define ENUM_FLAG 256
#define AUTO_INCREMENT_FLAG 512
#define TIMESTAMP_FLAG 1024
#define SET_FLAG 2048
#define NO_DEFAULT_VALUE_FLAG 4096
#define PART_KEY_FLAG 16384
#define NUM_FLAG 32768
flagNotNull, flagPrimaryKey, flagUniqueKey, flagMultipleKey, flagBlob, flagUnsigned, flagZeroFill :: Word16 -> Bool
flagBinary, flagEnum, flagAutoIncrement, flagTimeStamp, flagSet, flagNoDefaultValue, flagPartKey, flagNumeric :: Word16 -> Bool
flagNotNull :: Word16 -> Bool
flagNotNull Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. NOT_NULL_FLAG == NOT_NULL_FLAG
flagPrimaryKey :: Word16 -> Bool
flagPrimaryKey Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. PRI_KEY_FLAG == PRI_KEY_FLAG
flagUniqueKey :: Word16 -> Bool
flagUniqueKey Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. UNIQUE_KEY_FLAG == UNIQUE_KEY_FLAG
flagMultipleKey :: Word16 -> Bool
flagMultipleKey Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. MULT_KEY_FLAG == MULT_KEY_FLAG
flagBlob :: Word16 -> Bool
flagBlob Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. BLOB_FLAG == BLOB_FLAG
flagUnsigned :: Word16 -> Bool
flagUnsigned Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. UNSIGNED_FLAG == UNSIGNED_FLAG
flagZeroFill :: Word16 -> Bool
flagZeroFill Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. ZEROFILL_FLAG == ZEROFILL_FLAG
flagBinary :: Word16 -> Bool
flagBinary Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. BINARY_FLAG == BINARY_FLAG
flagEnum :: Word16 -> Bool
flagEnum Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. ENUM_FLAG == ENUM_FLAG
flagAutoIncrement :: Word16 -> Bool
flagAutoIncrement Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. AUTO_INCREMENT_FLAG == AUTO_INCREMENT_FLAG
flagTimeStamp :: Word16 -> Bool
flagTimeStamp Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. TIMESTAMP_FLAG == TIMESTAMP_FLAG
flagSet :: Word16 -> Bool
flagSet Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. SET_FLAG == SET_FLAG
flagNoDefaultValue :: Word16 -> Bool
flagNoDefaultValue Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. NO_DEFAULT_VALUE_FLAG == NO_DEFAULT_VALUE_FLAG
flagPartKey :: Word16 -> Bool
flagPartKey Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. PART_KEY_FLAG == PART_KEY_FLAG
flagNumeric :: Word16 -> Bool
flagNumeric Word16
flags = Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. NUM_FLAG == NUM_FLAG