{-# 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MySQLValue] -> ShowS
$cshowList :: [MySQLValue] -> ShowS
show :: MySQLValue -> [Char]
$cshow :: MySQLValue -> [Char]
showsPrec :: Int -> MySQLValue -> ShowS
$cshowsPrec :: Int -> MySQLValue -> ShowS
Show, MySQLValue -> MySQLValue -> Bool
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. 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  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     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     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    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    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     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     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 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 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    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   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     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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLTimeStamp    LocalTime
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeTimestampforall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x00
putParamMySQLType (MySQLDate         Day
_)  = FieldType -> Put
putFieldType FieldType
mySQLTypeDate     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     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     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 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      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   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     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 forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNull            = forall (f :: * -> *) a. Applicative f => a -> f a
pure MySQLValue
MySQLNull
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDecimal
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDecimal = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Scientific -> MySQLValue
MySQLDecimal forall {b}. Fractional b => ByteString -> Maybe b
fracLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTiny            = if Bool
isUnsigned then forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word8 -> MySQLValue
MySQLInt8U forall {b}. Integral b => ByteString -> Maybe b
intLexer
                                                    else forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Int8 -> MySQLValue
MySQLInt8 forall {b}. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeShort           = if Bool
isUnsigned then forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word16 -> MySQLValue
MySQLInt16U forall {b}. Integral b => ByteString -> Maybe b
intLexer
                                                    else forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Int16 -> MySQLValue
MySQLInt16 forall {b}. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLong
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeInt24      = if Bool
isUnsigned then forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word32 -> MySQLValue
MySQLInt32U forall {b}. Integral b => ByteString -> Maybe b
intLexer
                                                    else forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Int32 -> MySQLValue
MySQLInt32 forall {b}. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLongLong        = if Bool
isUnsigned then forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word64 -> MySQLValue
MySQLInt64U forall {b}. Integral b => ByteString -> Maybe b
intLexer
                                                    else forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Int64 -> MySQLValue
MySQLInt64 forall {b}. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeFloat           = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Float -> MySQLValue
MySQLFloat forall {b}. Fractional b => ByteString -> Maybe b
fracLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDouble          = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Double -> MySQLValue
MySQLDouble forall {b}. Fractional b => ByteString -> Maybe b
fracLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeYear            = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Word16 -> MySQLValue
MySQLYear forall {b}. Integral b => ByteString -> Maybe b
intLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp2 = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t LocalTime -> MySQLValue
MySQLTimeStamp forall a b. (a -> b) -> a -> b
$ \ ByteString
bs ->
                                          Day -> TimeOfDay -> LocalTime
LocalTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Day
dateParser ByteString
bs 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 forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime2  = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t LocalTime -> MySQLValue
MySQLDateTime forall a b. (a -> b) -> a -> b
$ \ ByteString
bs ->
                                          Day -> TimeOfDay -> LocalTime
LocalTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Day
dateParser ByteString
bs 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 forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDate
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDate    = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Day -> MySQLValue
MySQLDate ByteString -> Maybe Day
dateParser
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime2      = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ \ ByteString
bs ->
                                          if ByteString
bs ByteString -> Int -> Word8
`B.unsafeIndex` Int
0 forall a. Eq a => a -> a -> Bool
== Word8
45  -- '-'
                                               then Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
1 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe TimeOfDay
timeParser ByteString
bs

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

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

    | Bool
otherwise                     = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.Protocol.MySQLValue: missing text decoder for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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 forall a. Eq a => a -> a -> Bool
/= Word16
63
    intLexer :: ByteString -> Maybe b
intLexer ByteString
bs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
LexInt.readSigned forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal ByteString
bs
    fracLexer :: ByteString -> Maybe b
fracLexer ByteString
bs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
LexFrac.readSigned forall a. Fractional a => ByteString -> Maybe (a, ByteString)
LexFrac.readDecimal ByteString
bs
    dateParser :: ByteString -> Maybe Day
dateParser ByteString
bs = do
        (Year
yyyy, ByteString
rest) <- forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal ByteString
bs
        (Int
mm, ByteString
rest') <- forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal (ByteString -> ByteString
B.unsafeTail ByteString
rest)
        (Int
dd, ByteString
_) <- forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal (ByteString -> ByteString
B.unsafeTail ByteString
rest')
        forall (m :: * -> *) a. Monad m => a -> m a
return (Year -> Int -> Int -> Day
fromGregorian Year
yyyy Int
mm Int
dd)

    timeParser :: ByteString -> Maybe TimeOfDay
timeParser ByteString
bs = do
        (Int
hh, ByteString
rest) <- forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal ByteString
bs
        (Int
mm, ByteString
rest') <- forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readDecimal (ByteString -> ByteString
B.unsafeTail ByteString
rest)
        (Pico
ss, ByteString
_) <- forall a. Fractional a => ByteString -> Maybe (a, ByteString)
LexFrac.readDecimal (ByteString -> ByteString
B.unsafeTail ByteString
rest')
        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 :: forall t b.
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (t -> b
con t
v)
        Maybe t
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.Protocol.MySQLValue: parsing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FieldType
typ forall a. [a] -> [a] -> [a]
++ [Char]
" failed, \
                          \input: " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
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 forall a. Maybe a
Nothing Scientific
n)
putTextField (MySQLInt8U      Word8
n) = Builder -> Put
putBuilder (forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word8
n)
putTextField (MySQLInt8       Int8
n) = Builder -> Put
putBuilder (forall a. (Integral a, Show a) => a -> Builder
Textual.integral Int8
n)
putTextField (MySQLInt16U     Word16
n) = Builder -> Put
putBuilder (forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word16
n)
putTextField (MySQLInt16      Int16
n) = Builder -> Put
putBuilder (forall a. (Integral a, Show a) => a -> Builder
Textual.integral Int16
n)
putTextField (MySQLInt32U     Word32
n) = Builder -> Put
putBuilder (forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word32
n)
putTextField (MySQLInt32      Int32
n) = Builder -> Put
putBuilder (forall a. (Integral a, Show a) => a -> Builder
Textual.integral Int32
n)
putTextField (MySQLInt64U     Word64
n) = Builder -> Put
putBuilder (forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word64
n)
putTextField (MySQLInt64      Int64
n) = Builder -> Put
putBuilder (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 (forall a. (Integral a, Show a) => a -> Builder
Textual.integral Word16
n)
putTextField (MySQLDateTime  LocalTime
dt) = Put -> Put
putInQuotes forall a b. (a -> b) -> a -> b
$
                                      ByteString -> Put
putByteString ([Char] -> ByteString
BC.pack (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%F %T%Q" LocalTime
dt))
putTextField (MySQLTimeStamp LocalTime
dt) = Put -> Put
putInQuotes forall a b. (a -> b) -> a -> b
$
                                      ByteString -> Put
putByteString ([Char] -> ByteString
BC.pack (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%F %T%Q" LocalTime
dt))
putTextField (MySQLDate       Day
d) = Put -> Put
putInQuotes forall a b. (a -> b) -> a -> b
$
                                      ByteString -> Put
putByteString ([Char] -> ByteString
BC.pack (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%F" Day
d))
putTextField (MySQLTime  Word8
sign TimeOfDay
t) = Put -> Put
putInQuotes forall a b. (a -> b) -> a -> b
$ do
                                      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign forall a. Eq a => a -> a -> Bool
== Word8
1) (Char -> Put
putCharUtf8 Char
'-')
                                      ByteString -> Put
putByteString ([Char] -> ByteString
BC.pack (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%T%Q" TimeOfDay
t))
                                      -- this works even for hour > 24
putTextField (MySQLGeometry  ByteString
bs) = Put -> Put
putInQuotes forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
escapeBytes forall a b. (a -> b) -> a -> b
$ ByteString
bs
putTextField (MySQLBytes     ByteString
bs) = Put -> Put
putInQuotes forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
escapeBytes forall a b. (a -> b) -> a -> b
$ ByteString
bs
putTextField (MySQLText       Text
t) = Put -> Put
putInQuotes forall a b. (a -> b) -> a -> b
$
                                      ByteString -> Put
putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeText forall a b. (a -> b) -> a -> b
$ Text
t
putTextField (MySQLBit        Word64
b) = do Builder -> Put
putBuilder Builder
"b\'"
                                      Builder -> Put
putBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PutM a -> Builder
execPut 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
63,Int
62..Int
0] forall a b. (a -> b) -> a -> b
$ \ Int
pos ->
            if Word64
word 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
'\'' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
p 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ColumnDef]
fs forall a b. (a -> b) -> a -> b
$ \ ColumnDef
f -> do
    Word8
