{-# OPTIONS_GHC -funbox-strict-fields #-}
module Database.MySQL.BinLogProtocol.BinLogMeta where
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 (Int -> BinLogMeta -> ShowS
[BinLogMeta] -> ShowS
BinLogMeta -> [Char]
(Int -> BinLogMeta -> ShowS)
-> (BinLogMeta -> [Char])
-> ([BinLogMeta] -> ShowS)
-> Show BinLogMeta
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinLogMeta -> ShowS
showsPrec :: Int -> BinLogMeta -> ShowS
$cshow :: BinLogMeta -> [Char]
show :: BinLogMeta -> [Char]
$cshowList :: [BinLogMeta] -> ShowS
showList :: [BinLogMeta] -> ShowS
Show, BinLogMeta -> BinLogMeta -> Bool
(BinLogMeta -> BinLogMeta -> Bool)
-> (BinLogMeta -> BinLogMeta -> Bool) -> Eq BinLogMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinLogMeta -> BinLogMeta -> Bool
== :: BinLogMeta -> BinLogMeta -> Bool
$c/= :: BinLogMeta -> BinLogMeta -> Bool
/= :: BinLogMeta -> BinLogMeta -> Bool
Eq)
getBinLogMeta :: FieldType -> Get BinLogMeta
getBinLogMeta :: FieldType -> Get BinLogMeta
getBinLogMeta FieldType
t
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTiny = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_TINY
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeShort = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_SHORT
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeInt24 = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_INT24
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLong = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_LONG
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLongLong = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_LONGLONG
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeFloat = Word8 -> BinLogMeta
BINLOG_TYPE_FLOAT (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDouble = Word8 -> BinLogMeta
BINLOG_TYPE_DOUBLE (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBit = do
Word8
byte0 <- Get Word8
getWord8
Word8
byte1 <- Get Word8
getWord8
let nbits :: Word16
nbits = (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte0
nbytes :: Word8
nbytes = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word16
nbits Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
7) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word8 -> BinLogMeta
BINLOG_TYPE_BIT Word16
nbits Word8
nbytes)
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_TIMESTAMP
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_DATETIME
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDate = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_DATE
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_TIME
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp2 = Word8 -> BinLogMeta
BINLOG_TYPE_TIMESTAMP2 (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime2 = Word8 -> BinLogMeta
BINLOG_TYPE_DATETIME2 (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime2 = Word8 -> BinLogMeta
BINLOG_TYPE_TIME2 (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeYear = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_YEAR
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDecimal = Word8 -> Word8 -> BinLogMeta
BINLOG_TYPE_NEWDECIMAL (Word8 -> Word8 -> BinLogMeta)
-> Get Word8 -> Get (Word8 -> BinLogMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
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
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarChar = Word16 -> BinLogMeta
BINLOG_TYPE_STRING (Word16 -> BinLogMeta) -> Get Word16 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarString = Word16 -> BinLogMeta
BINLOG_TYPE_STRING (Word16 -> BinLogMeta) -> Get Word16 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString = do
Word8
byte0 <- Get Word8
getWord8
Word8
byte1 <- Get Word8
getWord8
if Word8
byte0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0
then if (Word8
byte0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x30) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x30
then if Word8 -> FieldType
FieldType (Word8
byte0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x30) FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString
then let len :: Word16
len = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> Word8 -> Word16
forall a b. (a -> b) -> a -> b
$ (Word8
byte0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x30) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
0x30
len' :: Word16
len' = Word16
len Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1
in BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinLogMeta -> Get BinLogMeta) -> BinLogMeta -> Get BinLogMeta
forall a b. (a -> b) -> a -> b
$! Word16 -> BinLogMeta
BINLOG_TYPE_STRING Word16
len'
else let len :: Word16
len = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 :: Word16
len' :: Word16
len' = Word16
len Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1
in BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinLogMeta -> Get BinLogMeta) -> BinLogMeta -> Get BinLogMeta
forall a b. (a -> b) -> a -> b
$! Word16 -> BinLogMeta
BINLOG_TYPE_STRING Word16
len'
else let t' :: FieldType
t' = Word8 -> FieldType
FieldType Word8
byte0
in if | FieldType
t' FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeSet -> let nbits :: Word16
nbits = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
3
nbytes :: Word8
nbytes = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word16
nbits Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
7) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8
in BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word8 -> BinLogMeta
BINLOG_TYPE_SET Word16
nbits Word8
nbytes)
| FieldType
t' FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeEnum -> BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> BinLogMeta
BINLOG_TYPE_ENUM Word8
byte1)
| FieldType
t' FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString -> BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> BinLogMeta
BINLOG_TYPE_STRING (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1))
| Bool
otherwise -> [Char] -> Get BinLogMeta
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get BinLogMeta) -> [Char] -> Get BinLogMeta
forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.BinLogProtocol.BinLogMeta:\
\ impossible type inside binlog string: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldType -> [Char]
forall a. Show a => a -> [Char]
show FieldType
t'
else BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> BinLogMeta
BINLOG_TYPE_STRING (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1))
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBlob = Word8 -> BinLogMeta
BINLOG_TYPE_BLOB (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeGeometry = Word8 -> BinLogMeta
BINLOG_TYPE_GEOMETRY (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
| Bool
otherwise = [Char] -> Get BinLogMeta
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get BinLogMeta) -> [Char] -> Get BinLogMeta
forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.BinLogProtocol.BinLogMeta:\
\ impossible type in binlog: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldType -> [Char]
forall a. Show a => a -> [Char]
show FieldType
t