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

{-|
Module      : Database.MySQL.Protocol.MySQLValue
Description : Text and binary protocol
Copyright   : (c) Winterland, 2016
License     : BSD
Maintainer  : drkoster@qq.com
Stability   : experimental
Portability : PORTABLE

Core text and binary row decoder/encoder machinery.

-}

module Database.MySQL.Protocol.MySQLValue
  ( -- * MySQLValue decoder and encoder
    MySQLValue(..)
  , putParamMySQLType
  , getTextField
  , putTextField
  , getTextRow
  , getTextRowVector
  , getBinaryField
  , putBinaryField
  , getBinaryRow
  , getBinaryRowVector
  -- * Internal utilities
  , getBits
  , BitMap(..)
  , isColumnSet
  , isColumnNull
  , makeNullMap
  ) where

import qualified Blaze.Text                         as Textual
import           Control.Applicative
import           Control.Monad
import           Data.Binary.Put
import           Data.Binary.Parser
import           Data.Binary.IEEE754
import           Data.Bits
import           Data.ByteString                    (ByteString)
import qualified Data.ByteString                    as B
import qualified Data.ByteString.Builder            as BB
import           Data.ByteString.Builder.Scientific (FPFormat (..),
                                                     formatScientificBuilder)
import qualified Data.ByteString.Char8              as BC
import qualified Data.ByteString.Lazy               as L
import qualified Data.ByteString.Lex.Fractional     as LexFrac
import qualified Data.ByteString.Lex.Integral       as LexInt
import qualified Data.ByteString.Unsafe             as B
import           Data.Fixed                         (Pico)
import           Data.Int
import           Data.Scientific                    (Scientific)
import           Data.Text                          (Text)
import qualified Data.Text.Encoding                 as T
import           Data.Time.Calendar                 (Day, fromGregorian,
                                                     toGregorian)
import           Data.Time.Format                   (defaultTimeLocale,
                                                     formatTime)
import           Data.Time.LocalTime                (LocalTime (..),
                                                     TimeOfDay (..))
import           Data.Word
import           Database.MySQL.Protocol.ColumnDef
import           Database.MySQL.Protocol.Escape
import           Database.MySQL.Protocol.Packet
import           GHC.Generics                       (Generic)
import qualified Data.Vector                        as V

--------------------------------------------------------------------------------
-- | Data type mapping between MySQL values and haskell values.
--
-- There're some subtle differences between MySQL values and haskell values:
--
-- MySQL's @DATETIME@ and @TIMESTAMP@ are different on timezone handling:
--
--  * DATETIME and DATE is just a represent of a calendar date, it has no timezone information involved,
--  you always get the same value as you put no matter what timezone you're using with MySQL.
--
--  * MySQL converts TIMESTAMP values from the current time zone to UTC for storage,
--  and back from UTC to the current time zone for retrieval. If you put a TIMESTAMP with timezone A,
--  then read it with timezone B, you may get different result because of this conversion, so always
--  be careful about setting up the right timezone with MySQL, you can do it with a simple @SET time_zone = timezone;@
--  for more info on timezone support, please read <http://dev.mysql.com/doc/refman/5.7/en/time-zone-support.html>
--
--  So we use 'LocalTime' to present both @DATETIME@ and @TIMESTAMP@, but the local here is different.
--
-- MySQL's @TIME@ type can present time of day, but also elapsed time or a time interval between two events.
-- @TIME@ values may range from @-838:59:59@ to @838:59:59@, so 'MySQLTime' values consist of a sign and a
-- 'TimeOfDay' whose hour part may exceeded 24. you can use @timeOfDayToTime@ to get the absolute time interval.
--
-- Under MySQL >= 5.7, @DATETIME@, @TIMESTAMP@ and @TIME@ may contain fractional part, which matches haskell's
-- precision.
--
data MySQLValue
    = MySQLDecimal       !Scientific   -- ^ DECIMAL, NEWDECIMAL
    | MySQLInt8U         !Word8        -- ^ Unsigned TINY
    | MySQLInt8          !Int8         -- ^ TINY
    | MySQLInt16U        !Word16       -- ^ Unsigned SHORT
    | MySQLInt16         !Int16        -- ^ SHORT
    | MySQLInt32U        !Word32       -- ^ Unsigned LONG, INT24
    | MySQLInt32         !Int32        -- ^ LONG, INT24
    | MySQLInt64U        !Word64       -- ^ Unsigned LONGLONG
    | MySQLInt64         !Int64        -- ^ LONGLONG
    | MySQLFloat         !Float        -- ^ IEEE 754 single precision format
    | MySQLDouble        !Double       -- ^ IEEE 754 double precision format
    | MySQLYear          !Word16       -- ^ YEAR
    | MySQLDateTime      !LocalTime    -- ^ DATETIME
    | MySQLTimeStamp     !LocalTime    -- ^ TIMESTAMP
    | MySQLDate          !Day              -- ^ DATE
    | MySQLTime          !Word8 !TimeOfDay -- ^ sign(0 = non-negative, 1 = negative) hh mm ss microsecond
                                           -- The sign is OPPOSITE to binlog one !!!
    | MySQLGeometry      !ByteString       -- ^ todo: parsing to something meanful
    | MySQLBytes         !ByteString
    | MySQLBit           !Word64
    | MySQLText          !Text
    | MySQLNull
  deriving (Int -> MySQLValue -> ShowS
[MySQLValue] -> ShowS
MySQLValue -> String
(Int -> MySQLValue -> ShowS)
-> (MySQLValue -> String)
-> ([MySQLValue] -> ShowS)
-> Show MySQLValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MySQLValue] -> ShowS
$cshowList :: [MySQLValue] -> ShowS
show :: MySQLValue -> String
$cshow :: MySQLValue -> String
showsPrec :: Int -> MySQLValue -> ShowS
$cshowsPrec :: Int -> MySQLValue -> ShowS
Show, MySQLValue -> MySQLValue -> Bool
(MySQLValue -> MySQLValue -> Bool)
-> (MySQLValue -> MySQLValue -> Bool) -> Eq MySQLValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MySQLValue -> MySQLValue -> Bool
$c/= :: MySQLValue -> MySQLValue -> Bool
== :: MySQLValue -> MySQLValue -> Bool
$c== :: MySQLValue -> MySQLValue -> Bool
Eq, (forall x. MySQLValue -> Rep MySQLValue x)
-> (forall x. Rep MySQLValue x -> MySQLValue) -> Generic MySQLValue
forall x. Rep MySQLValue x -> MySQLValue
forall x. MySQLValue -> Rep MySQLValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MySQLValue x -> MySQLValue
$cfrom :: forall x. MySQLValue -> Rep MySQLValue x
Generic)