p <- Get Word8
peek
    if Word8
p forall a. Eq a => a -> a -> Bool
== Word8
0xFB
    then Int -> Get ()
skipN Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector ColumnDef
fs forall a b. (a -> b) -> a -> b
$ \ ColumnDef
f -> do
    Word8
p <- Get Word8
peek
    if Word8
p forall a. Eq a => a -> a -> Bool
== Word8
0xFB
    then Int -> Get ()
skipN Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNull              = forall (f :: * -> *) a. Applicative f => a -> f a
pure MySQLValue
MySQLNull
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDecimal
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDecimal   = forall t b.
FieldType -> (t -> b) -> (ByteString -> Maybe t) -> Get b
feedLenEncBytes FieldType
t Scientific -> MySQLValue
MySQLDecimal forall {b}. Fractional b => ByteString -> Maybe b
fracLexer
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTiny              = if Bool
isUnsigned then Word8 -> MySQLValue
MySQLInt8U forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
                                                      else Int8 -> MySQLValue
MySQLInt8  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeShort             = if Bool
isUnsigned then Word16 -> MySQLValue
MySQLInt16U forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
                                                      else Int16 -> MySQLValue
MySQLInt16  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16le
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLong
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeInt24        = if Bool
isUnsigned then Word32 -> MySQLValue
MySQLInt32U forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
                                                      else Int32 -> MySQLValue
