module Database.MySQL.BinLogProtocol.BinLogMeta where
import Control.Applicative
import Data.Binary.Get
import Data.Bits
import Data.Word
import Database.MySQL.Protocol.ColumnDef
data BinLogMeta
= BINLOG_TYPE_TINY
| BINLOG_TYPE_SHORT
| BINLOG_TYPE_INT24
| BINLOG_TYPE_LONG
| BINLOG_TYPE_LONGLONG
| BINLOG_TYPE_FLOAT !Word8
| BINLOG_TYPE_DOUBLE !Word8
| BINLOG_TYPE_BIT !Word16 !Word8
| BINLOG_TYPE_TIMESTAMP
| BINLOG_TYPE_DATETIME
| BINLOG_TYPE_DATE
| BINLOG_TYPE_TIME
| BINLOG_TYPE_TIMESTAMP2 !Word8
| BINLOG_TYPE_DATETIME2 !Word8
| BINLOG_TYPE_TIME2 !Word8
| BINLOG_TYPE_YEAR
| BINLOG_TYPE_NEWDECIMAL !Word8 !Word8
| BINLOG_TYPE_ENUM !Word8
| BINLOG_TYPE_SET !Word16 !Word8
| BINLOG_TYPE_BLOB !Word8
| BINLOG_TYPE_STRING !Word16
| BINLOG_TYPE_GEOMETRY !Word8
deriving (Show, Eq)
getBinLogMeta :: FieldType -> Get BinLogMeta
getBinLogMeta t
| t == mySQLTypeTiny = pure BINLOG_TYPE_TINY
| t == mySQLTypeShort = pure BINLOG_TYPE_SHORT
| t == mySQLTypeInt24 = pure BINLOG_TYPE_INT24
| t == mySQLTypeLong = pure BINLOG_TYPE_LONG
| t == mySQLTypeLongLong = pure BINLOG_TYPE_LONGLONG
| t == mySQLTypeFloat = BINLOG_TYPE_FLOAT <$> getWord8
| t == mySQLTypeDouble = BINLOG_TYPE_DOUBLE <$> getWord8
| t == mySQLTypeBit = do
byte0 <- getWord8
byte1 <- getWord8
let nbits = (fromIntegral byte1 `shiftL` 3) .|. fromIntegral byte0
nbytes = fromIntegral $ (nbits + 7) `shiftR` 3
pure (BINLOG_TYPE_BIT nbits nbytes)
| t == mySQLTypeTimestamp = pure BINLOG_TYPE_TIMESTAMP
| t == mySQLTypeDateTime = pure BINLOG_TYPE_DATETIME
| t == mySQLTypeDate = pure BINLOG_TYPE_DATE
| t == mySQLTypeTime = pure BINLOG_TYPE_TIME
| t == mySQLTypeTimestamp2 = BINLOG_TYPE_TIMESTAMP2 <$> getWord8
| t == mySQLTypeDateTime2 = BINLOG_TYPE_DATETIME2 <$> getWord8
| t == mySQLTypeTime2 = BINLOG_TYPE_TIME2 <$> getWord8
| t == mySQLTypeYear = pure BINLOG_TYPE_YEAR
| t == mySQLTypeNewDecimal = BINLOG_TYPE_NEWDECIMAL <$> getWord8 <*> getWord8
| t == mySQLTypeVarChar = BINLOG_TYPE_STRING <$> getWord16le
| t == mySQLTypeVarString = BINLOG_TYPE_STRING <$> getWord16le
| t == mySQLTypeString = do
byte0 <- getWord8
byte1 <- getWord8
if byte0 > 0
then if (byte0 .&. 0x30) /= 0x30
then if FieldType (byte0 .|. 0x30) == mySQLTypeString
then let len = fromIntegral $ (byte0 .&. 0x30) `xor` 0x30
len' = len `shiftL` 4 .|. fromIntegral byte1
in pure $! BINLOG_TYPE_STRING len'
else let len = fromIntegral byte0 `shiftL` 8 :: Word16
len' = len .|. fromIntegral byte1
in pure $! BINLOG_TYPE_STRING len'
else let t' = FieldType byte0
in if | t' == mySQLTypeSet -> let nbits = fromIntegral byte1 `shiftL` 3
nbytes = fromIntegral $ (nbits + 7) `shiftR` 8
in pure (BINLOG_TYPE_SET nbits nbytes)
| t' == mySQLTypeEnum -> pure (BINLOG_TYPE_ENUM byte1)
| t' == mySQLTypeString -> pure (BINLOG_TYPE_STRING (fromIntegral byte1))
| otherwise -> fail $ "Database.MySQL.BinLogProtocol.BinLogMeta:\
\ impossible type inside binlog string: " ++ show t'
else pure (BINLOG_TYPE_STRING (fromIntegral byte1))
| t == mySQLTypeBlob = BINLOG_TYPE_BLOB <$> getWord8
| t == mySQLTypeGeometry = BINLOG_TYPE_GEOMETRY <$> getWord8
| otherwise = fail $ "Database.MySQL.BinLogProtocol.BinLogMeta:\
\ impossible type in binlog: " ++ show t