-- | Put 'FieldType' and usigned bit(0x80/0x00) for 'MySQLValue's.
--
putParamMySQLType :: MySQLValue -> Put
putParamMySQLType :: MySQLValue -> Put
putParamMySQLType (MySQLDecimal      Scientific
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeDecimal  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLInt8U        Word8
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeTiny     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x80
putParamMySQLType (MySQLInt8         Int8
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeTiny     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLInt16U       Word16
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeShort    Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x80
putParamMySQLType (MySQLInt16        Int16
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeShort    Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLInt32U       Word32
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeLong     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x80
putParamMySQLType (MySQLInt32        Int32
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeLong     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLInt64U       Word64
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeLongLong Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x80
putParamMySQLType (MySQLInt64        Int64
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeLongLong Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLFloat        Float
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeFloat    Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLDouble       Double
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeDouble   Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLYear         Word16
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeYear     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x80
putParamMySQLType (MySQLDateTime     LocalTime
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeDateTime Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLTimeStamp    LocalTime
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeTimestampPut -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLDate         Day
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeDate     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLTime       Word8
_ TimeOfDay
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeTime     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLBytes        ByteString
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeBlob     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLGeometry     ByteString
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeGeometry Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLBit          Word64
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeBit      Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLText         Text
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeString   Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType MySQLValue
MySQLNull              = FieldType -> Put
putFieldType FieldType
mySQLTypeNull     Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00

--------------------------------------------------------------------------------
-- | Text protocol decoder
getTextField :: ColumnDef -> Get MySQLValue
getTextField :: ColumnDef -> Get MySQLValue
getTextField ColumnDef
f
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNull            = MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure MySQLValue
MySQLNull
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDecimal
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDecimal = FieldType
-> (Scientific -> MySQLValue)
-> (ByteString -> Maybe Scientific)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Scientific -> MySQLValue
MySQLDecimal ByteString -> Maybe Scientific
forall b. Fractional b => ByteString -> Maybe b
fracLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTiny            = if Bool
isUnsigned then FieldType
-> (Word8 -> MySQLValue)
-> (ByteString -> Maybe Word8)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word8 -> MySQLValue
MySQLInt8U ByteString -> Maybe Word8
forall b. Integral b => ByteString -> Maybe b
intLexer
                                                    else FieldType
-> (Int8 -> MySQLValue)
-> (ByteString -> Maybe Int8)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Int8 -> MySQLValue
MySQLInt8 ByteString -> Maybe Int8
forall b. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeShort           = if Bool
isUnsigned then FieldType
-> (Word16 -> MySQLValue)
-> (ByteString -> Maybe Word16)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word16 -> MySQLValue
MySQLInt16U ByteString -> Maybe Word16
forall b. Integral b => ByteString -> Maybe b
intLexer
                                                    else FieldType
-> (Int16 -> MySQLValue)
-> (ByteString -> Maybe Int16)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Int16 -> MySQLValue
MySQLInt16 ByteString -> Maybe Int16
forall b. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLong
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeInt24      = if Bool
isUnsigned then FieldType
-> (Word32 -> MySQLValue)
-> (ByteString -> Maybe Word32)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word32 -> MySQLValue
MySQLInt32U ByteString -> Maybe Word32
forall b. Integral b => ByteString -> Maybe b
intLexer
                                                    else FieldType
-> (Int32 -> MySQLValue)
-> (ByteString -> Maybe Int32)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Int32 -> MySQLValue
MySQLInt32 ByteString -> Maybe Int32
forall b. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLongLong        = if Bool
isUnsigned then FieldType
-> (Word64 -> MySQLValue)
-> (ByteString -> Maybe Word64)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word64 -> MySQLValue
MySQLInt64U ByteString -> Maybe Word64
forall b. Integral b => ByteString -> Maybe b
intLexer
                                                    else FieldType
-> (Int64 -> MySQLValue)
-> (ByteString -> Maybe Int64)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Int64 -> MySQLValue
MySQLInt64 ByteString -> Maybe Int64
forall b. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeFloat           = FieldType
-> (Float -> MySQLValue)
-> (ByteString -> Maybe Float)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Float -> MySQLValue
MySQLFloat ByteString -> Maybe Float
forall b. Fractional b => ByteString -> Maybe b
fracLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDouble          = FieldType
-> (Double -> MySQLValue)
-> (ByteString -> Maybe Double)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Double -> MySQLValue
MySQLDouble ByteString -> Maybe Double
forall b. Fractional b => ByteString -> Maybe b
fracLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeYear            = FieldType
-> (Word16 -> MySQLValue)
-> (ByteString -> Maybe Word16)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word16 -> MySQLValue
MySQLYear ByteString -> Maybe Word16
forall b. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp2 = FieldType
-> (LocalTime -> MySQLValue)
-> (ByteString -> Maybe LocalTime)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t LocalTime -> MySQLValue
MySQLTimeStamp ((ByteString -> Maybe LocalTime) -> Get MySQLValue)
-> (ByteString -> Maybe LocalTime) -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ \ ByteString
bs ->
                                          Day -> TimeOfDay -> LocalTime
LocalTime (Day -> TimeOfDay -> LocalTime)
-> Maybe Day -> Maybe (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Day
dateParser ByteString
bs Maybe (TimeOfDay -> LocalTime)
-> Maybe TimeOfDay -> Maybe LocalTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe TimeOfDay
timeParser (Int -> ByteString -> ByteString
B.unsafeDrop Int
11 ByteString
bs)
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime2  = FieldType
-> (LocalTime -> MySQLValue)
-> (ByteString -> Maybe LocalTime)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t LocalTime -> MySQLValue
MySQLDateTime ((ByteString -> Maybe LocalTime) -> Get MySQLValue)
-> (ByteString -> Maybe LocalTime) -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ \ ByteString
bs ->
                                          Day -> TimeOfDay -> LocalTime
LocalTime (Day -> TimeOfDay -> LocalTime)
-> Maybe Day -> Maybe (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Day
dateParser ByteString
bs Maybe (TimeOfDay -> LocalTime)
-> Maybe TimeOfDay -> Maybe LocalTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe TimeOfDay
timeParser (Int -> ByteString -> ByteString
B.unsafeDrop Int
11 ByteString
bs)
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDate
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDate    = FieldType
-> (Day -> MySQLValue)
-> (ByteString -> Maybe Day)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Day -> MySQLValue
MySQLDate ByteString -> Maybe Day
dateParser
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime2      = FieldType
-> (MySQLValue -> MySQLValue)
-> (ByteString -> Maybe MySQLValue)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t MySQLValue -> MySQLValue
forall a. a -> a
id ((ByteString -> Maybe MySQLValue) -> Get MySQLValue)
-> (ByteString -> Maybe MySQLValue) -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ \ ByteString
bs ->
                                          if ByteString
bs ByteString -> Int -> Word8
`B.unsafeIndex` Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45  -- '-'
                                               then Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
1 (TimeOfDay -> MySQLValue) -> Maybe TimeOfDay -> Maybe MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe TimeOfDay
timeParser (Int -> ByteString -> ByteString
B.unsafeDrop Int
1 ByteString
bs)
                                               else Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
0 (TimeOfDay -> MySQLValue) -> Maybe TimeOfDay -> Maybe MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe TimeOfDay
timeParser ByteString
bs

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeGeometry        = ByteString -> MySQLValue
MySQLGeometry (ByteString -> MySQLValue) -> Get ByteString -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenEncBytes
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarChar
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeEnum
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeSet
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTinyBlob
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeMediumBlob
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLongBlob
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBlob
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarString
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString     = (if Bool
isText then Text -> MySQLValue
MySQLText (Text -> MySQLValue)
-> (ByteString -> Text) -> ByteString -> MySQLValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 else ByteString -> MySQLValue
MySQLBytes) (ByteString -> MySQLValue) -> Get ByteString -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenEncBytes

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBit             = Word64 -> MySQLValue
MySQLBit (Word64 -> MySQLValue) -> Get Word64 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get Word64
getBits (Int -> Get Word64) -> Get Int -> Get Word64
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Int
getLenEncInt)

    | Bool
otherwise                     = String -> Get MySQLValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get MySQLValue) -> String -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ String
"Database.MySQL.Protocol.MySQLValue: missing text decoder for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldType -> String
forall a. Show a => a -> String
show FieldType
t
  where
    t :: FieldType
t = ColumnDef -> FieldType
columnType ColumnDef
f
    isUnsigned :: Bool
isUnsigned = Word16 -> Bool
flagUnsigned (ColumnDef -> Word16
columnFlags ColumnDef
f)
    isText :: Bool
isText = ColumnDef -> Word16
columnCharSet ColumnDef
f Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
63
    intLexer :: ByteString -> Maybe b
intLexer ByteString
bs = (b, ByteString) -> b
forall a b. (a, b) -> a
fst ((b, ByteString) -> b) -> Maybe (b, ByteString) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe (b, ByteString))
-> ByteString -> Maybe (b, ByteString)
forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
LexInt.readSigned ByteString -> Maybe (b, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal ByteString
bs
    fracLexer :: ByteString -> Maybe b
fracLexer ByteString
bs = (b, ByteString) -> b
forall a b. (a, b) -> a
fst ((b, ByteString) -> b) -> Maybe (b, ByteString) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe (b, ByteString))
-> ByteString -> Maybe (b, ByteString)
forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
LexFrac.readSigned ByteString -> Maybe (b, ByteString)
forall a. Fractional a => ByteString -> Maybe (a, ByteString)
LexFrac.readDecimal ByteString
bs
    dateParser :: ByteString -> Maybe Day
dateParser ByteString
bs = do
        (Integer
yyyy, ByteString
rest) <- ByteString -> Maybe (Integer, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal ByteString
bs
        (Int
mm, ByteString
rest') <- ByteString -> Maybe (Int, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal (ByteString -> ByteString
B.unsafeTail ByteString
rest)
        (Int
dd, ByteString
_) <- ByteString -> Maybe (Int, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal (ByteString -> ByteString
B.unsafeTail ByteString
rest')
        Day -> Maybe Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Int -> Day
fromGregorian Integer
yyyy Int
mm Int
dd)

    timeParser :: ByteString -> Maybe TimeOfDay
timeParser ByteString
bs = do
        (Int
hh, ByteString
rest) <- ByteString -> Maybe (Int, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal ByteString
bs
        (Int
mm, ByteString
rest') <- ByteString -> Maybe (Int, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal (ByteString -> ByteString
B.unsafeTail ByteString
rest)
        (Pico
ss, ByteString
_) <- ByteString -> Maybe (Pico, ByteString)
forall a. Fractional a => ByteString -> Maybe (a, ByteString)
LexFrac.readDecimal (ByteString -> ByteString
B.unsafeTail ByteString
rest')
        TimeOfDay -> Maybe TimeOfDay
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
hh Int
mm Pico
ss)


feedLenEncBytes :: FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes :: FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
typ t -> b
con ByteString -> Maybe t
parser = do
    ByteString
bs <- Get ByteString
getLenEncBytes
    case ByteString -> Maybe t
parser ByteString
bs of
        Just t
v -> b -> Get b
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> b
con t
v)
        Maybe t
Nothing -> String -> Get b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get b) -> String -> Get b
forall a b. (a -> b) -> a -> b
$ String
"Database.MySQL.Protocol.MySQLValue: parsing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldType -> String
forall a. Show a => a -> String
show FieldType
typ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" failed, \
                          \input: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BC.unpack ByteString
bs
{-# INLINE feedLenEncBytes #-}

--------------------------------------------------------------------------------
-- | Text protocol encoder
putTextField :: MySQLValue -> Put
putTextField :: MySQLValue -> Put
putTextField (MySQLDecimal    Scientific
n) = Builder -> Put
putBuilder (FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
Fixed Maybe Int
forall a. Maybe a
Nothing Scientific
n)
putTextField (MySQLInt8U      Word8
n) = Builder -> Put
putBuilder (Word8 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word8
n)
putTextField (MySQLInt8       Int8
n) = Builder -> Put
putBuilder (Int8 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Int8
n)
putTextField (MySQLInt16U     Word16
n) = Builder -> Put
putBuilder (Word16 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word16
n)
putTextField (MySQLInt16      Int16
n) = Builder -> Put
putBuilder (Int16 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Int16
n)
putTextField (MySQLInt32U     Word32
n) = Builder -> Put
putBuilder (Word32 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word32
n)
putTextField (MySQLInt32      Int32
n) = Builder -> Put
putBuilder (Int32 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Int32
n)
putTextField (MySQLInt64U     Word64
n) = Builder -> Put
putBuilder (Word64 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word64
n)
putTextField (MySQLInt64      Int64
n) = Builder -> Put
putBuilder (Int64 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Int64
n)
putTextField (MySQLFloat      Float
x) = Builder -> Put
putBuilder (Float -> Builder
Textual.float Float
x)
putTextField (MySQLDouble     Double
x) = Builder -> Put
putBuilder (Double -> Builder
Textual.double Double
x)
putTextField (MySQLYear       Word16
n) = Builder -> Put
putBuilder (Word16 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word16
n)
putTextField (MySQLDateTime  LocalTime
dt) = Put -> Put
putInQuotes (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
                                      ByteString -> Put
putByteString (String -> ByteString
BC.pack (TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T%Q" LocalTime
dt))
putTextField (MySQLTimeStamp LocalTime
dt) = Put -> Put
putInQuotes (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
                                      ByteString -> Put
putByteString (String -> ByteString
BC.pack (TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T%Q" LocalTime
dt))
putTextField (MySQLDate       Day
d) = Put -> Put
putInQuotes (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
                                      ByteString -> Put
putByteString (String -> ByteString
BC.pack (TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F" Day
d))
putTextField (MySQLTime  Word8
sign TimeOfDay
t) = Put -> Put
putInQuotes (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
                                      Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1) (Char -> Put
putCharUtf8 Char
'-')
                                      ByteString -> Put
putByteString (String -> ByteString
BC.pack (TimeLocale -> String -> TimeOfDay -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%T%Q" TimeOfDay
t))
                                      -- this works even for hour > 24
putTextField (MySQLGeometry  ByteString
bs) = Put -> Put
putInQuotes (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putByteString (ByteString -> Put)
-> (ByteString -> ByteString) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
escapeBytes (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
bs
putTextField (MySQLBytes     ByteString
bs) = Put -> Put
putInQuotes (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putByteString (ByteString -> Put)
-> (ByteString -> ByteString) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
escapeBytes (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
bs
putTextField (MySQLText       Text
t) = Put -> Put
putInQuotes (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
                                      ByteString -> Put
putByteString (ByteString -> Put) -> (Text -> ByteString) -> Text -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeText (Text -> Put) -> Text -> Put
forall a b. (a -> b) -> a -> b
$ Text
t
putTextField (MySQLBit        Word64
b) = do Builder -> Put
putBuilder Builder
"b\'"
                                      Builder -> Put
putBuilder (Builder -> Put) -> (Put -> Builder) -> Put -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> Builder
forall a. PutM a -> Builder
execPut (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word64 -> Put
putTextBits Word64
b
                                      Char -> Put
putCharUtf8 Char
'\''
  where
    putTextBits :: Word64 -> Put
    putTextBits :: Word64 -> Put
putTextBits Word64
word = [Int] -> (Int -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
63,Int
62..Int
0] ((Int -> Put) -> Put) -> (Int -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \ Int
pos ->
            if Word64
word Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
pos then Char -> Put
putCharUtf8 Char
'1' else Char -> Put
putCharUtf8 Char
'0'
    {-# INLINE putTextBits #-}

putTextField MySQLValue
MySQLNull           = Builder -> Put
putBuilder Builder
"NULL"

putInQuotes :: Put -> Put
putInQuotes :: Put -> Put
putInQuotes Put
p = Char -> Put
putCharUtf8 Char
'\'' Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Put
putCharUtf8 Char
'\''
{-# INLINE putInQuotes #-}

--------------------------------------------------------------------------------
-- | Text row decoder
getTextRow :: [ColumnDef] -> Get [MySQLValue]
getTextRow :: [ColumnDef] -> Get [MySQLValue]
getTextRow [ColumnDef]
fs = [ColumnDef] -> (ColumnDef -> Get MySQLValue) -> Get [MySQLValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ColumnDef]
fs ((ColumnDef -> Get MySQLValue) -> Get [MySQLValue])
-> (ColumnDef -> Get MySQLValue) -> Get [MySQLValue]
forall a b. (a -> b) -> a -> b
$ \ ColumnDef
f -> do
    Word8
p <- Get Word8
peek
    if Word8
p Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFB
    then Int -> Get ()
skipN Int
1 Get () -> Get MySQLValue -> Get MySQLValue
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MySQLValue -> Get MySQLValue
forall (m :: * -> *) a. Monad m => a -> m a
return MySQLValue
MySQLNull
    else ColumnDef -> Get MySQLValue
getTextField ColumnDef
f
{-# INLINE getTextRow #-}

getTextRowVector :: V.Vector ColumnDef -> Get (V.Vector MySQLValue)
getTextRowVector :: Vector ColumnDef -> Get (Vector MySQLValue)
getTextRowVector Vector ColumnDef
fs = Vector ColumnDef
-> (ColumnDef -> Get MySQLValue) -> Get (Vector MySQLValue)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector ColumnDef
fs ((ColumnDef -> Get MySQLValue) -> Get (Vector MySQLValue))
-> (ColumnDef -> Get MySQLValue) -> Get (Vector MySQLValue)
forall a b. (a -> b) -> a -> b
$ \ ColumnDef
f -> do
    Word8
p <- Get Word8
peek
    if Word8
p Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFB
    then Int -> Get ()
skipN Int
1 Get () -> Get MySQLValue -> Get MySQLValue
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MySQLValue -> Get MySQLValue
forall (m :: * -> *) a. Monad m => a -> m a
return MySQLValue
MySQLNull
    else ColumnDef -> Get MySQLValue
getTextField ColumnDef
f
{-# INLINE getTextRowVector #-}

--------------------------------------------------------------------------------
-- | Binary protocol decoder
getBinaryField :: ColumnDef -> Get MySQLValue
getBinaryField :: ColumnDef -> Get MySQLValue
getBinaryField ColumnDef
f
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNull              = MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure MySQLValue
MySQLNull
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDecimal
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDecimal   = FieldType
-> (Scientific -> MySQLValue)
-> (ByteString -> Maybe Scientific)
-> Get MySQLValue
forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Scientific -> MySQLValue
MySQLDecimal ByteString -> Maybe Scientific
forall b. Fractional b => ByteString -> Maybe b
fracLexer
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTiny              = if Bool
isUnsigned then Word8 -> MySQLValue
MySQLInt8U (Word8 -> MySQLValue) -> Get Word8 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
                                                      else Int8 -> MySQLValue
MySQLInt8  (Int8 -> MySQLValue) -> Get Int8 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeShort             = if Bool
isUnsigned then Word16 -> MySQLValue
MySQLInt16U (Word16 -> MySQLValue) -> Get Word16 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
                                                      else Int16 -> MySQLValue
MySQLInt16  (Int16 -> MySQLValue) -> Get Int16 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16le
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLong
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeInt24        = if Bool
isUnsigned then Word32 -> MySQLValue
MySQLInt32U (Word32 -> MySQLValue) -> Get Word32 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
                                                      else Int32 -> MySQLValue
MySQLInt32  (Int32 -> MySQLValue) -> Get Int32 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32le
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeYear              = Word16 -> MySQLValue
MySQLYear (Word16 -> MySQLValue)
-> (Word16 -> Word16) -> Word16 -> MySQLValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> MySQLValue) -> Get Word16 -> Get MySQLValue
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
mySQLTypeLongLong          = if Bool
isUnsigned then Word64 -> MySQLValue
MySQLInt64U (Word64 -> MySQLValue) -> Get Word64 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
                                                      else Int64 -> MySQLValue
MySQLInt64  (Int64 -> MySQLValue) -> Get Int64 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeFloat             = Float -> MySQLValue
MySQLFloat  (Float -> MySQLValue) -> Get Float -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloatle
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDouble            = Double -> MySQLValue
MySQLDouble (Double -> MySQLValue) -> Get Double -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDoublele
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp2   = do
            Int
n <- Get Int
getLenEncInt
            case Int
n of
               Int
0 -> MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLTimeStamp (Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
0 Int
0 Int
0) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0))
               Int
4 -> do
                   Day
d <- Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Get Integer -> Get (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getYear Get (Int -> Int -> Day) -> Get Int -> Get (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Int -> Day) -> Get Int -> Get Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLTimeStamp (Day -> TimeOfDay -> LocalTime
LocalTime Day
d (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0))
               Int
7 -> do
                   Day
d <- Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Get Integer -> Get (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getYear Get (Int -> Int -> Day) -> Get Int -> Get (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Int -> Day) -> Get Int -> Get Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   TimeOfDay
td <- Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int -> Int -> Pico -> TimeOfDay)
-> Get Int -> Get (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' Get (Int -> Pico -> TimeOfDay)
-> Get Int -> Get (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Pico -> TimeOfDay) -> Get Pico -> Get TimeOfDay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond4
                   MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLTimeStamp (Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
td)
               Int
11 -> do
                   Day
d <- Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Get Integer -> Get (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getYear Get (Int -> Int -> Day) -> Get Int -> Get (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Int -> Day) -> Get Int -> Get Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   TimeOfDay
td <- Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int -> Int -> Pico -> TimeOfDay)
-> Get Int -> Get (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' Get (Int -> Pico -> TimeOfDay)
-> Get Int -> Get (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Pico -> TimeOfDay) -> Get Pico -> Get TimeOfDay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond8
                   MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLTimeStamp (Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
td)
               Int
_ -> String -> Get MySQLValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Database.MySQL.Protocol.MySQLValue: wrong TIMESTAMP length"
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime2    = do
            Int
n <- Get Int
getLenEncInt
            case Int
n of
               Int
0 -> MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLDateTime (Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
0 Int
0 Int
0) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0))
               Int
4 -> do
                   Day
d <- Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Get Integer -> Get (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getYear Get (Int -> Int -> Day) -> Get Int -> Get (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Int -> Day) -> Get Int -> Get Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLDateTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
d (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0))
               Int
7 -> do
                   Day
d <- Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Get Integer -> Get (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getYear Get (Int -> Int -> Day) -> Get Int -> Get (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Int -> Day) -> Get Int -> Get Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   TimeOfDay
td <- Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int -> Int -> Pico -> TimeOfDay)
-> Get Int -> Get (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' Get (Int -> Pico -> TimeOfDay)
-> Get Int -> Get (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Pico -> TimeOfDay) -> Get Pico -> Get TimeOfDay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond4
                   MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLDateTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
td)
               Int
11 -> do
                   Day
d <- Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Get Integer -> Get (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getYear Get (Int -> Int -> Day) -> Get Int -> Get (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Int -> Day) -> Get Int -> Get Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   TimeOfDay
td <- Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int -> Int -> Pico -> TimeOfDay)
-> Get Int -> Get (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' Get (Int -> Pico -> TimeOfDay)
-> Get Int -> Get (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Pico -> TimeOfDay) -> Get Pico -> Get TimeOfDay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond8
                   MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLDateTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
td)
               Int
_ -> String -> Get MySQLValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Database.MySQL.Protocol.MySQLValue: wrong DATETIME length"

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDate
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDate      = do
            Int
n <- Get Int
getLenEncInt
            case Int
n of
               Int
0 -> MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ Day -> MySQLValue
MySQLDate (Integer -> Int -> Int -> Day
fromGregorian Integer
0 Int
0 Int
0)
               Int
4 -> Day -> MySQLValue
MySQLDate (Day -> MySQLValue) -> Get Day -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Get Integer -> Get (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getYear Get (Int -> Int -> Day) -> Get Int -> Get (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' Get (Int -> Day) -> Get Int -> Get Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8')
               Int
_ -> String -> Get MySQLValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Database.MySQL.Protocol.MySQLValue: wrong DATE length"

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime2        = do
            Int
n <- Get Int
getLenEncInt
            case Int
n of
               Int
0 -> MySQLValue -> Get MySQLValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MySQLValue -> Get MySQLValue) -> MySQLValue -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
0 (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0)
               Int
8 -> do
                   Word8
sign <- Get Word8
getWord8   -- is_negative(1 if minus, 0 for plus)
                   Int
d <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
                   Int
h <-  Get Int
getInt8'
                   Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
sign (TimeOfDay -> MySQLValue) -> Get TimeOfDay -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h) (Int -> Pico -> TimeOfDay) -> Get Int -> Get (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' Get (Pico -> TimeOfDay) -> Get Pico -> Get TimeOfDay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond4)

               Int
12 -> do
                   Word8
sign <- Get Word8
getWord8   -- is_negative(1 if minus, 0 for plus)
                   Int
d <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
                   Int
h <-  Get Int
getInt8'
                   Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
sign (TimeOfDay -> MySQLValue) -> Get TimeOfDay -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h) (Int -> Pico -> TimeOfDay) -> Get Int -> Get (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' Get (Pico -> TimeOfDay) -> Get Pico -> Get TimeOfDay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond8)
               Int
_ -> String -> Get MySQLValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Database.MySQL.Protocol.MySQLValue: wrong TIME length"

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeGeometry          = ByteString -> MySQLValue
MySQLGeometry (ByteString -> MySQLValue) -> Get ByteString -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenEncBytes
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarChar
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeEnum
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeSet
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTinyBlob
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeMediumBlob
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLongBlob
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBlob
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarString
        Bool -> Bool -> Bool
|| FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString       = if Bool
isText then Text -> MySQLValue
MySQLText (Text -> MySQLValue)
-> (ByteString -> Text) -> ByteString -> MySQLValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> MySQLValue) -> Get ByteString -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenEncBytes
                                                  else ByteString -> MySQLValue
MySQLBytes (ByteString -> MySQLValue) -> Get ByteString -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenEncBytes
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBit               = Word64 -> MySQLValue
MySQLBit (Word64 -> MySQLValue) -> Get Word64 -> Get MySQLValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get Word64
getBits (Int -> Get Word64) -> Get Int -> Get Word64
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Int
getLenEncInt)
    | Bool
otherwise                       = String -> Get MySQLValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get MySQLValue) -> String -> Get MySQLValue
forall a b. (a -> b) -> a -> b
$ String
"Database.MySQL.Protocol.MySQLValue:\
                                               \ missing binary decoder for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldType -> String
forall a. Show a => a -> String
show FieldType
t
  where
    t :: FieldType
t = ColumnDef -> FieldType
columnType ColumnDef
f
    isUnsigned :: Bool
isUnsigned = Word16 -> Bool
flagUnsigned (ColumnDef -> Word16
columnFlags ColumnDef
f)
    isText :: Bool
isText = ColumnDef -> Word16
columnCharSet ColumnDef
f Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
63
    fracLexer :: ByteString -> Maybe b
fracLexer ByteString
bs = (b, ByteString) -> b
forall a b. (a, b) -> a
fst ((b, ByteString) -> b) -> Maybe (b, ByteString) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe (b, ByteString))
-> ByteString -> Maybe (b, ByteString)
forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
LexFrac.readSigned ByteString -> Maybe (b, ByteString)
forall a. Fractional a => ByteString -> Maybe (a, ByteString)
LexFrac.readDecimal ByteString
bs
    getYear :: Get Integer
    getYear :: Get Integer
getYear = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Get Word16 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    getInt8' :: Get Int
    getInt8' :: Get Int
getInt8' = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    getSecond4 :: Get Pico
    getSecond4 :: Get Pico
getSecond4 = Word8 -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Word8 -> Pico) -> Get Word8 -> Get Pico
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    getSecond8 :: Get Pico
    getSecond8 :: Get Pico
getSecond8 = Pico -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Pico -> Pico) -> Get Pico -> Get Pico
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Int
s <- Get Int
getInt8'
        Int
ms <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le :: Get Int
        Pico -> Get Pico
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pico -> Get Pico) -> Pico -> Get Pico
forall a b. (a -> b) -> a -> b
$! (Int -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
s Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Int -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
ms Pico -> Pico -> Pico
forall a. Fractional a => a -> a -> a
/ Pico
1000000 :: Pico)


-- | Get a bit sequence as a Word64
--
-- Since 'Word64' has a @Bits@ instance, it's easier to deal with in haskell.
--
getBits :: Int -> Get Word64
getBits :: Int -> Get Word64
getBits Int
bytes =
    if  | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Get Word8 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word64) -> Get Word16 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
        | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 -> Word24 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word24 -> Word64) -> Get Word24 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word24
getWord24be
        | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 -> Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
        | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 -> Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord40be
        | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 -> Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord48be
        | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 -> Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord56be
        | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 -> Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
        | Bool
otherwise  -> String -> Get Word64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Word64) -> String -> Get Word64
forall a b. (a -> b) -> a -> b
$  String
"Database.MySQL.Protocol.MySQLValue: \
                                \wrong bit length size: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bytes
{-# INLINE getBits #-}


--------------------------------------------------------------------------------
-- | Binary protocol encoder
putBinaryField :: MySQLValue -> Put
putBinaryField :: MySQLValue -> Put
putBinaryField (MySQLDecimal    Scientific
n) = ByteString -> Put
putLenEncBytes (ByteString -> Put) -> (Builder -> ByteString) -> Builder -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> Put) -> Builder -> Put
forall a b. (a -> b) -> a -> b
$
                                        FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
Fixed Maybe Int
forall a. Maybe a
Nothing Scientific
n
putBinaryField (MySQLInt8U      Word8
n) = Word8 -> Put
putWord8 Word8
n
putBinaryField (MySQLInt8       Int8
n) = Word8 -> Put
putWord8 (Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
n)
putBinaryField (MySQLInt16U     Word16
n) = Word16 -> Put
putWord16le Word16
n
putBinaryField (MySQLInt16      Int16
n) = Int16 -> Put
putInt16le Int16
n
putBinaryField (MySQLInt32U     Word32
n) = Word32 -> Put
putWord32le Word32
n
putBinaryField (MySQLInt32      Int32
n) = Int32 -> Put
putInt32le Int32
n
putBinaryField (MySQLInt64U     Word64
n) = Word64 -> Put
putWord64le Word64
n
putBinaryField (MySQLInt64      Int64
n) = Int64 -> Put
putInt64le Int64
n
putBinaryField (MySQLFloat      Float
x) = Float -> Put
putFloatle Float
x
putBinaryField (MySQLDouble     Double
x) = Double -> Put
putDoublele Double
x
putBinaryField (MySQLYear       Word16
n) = ByteString -> Put
putLenEncBytes (ByteString -> Put) -> (Builder -> ByteString) -> Builder -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> Put) -> Builder -> Put
forall a b. (a -> b) -> a -> b
$
                                        Word16 -> Builder
forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word16
n  -- this's really weird, it's not documented anywhere
                                                            -- we must encode year into string in binary mode!
putBinaryField (MySQLTimeStamp (LocalTime Day
date TimeOfDay
time)) = do Word8 -> Put
putWord8 Word8
11    -- always put full
                                                           Day -> Put
putBinaryDay Day
date
                                                           TimeOfDay -> Put
putBinaryTime' TimeOfDay
time
putBinaryField (MySQLDateTime  (LocalTime Day
date TimeOfDay
time)) = do Word8 -> Put
putWord8 Word8
11    -- always put full
                                                           Day -> Put
putBinaryDay Day
date
                                                           TimeOfDay -> Put
putBinaryTime' TimeOfDay
time
putBinaryField (MySQLDate    Day
d)    = do Word8 -> Put
putWord8 Word8
4
                                        Day -> Put
putBinaryDay Day
d
putBinaryField (MySQLTime Word8
sign TimeOfDay
t)  = do Word8 -> Put
putWord8 Word8
12    -- always put full
                                        Word8 -> Put
putWord8 Word8
sign
                                        TimeOfDay -> Put
putBinaryTime TimeOfDay
t
putBinaryField (MySQLGeometry ByteString
bs)  = ByteString -> Put
putLenEncBytes ByteString
bs
putBinaryField (MySQLBytes  ByteString
bs)    = ByteString -> Put
putLenEncBytes ByteString
bs
putBinaryField (MySQLBit    Word64
word)  = do Word8 -> Put
putWord8 Word8
8     -- always put full
                                        Word64 -> Put
putWord64be Word64
word
putBinaryField (MySQLText    Text
t)    = ByteString -> Put
putLenEncBytes (Text -> ByteString
T.encodeUtf8 Text
t)
putBinaryField MySQLValue
MySQLNull           = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putBinaryDay :: Day -> Put
putBinaryDay :: Day -> Put
putBinaryDay Day
d = do let (Integer
yyyy, Int
mm, Int
dd) = Day -> (Integer, Int, Int)
toGregorian Day
d
                    Word16 -> Put
putWord16le (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
yyyy)
                    Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mm)
                    Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dd)
{-# INLINE putBinaryDay #-}

putBinaryTime' :: TimeOfDay -> Put
putBinaryTime' :: TimeOfDay -> Put
putBinaryTime' (TimeOfDay Int
hh Int
mm Pico
ss) = do let s :: Word8
s = Pico -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
floor Pico
ss
                                             ms :: Word32
ms = Pico -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
floor (Pico -> Word32) -> Pico -> Word32
forall a b. (a -> b) -> a -> b
$ (Pico
ss Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
- Word8 -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word8
s) Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* Pico
1000000
                                         Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hh)
                                         Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mm)
                                         Word8 -> Put
putWord8 Word8
s
                                         Word32 -> Put
putWord32le Word32
ms
{-# INLINE putBinaryTime' #-}

putBinaryTime :: TimeOfDay -> Put
putBinaryTime :: TimeOfDay -> Put
putBinaryTime (TimeOfDay Int
hh Int
mm Pico
ss) = do let s :: Word8
s = Pico -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
floor Pico
ss
                                            ms :: Word32
ms = Pico -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
floor (Pico -> Word32) -> Pico -> Word32
forall a b. (a -> b) -> a -> b
$ (Pico
ss Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
- Word8 -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word8
s) Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* Pico
1000000
                                            (Int
d, Int
h) = Int
hh Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
24  -- hour may exceed 24 here
                                        Word32 -> Put
putWord32le (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
                                        Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
                                        Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mm)
                                        Word8 -> Put
putWord8 Word8
s
                                        Word32 -> Put
putWord32le Word32
ms
{-# INLINE putBinaryTime #-}

--------------------------------------------------------------------------------
-- | Binary row decoder
--
-- MySQL use a special null bitmap without offset = 2 here.
--
getBinaryRow :: [ColumnDef] -> Int -> Get [MySQLValue]
getBinaryRow :: [ColumnDef] -> Int -> Get [MySQLValue]
getBinaryRow [ColumnDef]
fields Int
flen = do
    Int -> Get ()
skipN Int
1           -- 0x00
    let maplen :: Int
maplen = (Int
flen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
    BitMap
nullmap <- ByteString -> BitMap
BitMap (ByteString -> BitMap) -> Get ByteString -> Get BitMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
maplen
    [ColumnDef] -> BitMap -> Int -> Get [MySQLValue]
go [ColumnDef]
fields BitMap
nullmap Int
0
  where
    go :: [ColumnDef] -> BitMap -> Int -> Get [MySQLValue]
    go :: [ColumnDef] -> BitMap -> Int -> Get [MySQLValue]
go []     BitMap
_       Int
_   = [MySQLValue] -> Get [MySQLValue]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go (ColumnDef
f:[ColumnDef]
fs) BitMap
nullmap Int
pos = do
        MySQLValue
r <- if BitMap -> Int -> Bool
isColumnNull BitMap
nullmap Int
pos
                then MySQLValue -> Get MySQLValue
forall (m :: * -> *) a. Monad m => a -> m a
return MySQLValue
MySQLNull
                else ColumnDef -> Get MySQLValue
getBinaryField ColumnDef
f
        let pos' :: Int
pos' = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        [MySQLValue]
rest <- Int
pos' Int -> Get [MySQLValue] -> Get [MySQLValue]
`seq` [ColumnDef] -> BitMap -> Int -> Get [MySQLValue]
go [ColumnDef]
fs BitMap
nullmap Int
pos'
        [MySQLValue] -> Get [MySQLValue]
forall (m :: * -> *) a. Monad m => a -> m a
return (MySQLValue
r MySQLValue -> [MySQLValue] -> [MySQLValue]
`seq` (MySQLValue
r MySQLValue -> [MySQLValue] -> [MySQLValue]
forall a. a -> [a] -> [a]
: [MySQLValue]
rest))
{-# INLINE getBinaryRow #-}

getBinaryRowVector :: V.Vector ColumnDef -> Int -> Get (V.Vector MySQLValue)
getBinaryRowVector :: Vector ColumnDef -> Int -> Get (Vector MySQLValue)
getBinaryRowVector Vector ColumnDef
fields Int
flen = do
    Int -> Get ()
skipN Int
1           -- 0x00
    let maplen :: Int
maplen = (Int
flen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
    BitMap
nullmap <- ByteString -> BitMap
BitMap (ByteString -> BitMap) -> Get ByteString -> Get BitMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
maplen
    ((Int -> ColumnDef -> Get MySQLValue)
-> Vector ColumnDef -> Get (Vector MySQLValue)
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
`V.imapM` Vector ColumnDef
fields) ((Int -> ColumnDef -> Get MySQLValue) -> Get (Vector MySQLValue))
-> (Int -> ColumnDef -> Get MySQLValue) -> Get (Vector MySQLValue)
forall a b. (a -> b) -> a -> b
$ \ Int
pos ColumnDef
f ->
        if BitMap -> Int -> Bool
isColumnNull BitMap
nullmap Int
pos then MySQLValue -> Get MySQLValue
forall (m :: * -> *) a. Monad m => a -> m a
return MySQLValue
MySQLNull else ColumnDef -> Get MySQLValue
getBinaryField ColumnDef
f
{-# INLINE getBinaryRowVector #-}

--------------------------------------------------------------------------------
-- | Use 'ByteString' to present a bitmap.
--
-- When used for represent bits values, the underlining 'ByteString' follows:
--
--  * byteString: head       -> tail
--  * bit:        high bit   -> low bit
--
-- When used as a null-map/present-map, every bit inside a byte
-- is mapped to a column, the mapping order is following:
--
--  * byteString: head -> tail
--  * column:     left -> right
--
-- We don't use 'Int64' here because there maybe more than 64 columns.
--
newtype BitMap = BitMap { BitMap -> ByteString
fromBitMap :: ByteString } deriving (BitMap -> BitMap -> Bool
(BitMap -> BitMap -> Bool)
-> (BitMap -> BitMap -> Bool) -> Eq BitMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitMap -> BitMap -> Bool
$c/= :: BitMap -> BitMap -> Bool
== :: BitMap -> BitMap -> Bool
$c== :: BitMap -> BitMap -> Bool
Eq, Int -> BitMap -> ShowS
[BitMap] -> ShowS
BitMap -> String
(Int -> BitMap -> ShowS)
-> (BitMap -> String) -> ([BitMap] -> ShowS) -> Show BitMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitMap] -> ShowS
$cshowList :: [BitMap] -> ShowS
show :: BitMap -> String
$cshow :: BitMap -> String
showsPrec :: Int -> BitMap -> ShowS
$cshowsPrec :: Int -> BitMap -> ShowS
Show)

-- | Test if a column is set(binlog protocol).
--
-- The number counts from left to right.
--
isColumnSet :: BitMap -> Int -> Bool
isColumnSet :: BitMap -> Int -> Bool
isColumnSet (BitMap ByteString
bitmap) Int
pos =
  let i :: Int
i = Int
pos Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3
      j :: Int
j = Int
pos Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
7
  in (ByteString
bitmap ByteString -> Int -> Word8
`B.unsafeIndex` Int
i) Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
j
{-# INLINE isColumnSet #-}

-- | Test if a column is null(binary protocol).
--
-- The number counts from left to right.
--
isColumnNull :: BitMap -> Int -> Bool
isColumnNull :: BitMap -> Int -> Bool
isColumnNull (BitMap ByteString
nullmap) Int
pos =
  let
    pos' :: Int
pos' = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    i :: Int
i    = Int
pos' Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3
    j :: Int
j    = Int
pos' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
7
  in (ByteString
nullmap ByteString -> Int -> Word8
`B.unsafeIndex` Int
i) Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
j
{-# INLINE isColumnNull #-}

-- | Make a nullmap for params(binary protocol) without offset.
--
makeNullMap :: [MySQLValue] -> BitMap
makeNullMap :: [MySQLValue] -> BitMap
makeNullMap [MySQLValue]
values = ByteString -> BitMap
BitMap (ByteString -> BitMap)
-> ([Word8] -> ByteString) -> [Word8] -> BitMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack ([Word8] -> BitMap) -> [Word8] -> BitMap
forall a b. (a -> b) -> a -> b
$ [MySQLValue] -> Word8 -> Int -> [Word8]
go [MySQLValue]
values Word8
0x00 Int
0
  where
    go :: [MySQLValue] -> Word8 -> Int -> [Word8]
    go :: [MySQLValue] -> Word8 -> Int -> [Word8]
go []             Word8
byte   Int
8  = [Word8
byte]
    go [MySQLValue]
vs             Word8
byte   Int
8  = Word8
byte Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [MySQLValue] -> Word8 -> Int -> [Word8]
go [MySQLValue]
vs Word8
0x00 Int
0
    go []             Word8
byte   Int
_  = [Word8
byte]
    go (MySQLValue
MySQLNull:[MySQLValue]
vs) Word8
byte Int
pos  = let pos' :: Int
pos' = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                                      byte' :: Word8
byte' = Word8
byte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int -> Word8
forall a. Bits a => Int -> a
bit Int
pos
                                  in Int
pos' Int -> [Word8] -> [Word8]
`seq` Word8
byte' Word8 -> [Word8] -> [Word8]
`seq` [MySQLValue] -> Word8 -> Int -> [Word8]
go [MySQLValue]
vs Word8
byte' Int
pos'
    go (MySQLValue
_        :[MySQLValue]
vs) Word8
byte Int
pos  = let pos' :: Int
pos' = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 in Int
pos' Int -> [Word8] -> [Word8]
`seq` [MySQLValue] -> Word8 -> Int -> [Word8]
go [MySQLValue]
vs Word8
byte Int
pos'

--------------------------------------------------------------------------------
-- TODO: add helpers to parse mySQLTypeGEOMETRY
-- reference: https://github.com/felixge/node-mysql/blob/master/lib/protocol/Parser.js