MySQLInt32  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32le
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeYear              = Word16 -> MySQLValue
MySQLYear forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLongLong          = if Bool
isUnsigned then Word64 -> MySQLValue
MySQLInt64U forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
                                                      else Int64 -> MySQLValue
MySQLInt64  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeFloat             = Float -> MySQLValue
MySQLFloat  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloatle
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDouble            = Double -> MySQLValue
MySQLDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDoublele
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp2   = do
            Int
n <- Get Int
getLenEncInt
            case Int
n of
               Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLTimeStamp (Day -> TimeOfDay -> LocalTime
LocalTime (Year -> Int -> Int -> Day
fromGregorian Year
0 Int
0 Int
0) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0))
               Int
4 -> do
                   Day
d <- Year -> Int -> Int -> Day
fromGregorian forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Year
getYear forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <- Year -> Int -> Int -> Day
fromGregorian forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Year
getYear forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   TimeOfDay
td <- Int -> Int -> Pico -> TimeOfDay
TimeOfDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond4
                   forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLTimeStamp (Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
td)
               Int
11 -> do
                   Day
d <- Year -> Int -> Int -> Day
fromGregorian forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Year
getYear forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   TimeOfDay
td <- Int -> Int -> Pico -> TimeOfDay
TimeOfDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond8
                   forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLTimeStamp (Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
td)
               Int
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Database.MySQL.Protocol.MySQLValue: wrong TIMESTAMP length"
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime2    = do
            Int
n <- Get Int
getLenEncInt
            case Int
n of
               Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLDateTime (Day -> TimeOfDay -> LocalTime
LocalTime (Year -> Int -> Int -> Day
fromGregorian Year
0 Int
0 Int
0) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0))
               Int
4 -> do
                   Day
d <- Year -> Int -> Int -> Day
fromGregorian forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Year
getYear forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <- Year -> Int -> Int -> Day
fromGregorian forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Year
getYear forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   TimeOfDay
td <- Int -> Int -> Pico -> TimeOfDay
TimeOfDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond4
                   forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLDateTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
