{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

{-|
Module      : Database.MySQL.Protocol.ColumnDef
Description : MySQL field type
Copyright   : (c) Winterland, 2016
License     : BSD
Maintainer  : drkoster@qq.com
Stability   : experimental
Portability : PORTABLE

Column definition(aka. field type).

-}

module Database.MySQL.Protocol.ColumnDef where

import           Control.Applicative
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

--------------------------------------------------------------------------------
--  Resultset

-- | A description of a field (column) of a table.
data ColumnDef = ColumnDef
    { -- fieldCatalog :: !ByteString              -- ^ const 'def'
      ColumnDef -> ByteString
columnDB        ::  !ByteString             -- ^ Database for table.
    , ColumnDef -> ByteString
columnTable     ::  !ByteString             -- ^ Table of column, if column was a field.
    , ColumnDef -> ByteString
columnOrigTable ::  !ByteString             -- ^ Original table name, if table was an alias.
    , ColumnDef -> ByteString
columnName      ::  !ByteString             -- ^ Name of column.
    , ColumnDef -> ByteString
columnOrigName  ::  !ByteString             -- ^ Original column name, if an alias.
    , ColumnDef -> Word16
columnCharSet   ::  !Word16                 -- ^ Character set number.
    , ColumnDef -> Word32
columnLength    ::  !Word32                 -- ^ Width of column (create length).
    , ColumnDef -> FieldType
columnType      ::  !FieldType
    , ColumnDef -> Word16
columnFlags     ::  !Word16                 -- ^ Div flags.
    , ColumnDef -> Word8
columnDecimals  ::  !Word8                  -- ^ Number of decimals in field.
    } 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
showList :: [ColumnDef] -> ShowS
$cshowList :: [ColumnDef] -> ShowS
show :: ColumnDef -> String
$cshow :: ColumnDef -> String
showsPrec :: Int -> ColumnDef -> ShowS
$cshowsPrec :: Int -> ColumnDef -> ShowS
Show, ColumnDef -> ColumnDef -> Bool
(ColumnDef -> ColumnDef -> Bool)
-> (ColumnDef -> ColumnDef -> Bool) -> Eq ColumnDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnDef -> ColumnDef -> Bool
$c/= :: ColumnDef -> ColumnDef -> Bool
== :: ColumnDef -> ColumnDef -> Bool
$c== :: 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                 -- const "def"
         Get () -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ByteString
getLenEncBytes)         -- db
        Get
  (ByteString
   -> ByteString
   -> ByteString
   -> ByteString
   -> Word16
   -> Word32
   -> FieldType
   -> Word16
   -> Word8
   -> ColumnDef)
-> Get ByteString
-> Get
     (ByteString
      -> ByteString
      -> ByteString
      -> Word16
      -> Word32
      -> FieldType
      -> Word16
      -> Word8
      -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getLenEncBytes          -- table
        Get
  (ByteString
   -> ByteString
   -> ByteString
   -> Word16
   -> Word32
   -> FieldType
   -> Word16
   -> Word8
   -> ColumnDef)
-> Get ByteString
-> Get
     (ByteString
      -> ByteString
      -> Word16
      -> Word32
      -> FieldType
      -> Word16
      -> Word8
      -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getLenEncBytes          -- origTable
        Get
  (ByteString
   -> ByteString
   -> Word16
   -> Word32
   -> FieldType
   -> Word16
   -> Word8
   -> ColumnDef)
-> Get ByteString
-> Get
     (ByteString
      -> Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getLenEncBytes          -- name
        Get
  (ByteString
   -> Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get ByteString
-> Get
     (Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getLenEncBytes          -- origName
        Get (Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get ()
-> Get
     (Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Int -> Get ()
skipN Int
1                  -- const 0x0c
        Get (Word16 -> Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get Word16
-> Get (Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le             -- charset
        Get (Word32 -> FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get Word32 -> Get (FieldType -> Word16 -> Word8 -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32le             -- length
        Get (FieldType -> Word16 -> Word8 -> ColumnDef)
-> Get FieldType -> Get (Word16 -> Word8 -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldType
getFieldType            -- type
        Get (Word16 -> Word8 -> ColumnDef)
-> Get Word16 -> Get (Word8 -> ColumnDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le             -- flags
        Get (Word8 -> ColumnDef) -> Get Word8 -> Get ColumnDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8                -- decimals
        Get ColumnDef -> Get () -> Get ColumnDef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Get ()
skipN Int
2                   -- const 0x00 0x00
{-# 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@ around 'Word8' for represent @MySQL_TYPE@, We don't use sum type here for speed reason.
--
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
showList :: [FieldType] -> ShowS
$cshowList :: [FieldType] -> ShowS
show :: FieldType -> String
$cshow :: FieldType -> String
showsPrec :: Int -> FieldType -> ShowS
$cshowsPrec :: Int -> FieldType -> ShowS
Show, FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c== :: 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 #-}

--------------------------------------------------------------------------------
--  Field flags

#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