td)
               Int
11 -> do
                   Day
d <- Year -> Int -> Int -> Day
fromGregorian forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Year
getYear forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8'
                   TimeOfDay
td <- Int -> Int -> Pico -> TimeOfDay
TimeOfDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond8
                   forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LocalTime -> MySQLValue
MySQLDateTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
td)
               Int
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Database.MySQL.Protocol.MySQLValue: wrong DATETIME length"

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

    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime2        = do
            Int
n <- Get Int
getLenEncInt
            case Int
n of
               Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int
dforall a. Num a => a -> a -> a
*Int
24 forall a. Num a => a -> a -> a
+ Int
h) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int
dforall a. Num a => a -> a -> a
*Int
24 forall a. Num a => a -> a -> a
+ Int
h) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt8' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Pico
getSecond8)
               Int
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Database.MySQL.Protocol.MySQLValue: wrong TIME length"

    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeGeometry          = ByteString -> MySQLValue
MySQLGeometry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenEncBytes
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarChar
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeEnum
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeSet
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTinyBlob
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeMediumBlob
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLongBlob
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBlob
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarString
        Bool -> Bool -> Bool
|| FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString       = if Bool
isText then Text -> MySQLValue
MySQLText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenEncBytes
                                                  else ByteString -> MySQLValue
MySQLBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenEncBytes
    | FieldType
t forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBit               = Word64 -> MySQLValue
MySQLBit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get Word64
getBits forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Int
getLenEncInt)
    | Bool
otherwise                       = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.Protocol.MySQLValue:\
                                               \ missing binary decoder for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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 forall a. Eq a => a -> a -> Bool
/= Word16
63
    fracLexer :: ByteString -> Maybe b
fracLexer ByteString
bs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
LexFrac.readSigned forall a. Fractional a => ByteString -> Maybe (a, ByteString)
LexFrac.readDecimal ByteString
bs
    getYear :: Get Integer
    getYear :: Get Year
getYear = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    getInt8' :: Get Int
    getInt8' :: Get Int
getInt8' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    getSecond4 :: Get Pico
    getSecond4 :: Get Pico
getSecond4 = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    getSecond8 :: Get Pico
    getSecond8 :: Get Pico
getSecond8 = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Int
s <- Get Int
getInt8'
        Int
ms <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le :: Get Int
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! (forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
s forall a. Num a => a -> a -> a
+ forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
ms 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 forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
bytes forall a. Eq a => a -> a -> Bool
== Int
1 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        | Int
bytes forall a. Eq a => a -> a -> Bool
== Int
2 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
        | Int
bytes forall a. Eq a => a -> a -> Bool
== Int
3 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word24
getWord24be
        | Int
bytes forall a. Eq a => a -> a -> Bool
== Int
4 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
        | Int
bytes forall a. Eq a => a -> a -> Bool
== Int
5 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord40be
        | Int
bytes forall a. Eq a => a -> a -> Bool
== Int
6 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord48be
        | Int
bytes forall a. Eq a => a -> a -> Bool
== Int
7 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord56be
        | Int
bytes forall a. Eq a => a -> a -> Bool
== Int
8 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
        | Bool
otherwise  -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$  [Char]
"Database.MySQL.Protocol.MySQLValue: \
                                \wrong bit length size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
bytes
{-# INLINE getBits #-}


--------------------------------------------------------------------------------
-- | Binary protocol encoder
putBinaryField :: MySQLValue -> Put
putBinaryField :: MySQLValue -> Put
putBinaryField (MySQLDecimal    Scientific
n) = ByteString -> Put
putLenEncBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall a b. (a -> b) -> a -> b
$
                                        FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
Fixed forall a. Maybe a
Nothing Scientific
n
putBinaryField (MySQLInt8U      Word8
n) = Word8 -> Put
putWord8 Word8
n
putBinaryField (MySQLInt8       Int8
n) = Word8 -> Put
putWord8 (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall a b. (a -> b) -> a -> b
$
                                        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           = forall (m :: * -> *) a. Monad m => a -> m a
return ()

putBinaryDay :: Day -> Put
putBinaryDay :: Day -> Put
putBinaryDay Day
d = do let (Year
yyyy, Int
mm, Int
dd) = Day -> (Year, Int, Int)
toGregorian Day
d
                    Word16 -> Put
putWord16le (forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
yyyy)
                    Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mm)
                    Word8 -> Put
putWord8 (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 = forall a b. (RealFrac a, Integral b) => a -> b
floor Pico
ss
                                             ms :: Word32
ms = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (Pico
ss forall a. Num a => a -> a -> a
- forall a b. (Real a, Fractional b) => a -> b
realToFrac Word8
s) forall a. Num a => a -> a -> a
* Pico
1000000
                                         Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hh)
                                         Word8 -> Put
putWord8 (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 = forall a b. (RealFrac a, Integral b) => a -> b
floor Pico
ss
                                            ms :: Word32
ms = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (Pico
ss forall a. Num a => a -> a -> a
- forall a b. (Real a, Fractional b) => a -> b
realToFrac Word8
s) forall a. Num a => a -> a -> a
* Pico
1000000
                                            (Int
d, Int
h) = Int
hh forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
24  -- hour may exceed 24 here
                                        Word32 -> Put
putWord32le (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
                                        Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
                                        Word8 -> Put
putWord8 (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 forall a. Num a => a -> a -> a
+ Int
7 forall a. Num a => a -> a -> a
+ Int
2) forall a. Bits a => a -> Int -> a
`shiftR` Int
3
    BitMap
nullmap <- ByteString -> BitMap
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
_   = 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 forall (m :: * -> *) a. Monad m => a -> m a
return MySQLValue
MySQLNull
                else ColumnDef -> Get MySQLValue
getBinaryField ColumnDef
f
        let pos' :: Int
pos' = Int
pos forall a. Num a => a -> a -> a
+ Int
1
        [MySQLValue]
rest <- Int
pos' seq :: forall a b. a -> b -> b
`seq` [ColumnDef] -> BitMap -> Int -> Get [MySQLValue]
go [ColumnDef]
fs BitMap
nullmap Int
pos'
        forall (m :: * -> *) a. Monad m => a -> m a
return (MySQLValue
r seq :: forall a b. a -> b -> b
`seq` (MySQLValue
r 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 forall a. Num a => a -> a -> a
+ Int
7 forall a. Num a => a -> a -> a
+ Int
2) forall a. Bits a => a -> Int -> a
`shiftR` Int
3
    BitMap
nullmap <- ByteString -> BitMap
BitMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
maplen
    (forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
`V.imapM` Vector ColumnDef
fields) forall a b. (a -> b) -> a -> b
$ \ Int
pos ColumnDef
f ->
        if BitMap -> Int -> Bool
isColumnNull BitMap
nullmap Int
pos then 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
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BitMap] -> ShowS
$cshowList :: [BitMap] -> ShowS
show :: BitMap -> [Char]
$cshow :: BitMap -> [Char]
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 forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3
      j :: Int
j = Int
pos forall a. Bits a => a -> a -> a
.&. Int
7
  in (ByteString
bitmap ByteString -> Int -> Word8
`B.unsafeIndex` Int
i) 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 forall a. Num a => a -> a -> a
+ Int
2
    i :: Int
i    = Int
pos' forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3
    j :: Int
j    = Int
pos' forall a. Bits a => a -> a -> a
.&. Int
7
  in (ByteString
nullmap ByteString -> Int -> Word8
`B.unsafeIndex` Int
i) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack 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 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 forall a. Num a => a -> a -> a
+ Int
1
                                      byte' :: Word8
byte' = Word8
byte forall a. Bits a => a -> a -> a
.|. forall a. Bits a => Int -> a
bit Int
pos
                                  in Int
pos' seq :: forall a b. a -> b -> b
`seq` Word8
byte' seq :: forall a b. a -> b -> b
`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 forall a. Num a => a -> a -> a
+ Int
1 in Int
pos' seq :: forall a b. a -> b -> b
`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