{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC
  -Wno-orphans
#-}

module ClickHaskell.DeSerialization where

-- Internal dependencies
import ClickHaskell.Versioning (ProtocolRevision(..), SinceRevision (..), DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION, afterRevision)
import ClickHaskell.DbTypes

-- GHC included
import Control.Monad (forM, replicateM)
import Data.Binary.Get
import Data.Binary.Get.Internal (readN)
import Data.Binary.Put
import Data.Bits (Bits (..))
import Data.ByteString as BS (length, take)
import Data.ByteString.Builder (Builder, word8)
import Data.Coerce (coerce)
import Data.Typeable (Proxy (..))
import GHC.Generics
import GHC.TypeLits (ErrorMessage (..), KnownNat, TypeError, natVal)
import Debug.Trace (traceShowId)

-- * Deserialization

class
  Deserializable chType
  where
  default deserialize :: (Generic chType, GDeserializable (Rep chType)) => ProtocolRevision -> Get chType
  deserialize :: ProtocolRevision -> Get chType
  deserialize ProtocolRevision
rev = Rep chType Any -> chType
forall a x. Generic a => Rep a x -> a
forall x. Rep chType x -> chType
to (Rep chType Any -> chType) -> Get (Rep chType Any) -> Get chType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (Rep chType Any)
forall p. ProtocolRevision -> Get (Rep chType p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev


-- ** Generics

class GDeserializable f
  where
  gDeserialize :: ProtocolRevision -> Get (f p)

instance
  GDeserializable f
  =>
  GDeserializable (D1 c (C1 c2 f))
  where
  {-# INLINE gDeserialize #-}
  gDeserialize :: forall p. ProtocolRevision -> Get (D1 c (C1 c2 f) p)
gDeserialize ProtocolRevision
rev = C1 c2 f p -> M1 D c (C1 c2 f) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (C1 c2 f p -> M1 D c (C1 c2 f) p)
-> (f p -> C1 c2 f p) -> f p -> M1 D c (C1 c2 f) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f p -> C1 c2 f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D c (C1 c2 f) p)
-> Get (f p) -> Get (M1 D c (C1 c2 f) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (f p)
forall p. ProtocolRevision -> Get (f p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev

instance
  GDeserializable (left :*: (right1 :*: right2))
  =>
  GDeserializable ((left :*: right1) :*: right2)
  where
  {-# INLINE gDeserialize #-}
  gDeserialize :: forall p.
ProtocolRevision -> Get ((:*:) (left :*: right1) right2 p)
gDeserialize ProtocolRevision
rev = (\(left p
l :*: (right1 p
r1 :*: right2 p
r2)) -> (left p
l left p -> right1 p -> (:*:) left right1 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: right1 p
r1) (:*:) left right1 p -> right2 p -> (:*:) (left :*: right1) right2 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: right2 p
r2) ((:*:) left (right1 :*: right2) p
 -> (:*:) (left :*: right1) right2 p)
-> Get ((:*:) left (right1 :*: right2) p)
-> Get ((:*:) (left :*: right1) right2 p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ((:*:) left (right1 :*: right2) p)
forall p.
ProtocolRevision -> Get ((:*:) left (right1 :*: right2) p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev

instance
  (GDeserializable (S1 metaSel field), GDeserializable right)
  =>
  GDeserializable (S1 metaSel field :*: right)
  where
  {-# INLINE gDeserialize #-}
  gDeserialize :: forall p.
ProtocolRevision -> Get ((:*:) (S1 metaSel field) right p)
gDeserialize ProtocolRevision
rev = S1 metaSel field p -> right p -> (:*:) (S1 metaSel field) right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (S1 metaSel field p -> right p -> (:*:) (S1 metaSel field) right p)
-> Get (S1 metaSel field p)
-> Get (right p -> (:*:) (S1 metaSel field) right p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (S1 metaSel field p)
forall p. ProtocolRevision -> Get (S1 metaSel field p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev Get (right p -> (:*:) (S1 metaSel field) right p)
-> Get (right p) -> Get ((:*:) (S1 metaSel field) right p)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolRevision -> Get (right p)
forall p. ProtocolRevision -> Get (right p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev

instance
  Deserializable chType
  =>
  GDeserializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType))
  where
  {-# INLINE gDeserialize #-}
  gDeserialize :: forall p.
ProtocolRevision
-> Get (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p)
gDeserialize ProtocolRevision
rev =  Rec0 chType p
-> M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 chType p
 -> M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p)
-> (chType -> Rec0 chType p)
-> chType
-> M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> Rec0 chType p
forall k i c (p :: k). c -> K1 i c p
K1 (chType -> M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p)
-> Get chType
-> Get (M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev


-- ** Versioning

instance
  ( KnownNat revision
  , Deserializable chType
  )
  =>
  Deserializable (SinceRevision chType revision)
  where
  deserialize :: ProtocolRevision -> Get (SinceRevision chType revision)
deserialize ProtocolRevision
rev =
    if ProtocolRevision
rev ProtocolRevision -> ProtocolRevision -> Bool
forall a. Ord a => a -> a -> Bool
>= (Integer -> ProtocolRevision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ProtocolRevision)
-> (Proxy revision -> Integer)
-> Proxy revision
-> ProtocolRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy revision -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal) (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @revision)
    then chType -> SinceRevision chType revision
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision (chType -> SinceRevision chType revision)
-> Get chType -> Get (SinceRevision chType revision)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev
    else SinceRevision chType revision
-> Get (SinceRevision chType revision)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SinceRevision chType revision
forall a (revisionNumber :: Nat). SinceRevision a revisionNumber
NotPresented

instance Deserializable ProtocolRevision where
  deserialize :: ProtocolRevision -> Get ProtocolRevision
deserialize ProtocolRevision
rev = UVarInt -> ProtocolRevision
forall a b. Coercible a b => a -> b
coerce (UVarInt -> ProtocolRevision)
-> Get UVarInt -> Get ProtocolRevision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev


-- ** Database types

instance Deserializable ChUUID where
  deserialize :: ProtocolRevision -> Get ChUUID
deserialize ProtocolRevision
_ = Word128 -> ChUUID
MkChUUID (Word128 -> ChUUID) -> Get Word128 -> Get ChUUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128 (Word64 -> Word64 -> Word128)
-> Get Word64 -> Get (Word64 -> Word128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le Get (Word64 -> Word128) -> Get Word64 -> Get Word128
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le)

instance Deserializable ChString where
  deserialize :: ProtocolRevision -> Get ChString
deserialize ProtocolRevision
rev = do
    Int
strSize <- UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UVarInt -> Int) -> Get UVarInt -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    ByteString -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (ByteString -> ChString) -> Get ByteString -> Get ChString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
strSize (Int -> ByteString -> ByteString
BS.take Int
strSize)


instance Deserializable ChInt8 where deserialize :: ProtocolRevision -> Get ChInt8
deserialize ProtocolRevision
_ = Int8 -> ChInt8
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int8 -> ChInt8) -> Get Int8 -> Get ChInt8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
instance Deserializable ChInt16 where deserialize :: ProtocolRevision -> Get ChInt16
deserialize ProtocolRevision
_ = Int16 -> ChInt16
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int16 -> ChInt16) -> Get Int16 -> Get ChInt16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16le
instance Deserializable ChInt32 where deserialize :: ProtocolRevision -> Get ChInt32
deserialize ProtocolRevision
_ = Int32 -> ChInt32
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int32 -> ChInt32) -> Get Int32 -> Get ChInt32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32le
instance Deserializable ChInt64 where deserialize :: ProtocolRevision -> Get ChInt64
deserialize ProtocolRevision
_ = Int64 -> ChInt64
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int64 -> ChInt64) -> Get Int64 -> Get ChInt64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
instance Deserializable ChInt128 where deserialize :: ProtocolRevision -> Get ChInt128
deserialize ProtocolRevision
_ = Int128 -> ChInt128
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int128 -> ChInt128) -> Get Int128 -> Get ChInt128
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word64 -> Word64 -> Int128) -> Word64 -> Word64 -> Int128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Int128
Int128 (Word64 -> Word64 -> Int128)
-> Get Word64 -> Get (Word64 -> Int128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le Get (Word64 -> Int128) -> Get Word64 -> Get Int128
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le)
instance Deserializable ChUInt8 where deserialize :: ProtocolRevision -> Get ChUInt8
deserialize ProtocolRevision
_ = Word8 -> ChUInt8
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word8 -> ChUInt8) -> Get Word8 -> Get ChUInt8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
instance Deserializable ChUInt16 where deserialize :: ProtocolRevision -> Get ChUInt16
deserialize ProtocolRevision
_ = Word16 -> ChUInt16
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word16 -> ChUInt16) -> Get Word16 -> Get ChUInt16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
instance Deserializable ChUInt32 where deserialize :: ProtocolRevision -> Get ChUInt32
deserialize ProtocolRevision
_ = Word32 -> ChUInt32
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word32 -> ChUInt32) -> Get Word32 -> Get ChUInt32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
instance Deserializable ChUInt64 where deserialize :: ProtocolRevision -> Get ChUInt64
deserialize ProtocolRevision
_ = Word64 -> ChUInt64
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word64 -> ChUInt64) -> Get Word64 -> Get ChUInt64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
instance Deserializable ChUInt128 where deserialize :: ProtocolRevision -> Get ChUInt128
deserialize ProtocolRevision
_ = Word128 -> ChUInt128
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word128 -> ChUInt128) -> Get Word128 -> Get ChUInt128
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128 (Word64 -> Word64 -> Word128)
-> Get Word64 -> Get (Word64 -> Word128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le Get (Word64 -> Word128) -> Get Word64 -> Get Word128
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le)
instance Deserializable ChDateTime where deserialize :: ProtocolRevision -> Get ChDateTime
deserialize ProtocolRevision
_ = Word32 -> ChDateTime
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word32 -> ChDateTime) -> Get Word32 -> Get ChDateTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
instance Deserializable ChDate where deserialize :: ProtocolRevision -> Get ChDate
deserialize ProtocolRevision
_ = Word16 -> ChDate
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word16 -> ChDate) -> Get Word16 -> Get ChDate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le

instance Deserializable UVarInt where
  deserialize :: ProtocolRevision -> Get UVarInt
deserialize ProtocolRevision
_ = Int -> UVarInt -> Get UVarInt
forall {a}. (Bits a, Num a) => Int -> a -> Get a
go Int
0 (UVarInt
0 :: UVarInt)
    where
    go :: Int -> a -> Get a
go Int
i a
o | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = do
      Word8
byte <- Get Word8
getWord8
      let o' :: a
o' = a
o a -> a -> a
forall a. Bits a => a -> a -> a
.|. ((Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7f) a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i))
      if Word8
byte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then a -> Get a
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! a
o' else Int -> a -> Get a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! a
o'
    go Int
_ a
_ = String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"input exceeds varuint size"


-- ** Raw columns deserialization

class DeserializableColumns columns where
  deserializeRawColumns :: ProtocolRevision -> UVarInt -> Get columns

instance
  DeserializableColumns (Columns '[])
  where
  {-# INLINE deserializeRawColumns #-}
  deserializeRawColumns :: ProtocolRevision -> UVarInt -> Get (Columns '[])
deserializeRawColumns ProtocolRevision
_rev UVarInt
_rows = Columns '[] -> Get (Columns '[])
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Columns '[]
Empty

instance 
  ( KnownColumn (Column name chType)
  , DeserializableColumn (Column name chType)
  , DeserializableColumns (Columns extraColumns)
  )
  =>
  DeserializableColumns (Columns (Column name chType ': extraColumns))
  where
  {-# INLINE deserializeRawColumns #-}
  deserializeRawColumns :: ProtocolRevision
-> UVarInt -> Get (Columns (Column name chType : extraColumns))
deserializeRawColumns ProtocolRevision
rev UVarInt
rows =
    Column name chType
-> Columns extraColumns
-> Columns (Column name chType : extraColumns)
forall (name :: Symbol) chType (columns1 :: [*]).
KnownColumn (Column name chType) =>
Column name chType
-> Columns columns1 -> Columns (Column name chType : columns1)
AddColumn
      (Column name chType
 -> Columns extraColumns
 -> Columns (Column name chType : extraColumns))
-> Get (Column name chType)
-> Get
     (Columns extraColumns
      -> Columns (Column name chType : extraColumns))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> UVarInt -> Get (Column name chType)
forall column.
DeserializableColumn column =>
ProtocolRevision -> UVarInt -> Get column
deserializeColumn ProtocolRevision
rev UVarInt
rows
      Get
  (Columns extraColumns
   -> Columns (Column name chType : extraColumns))
-> Get (Columns extraColumns)
-> Get (Columns (Column name chType : extraColumns))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall columns.
DeserializableColumns columns =>
ProtocolRevision -> UVarInt -> Get columns
deserializeRawColumns @(Columns extraColumns) ProtocolRevision
rev UVarInt
rows


-- ** Column deserialization

{-# SPECIALIZE replicateM :: Int -> Get chType -> Get [chType] #-}

class DeserializableColumn column where
  deserializeColumn :: ProtocolRevision -> UVarInt -> Get column

instance
  ( KnownColumn (Column name chType)
  , Deserializable chType
  ) =>
  DeserializableColumn (Column name chType) where
  deserializeColumn :: ProtocolRevision -> UVarInt -> Get (Column name chType)
deserializeColumn ProtocolRevision
rev UVarInt
rows = do
    ChString
_columnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    ChString
_columnType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
    [chType]
column <- Int -> Get chType -> Get [chType]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
    Column
  (GetColumnName (Column name chType))
  (GetColumnType (Column name chType))
-> Get
     (Column
        (GetColumnName (Column name chType))
        (GetColumnType (Column name chType)))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column
   (GetColumnName (Column name chType))
   (GetColumnType (Column name chType))
 -> Get
      (Column
         (GetColumnName (Column name chType))
         (GetColumnType (Column name chType))))
-> Column
     (GetColumnName (Column name chType))
     (GetColumnType (Column name chType))
-> Get
     (Column
        (GetColumnName (Column name chType))
        (GetColumnType (Column name chType)))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
UVarInt
-> [GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name chType) UVarInt
rows [chType]
[GetColumnType (Column name chType)]
column

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Nullable chType))
  , Deserializable chType
  ) =>
  DeserializableColumn (Column name (Nullable chType)) where
  deserializeColumn :: ProtocolRevision -> UVarInt -> Get (Column name (Nullable chType))
deserializeColumn ProtocolRevision
rev UVarInt
rows = do
    ChString
_columnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    ChString
_columnType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
    [ChUInt8]
nulls <- Int -> Get ChUInt8 -> Get [ChUInt8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChUInt8 ProtocolRevision
rev)
    [Nullable chType]
nullable <-
      [ChUInt8]
-> (ChUInt8 -> Get (Nullable chType)) -> Get [Nullable chType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
        [ChUInt8]
nulls
        (\case
          ChUInt8
0 -> chType -> Nullable chType
forall a. a -> Maybe a
Just (chType -> Nullable chType) -> Get chType -> Get (Nullable chType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev
          ChUInt8
_ -> (Nullable chType
forall a. Maybe a
Nothing Nullable chType -> Get chType -> Get (Nullable chType)
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
        )
    Column
  (GetColumnName (Column name (Nullable chType)))
  (GetColumnType (Column name (Nullable chType)))
-> Get
     (Column
        (GetColumnName (Column name (Nullable chType)))
        (GetColumnType (Column name (Nullable chType))))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column
   (GetColumnName (Column name (Nullable chType)))
   (GetColumnType (Column name (Nullable chType)))
 -> Get
      (Column
         (GetColumnName (Column name (Nullable chType)))
         (GetColumnType (Column name (Nullable chType)))))
-> Column
     (GetColumnName (Column name (Nullable chType)))
     (GetColumnType (Column name (Nullable chType)))
-> Get
     (Column
        (GetColumnName (Column name (Nullable chType)))
        (GetColumnType (Column name (Nullable chType))))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
UVarInt
-> [GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (Nullable chType)) UVarInt
rows [Nullable chType]
[GetColumnType (Column name (Nullable chType))]
nullable

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (LowCardinality chType))
  , Deserializable chType
  , ToChType (LowCardinality chType) chType
  , IsLowCardinalitySupported chType
  , TypeError ('Text "LowCardinality deserialization still unsupported")
  ) =>
  DeserializableColumn (Column name (LowCardinality chType)) where
  deserializeColumn :: ProtocolRevision
-> UVarInt -> Get (Column name (LowCardinality chType))
deserializeColumn ProtocolRevision
rev UVarInt
rows = do
    ChString
_columnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    ChString
_columnType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
    ChUInt64
_serializationType <- (ChUInt64 -> ChUInt64 -> ChUInt64
forall a. Bits a => a -> a -> a
.&. ChUInt64
0xf) (ChUInt64 -> ChUInt64) -> Get ChUInt64 -> Get ChUInt64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChUInt64 ProtocolRevision
rev
    ChInt64
_index_size <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChInt64 ProtocolRevision
rev
    -- error $ "Trace | " <> show _serializationType <> " : " <> show _index_size
    [LowCardinality chType]
lc <- Int -> Get (LowCardinality chType) -> Get [LowCardinality chType]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (chType -> LowCardinality chType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (chType -> LowCardinality chType)
-> Get chType -> Get (LowCardinality chType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
    Column
  (GetColumnName (Column name (LowCardinality chType)))
  (GetColumnType (Column name (LowCardinality chType)))
-> Get
     (Column
        (GetColumnName (Column name (LowCardinality chType)))
        (GetColumnType (Column name (LowCardinality chType))))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column
   (GetColumnName (Column name (LowCardinality chType)))
   (GetColumnType (Column name (LowCardinality chType)))
 -> Get
      (Column
         (GetColumnName (Column name (LowCardinality chType)))
         (GetColumnType (Column name (LowCardinality chType)))))
-> Column
     (GetColumnName (Column name (LowCardinality chType)))
     (GetColumnType (Column name (LowCardinality chType)))
-> Get
     (Column
        (GetColumnName (Column name (LowCardinality chType)))
        (GetColumnType (Column name (LowCardinality chType))))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
UVarInt
-> [GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (LowCardinality chType)) UVarInt
rows [GetColumnType (Column name (LowCardinality chType))]
[LowCardinality chType]
lc

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (ChArray chType))
  , Deserializable chType
  , TypeError ('Text "Arrays deserialization still unsupported")
  )
  => DeserializableColumn (Column name (ChArray chType)) where
  deserializeColumn :: ProtocolRevision -> UVarInt -> Get (Column name (ChArray chType))
deserializeColumn ProtocolRevision
rev UVarInt
rows = do
    ChString
_columnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    ChString
_columnType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
    (ChUInt64
arraySize, [ChUInt64]
_offsets) <- (ChUInt64, [ChUInt64]) -> (ChUInt64, [ChUInt64])
forall a. Show a => a -> a
traceShowId ((ChUInt64, [ChUInt64]) -> (ChUInt64, [ChUInt64]))
-> Get (ChUInt64, [ChUInt64]) -> Get (ChUInt64, [ChUInt64])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (ChUInt64, [ChUInt64])
readOffsets ProtocolRevision
rev
    [chType]
_types <- Int -> Get chType -> Get [chType]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (ChUInt64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ChUInt64
arraySize) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
    Column
  (GetColumnName (Column name (ChArray chType)))
  (GetColumnType (Column name (ChArray chType)))
-> Get
     (Column
        (GetColumnName (Column name (ChArray chType)))
        (GetColumnType (Column name (ChArray chType))))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column
   (GetColumnName (Column name (ChArray chType)))
   (GetColumnType (Column name (ChArray chType)))
 -> Get
      (Column
         (GetColumnName (Column name (ChArray chType)))
         (GetColumnType (Column name (ChArray chType)))))
-> Column
     (GetColumnName (Column name (ChArray chType)))
     (GetColumnType (Column name (ChArray chType)))
-> Get
     (Column
        (GetColumnName (Column name (ChArray chType)))
        (GetColumnType (Column name (ChArray chType))))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
UVarInt
-> [GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (ChArray chType)) UVarInt
rows []
    where
    readOffsets :: ProtocolRevision -> Get (ChUInt64, [ChUInt64])
    readOffsets :: ProtocolRevision -> Get (ChUInt64, [ChUInt64])
readOffsets ProtocolRevision
revivion = do
      ChUInt64
size <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChUInt64 ProtocolRevision
rev
      (ChUInt64
size, ) ([ChUInt64] -> (ChUInt64, [ChUInt64]))
-> Get [ChUInt64] -> Get (ChUInt64, [ChUInt64])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChUInt64 -> Get [ChUInt64]
go ChUInt64
size
      where
      go :: ChUInt64 -> Get [ChUInt64]
go ChUInt64
arraySize =
        do
        ChUInt64
nextOffset <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChUInt64 ProtocolRevision
revivion
        if ChUInt64
arraySize ChUInt64 -> ChUInt64 -> Bool
forall a. Ord a => a -> a -> Bool
>= ChUInt64
nextOffset
          then [ChUInt64] -> Get [ChUInt64]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ChUInt64
nextOffset]
          else (ChUInt64
nextOffset ChUInt64 -> [ChUInt64] -> [ChUInt64]
forall a. a -> [a] -> [a]
:) ([ChUInt64] -> [ChUInt64]) -> Get [ChUInt64] -> Get [ChUInt64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChUInt64 -> Get [ChUInt64]
go ChUInt64
arraySize




-- * Serialization

class Serializable chType
  where
  default serialize :: (Generic chType, GSerializable (Rep chType)) => ProtocolRevision -> chType -> Builder
  serialize :: ProtocolRevision -> chType -> Builder
  serialize ProtocolRevision
rev = ProtocolRevision -> Rep chType Any -> Builder
forall p. ProtocolRevision -> Rep chType p -> Builder
forall (f :: * -> *) p.
GSerializable f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev (Rep chType Any -> Builder)
-> (chType -> Rep chType Any) -> chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> Rep chType Any
forall x. chType -> Rep chType x
forall a x. Generic a => a -> Rep a x
from


-- ** Versioning

instance
  ( KnownNat revision
  , Serializable chType
  )
  =>
  Serializable (SinceRevision chType revision)
  where
  serialize :: ProtocolRevision -> SinceRevision chType revision -> Builder
serialize ProtocolRevision
rev (MkSinceRevision chType
val) = forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @revision ProtocolRevision
rev (ProtocolRevision -> chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev chType
val)
  serialize ProtocolRevision
rev SinceRevision chType revision
NotPresented          = forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @revision ProtocolRevision
rev (String -> Builder
forall a. HasCallStack => String -> a
error String
"Unexpected error")

instance Serializable ProtocolRevision where
  serialize :: ProtocolRevision -> ProtocolRevision -> Builder
serialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (UVarInt -> Builder)
-> (ProtocolRevision -> UVarInt) -> ProtocolRevision -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolRevision -> UVarInt
forall a b. Coercible a b => a -> b
coerce


-- ** Database types
instance Serializable UVarInt where
  serialize :: ProtocolRevision -> UVarInt -> Builder
serialize ProtocolRevision
_ = UVarInt -> Builder
forall {t}. (Integral t, Bits t) => t -> Builder
go
    where
    go :: t -> Builder
go t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0x80 = Word8 -> Builder
word8 (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i)
      | Bool
otherwise = Word8 -> Builder
word8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i) Int
7) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> t -> Builder
go (t -> Int -> t
forall a. Bits a => a -> Int -> a
unsafeShiftR t
i Int
7)

instance Serializable ChString where
  serialize :: ProtocolRevision -> ChString -> Builder
serialize ProtocolRevision
rev ChString
str
    =  (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (UVarInt -> Builder)
-> (ChString -> UVarInt) -> ChString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> (ChString -> Int) -> ChString -> UVarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Int) -> (ChString -> ByteString) -> ChString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChString -> ByteString
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType) ChString
str
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChString -> PutM ()) -> ChString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PutM ()
putByteString (ByteString -> PutM ())
-> (ChString -> ByteString) -> ChString -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChString -> ByteString
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType) ChString
str

instance Serializable ChUUID where serialize :: ProtocolRevision -> ChUUID -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChUUID -> PutM ()) -> ChUUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Word64
hi, Word64
lo) -> Word64 -> PutM ()
putWord64le Word64
lo PutM () -> PutM () -> PutM ()
forall a. Semigroup a => a -> a -> a
<> Word64 -> PutM ()
putWord64le Word64
hi) ((Word64, Word64) -> PutM ())
-> (ChUUID -> (Word64, Word64)) -> ChUUID -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUUID -> (Word64, Word64)
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt8 where serialize :: ProtocolRevision -> ChInt8 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChInt8 -> PutM ()) -> ChInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> PutM ()
putInt8 (Int8 -> PutM ()) -> (ChInt8 -> Int8) -> ChInt8 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt8 -> Int8
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt16 where serialize :: ProtocolRevision -> ChInt16 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChInt16 -> PutM ()) -> ChInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> PutM ()
putInt16le (Int16 -> PutM ()) -> (ChInt16 -> Int16) -> ChInt16 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt16 -> Int16
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt32 where serialize :: ProtocolRevision -> ChInt32 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChInt32 -> PutM ()) -> ChInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> PutM ()
putInt32le (Int32 -> PutM ()) -> (ChInt32 -> Int32) -> ChInt32 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt32 -> Int32
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt64 where serialize :: ProtocolRevision -> ChInt64 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChInt64 -> PutM ()) -> ChInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> PutM ()
putInt64le (Int64 -> PutM ()) -> (ChInt64 -> Int64) -> ChInt64 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt64 -> Int64
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt128 where serialize :: ProtocolRevision -> ChInt128 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChInt128 -> PutM ()) -> ChInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Int128 Word64
hi Word64
lo) -> Word64 -> PutM ()
putWord64le Word64
lo PutM () -> PutM () -> PutM ()
forall a. Semigroup a => a -> a -> a
<> Word64 -> PutM ()
putWord64le Word64
hi) (Int128 -> PutM ()) -> (ChInt128 -> Int128) -> ChInt128 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt128 -> Int128
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt8 where serialize :: ProtocolRevision -> ChUInt8 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChUInt8 -> PutM ()) -> ChUInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> PutM ()
putWord8 (Word8 -> PutM ()) -> (ChUInt8 -> Word8) -> ChUInt8 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt8 -> Word8
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt16 where serialize :: ProtocolRevision -> ChUInt16 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChUInt16 -> PutM ()) -> ChUInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> PutM ()
putWord16le (Word16 -> PutM ()) -> (ChUInt16 -> Word16) -> ChUInt16 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt16 -> Word16
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt32 where serialize :: ProtocolRevision -> ChUInt32 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChUInt32 -> PutM ()) -> ChUInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> PutM ()
putWord32le (Word32 -> PutM ()) -> (ChUInt32 -> Word32) -> ChUInt32 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt32 -> Word32
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt64 where serialize :: ProtocolRevision -> ChUInt64 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChUInt64 -> PutM ()) -> ChUInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> PutM ()
putWord64le (Word64 -> PutM ()) -> (ChUInt64 -> Word64) -> ChUInt64 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt64 -> Word64
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt128 where serialize :: ProtocolRevision -> ChUInt128 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChUInt128 -> PutM ()) -> ChUInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Word128 Word64
hi Word64
lo) -> Word64 -> PutM ()
putWord64le Word64
lo PutM () -> PutM () -> PutM ()
forall a. Semigroup a => a -> a -> a
<> Word64 -> PutM ()
putWord64le Word64
hi) (Word128 -> PutM ())
-> (ChUInt128 -> Word128) -> ChUInt128 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt128 -> Word128
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChDateTime where serialize :: ProtocolRevision -> ChDateTime -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChDateTime -> PutM ()) -> ChDateTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> PutM ()
putWord32le (Word32 -> PutM ())
-> (ChDateTime -> Word32) -> ChDateTime -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChDateTime -> Word32
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChDate where serialize :: ProtocolRevision -> ChDate -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChDate -> PutM ()) -> ChDate -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> PutM ()
putWord16le (Word16 -> PutM ()) -> (ChDate -> Word16) -> ChDate -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChDate -> Word16
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType


-- ** Columns

instance
  Serializable (Columns '[])
  where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Columns '[] -> Builder
serialize ProtocolRevision
_rev Columns '[]
Empty = Builder
""

instance
  ( Serializable (Columns columns)
  , Serializable col
  ) =>
  Serializable (Columns (col ': columns))
  where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Columns (col : columns) -> Builder
serialize ProtocolRevision
rev (AddColumn Column name chType
col Columns columns1
columns) = ProtocolRevision -> Column name chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev Column name chType
col Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> Columns columns1 -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev Columns columns1
columns

instance
  ( KnownColumn (Column name chType)
  , IsChType chType
  , Serializable chType
  ) => Serializable (Column name chType) where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Column name chType -> Builder
serialize ProtocolRevision
rev Column name chType
column
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnName @(Column name chType))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnType @(Column name chType))
    -- serialization is not custom
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev ChUInt8
0)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((chType -> Builder) -> [chType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @chType ProtocolRevision
rev) (Column name chType -> [chType]
forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues Column name chType
column))

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Nullable chType))
  , IsChType chType
  , Serializable chType
  ) => Serializable (Column name (Nullable chType)) where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Column name (Nullable chType) -> Builder
serialize ProtocolRevision
rev Column name (Nullable chType)
column
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnName @(Column name (Nullable chType)))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnType @(Column name (Nullable chType)))
    -- serialization is not custom
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev ChUInt8
0)
    -- Nulls
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Nullable chType -> Builder) -> [Nullable chType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev (ChUInt8 -> Builder)
-> (Nullable chType -> ChUInt8) -> Nullable chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt8 -> (chType -> ChUInt8) -> Nullable chType -> ChUInt8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChUInt8
1 (ChUInt8 -> chType -> ChUInt8
forall a b. a -> b -> a
const ChUInt8
0)) (Column name (Nullable chType) -> [Nullable chType]
forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues Column name (Nullable chType)
column))
    -- Values
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Nullable chType -> Builder) -> [Nullable chType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @chType ProtocolRevision
rev (chType -> Builder)
-> (Nullable chType -> chType) -> Nullable chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> (chType -> chType) -> Nullable chType -> chType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe chType
forall chType. IsChType chType => chType
defaultValueOfTypeName chType -> chType
forall a. a -> a
id) (Column name (Nullable chType) -> [Nullable chType]
forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues Column name (Nullable chType)
column))

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Nullable chType))
  , IsChType chType
  , Serializable chType
  ) => Serializable (Column name (LowCardinality chType)) where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Column name (LowCardinality chType) -> Builder
serialize ProtocolRevision
rev Column name (LowCardinality chType)
column
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnName @(Column name (Nullable chType)))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnType @(Column name (Nullable chType)))
    -- serialization is not custom
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev ChUInt8
0)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Column name (LowCardinality chType) -> Builder
forall a. HasCallStack => a
undefined Column name (LowCardinality chType)
column


-- ** Generics

class GSerializable f
  where
  gSerialize :: ProtocolRevision -> f p -> Builder

instance
  GSerializable f
  =>
  GSerializable (D1 c (C1 c2 f))
  where
  {-# INLINE gSerialize #-}
  gSerialize :: forall p. ProtocolRevision -> D1 c (C1 c2 f) p -> Builder
gSerialize ProtocolRevision
rev (M1 (M1 f p
re)) = ProtocolRevision -> f p -> Builder
forall p. ProtocolRevision -> f p -> Builder
forall (f :: * -> *) p.
GSerializable f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev f p
re

instance
  GSerializable (left1 :*: (left2 :*: right))
  =>
  GSerializable ((left1 :*: left2) :*: right)
  where
  {-# INLINE gSerialize #-}
  gSerialize :: forall p.
ProtocolRevision -> (:*:) (left1 :*: left2) right p -> Builder
gSerialize ProtocolRevision
rev ((left1 p
l1 :*: left2 p
l2) :*: right p
r) = ProtocolRevision -> (:*:) left1 (left2 :*: right) p -> Builder
forall p.
ProtocolRevision -> (:*:) left1 (left2 :*: right) p -> Builder
forall (f :: * -> *) p.
GSerializable f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev (left1 p
l1 left1 p -> (:*:) left2 right p -> (:*:) left1 (left2 :*: right) p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (left2 p
l2 left2 p -> right p -> (:*:) left2 right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: right p
r))

instance
  Serializable chType
  =>
  GSerializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType))
  where
  {-# INLINE gSerialize #-}
  gSerialize :: forall p.
ProtocolRevision
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> Builder
gSerialize ProtocolRevision
rev = ProtocolRevision -> chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (chType -> Builder)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> chType)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R chType p -> chType
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R chType p -> chType)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
    -> K1 R chType p)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> K1 R chType p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

instance
  (Serializable chType, GSerializable right)
  =>
  GSerializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType) :*: right)
  where
  {-# INLINE gSerialize #-}
  gSerialize :: forall p.
ProtocolRevision
-> (:*:)
     (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType)) right p
-> Builder
gSerialize ProtocolRevision
rev (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
left :*: right p
right)
    = (ProtocolRevision -> chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (chType -> Builder)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> chType)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R chType p -> chType
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R chType p -> chType)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
    -> K1 R chType p)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> K1 R chType p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> Builder)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> Builder
forall a b. (a -> b) -> a -> b
$ S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
left) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> right p -> Builder
forall p. ProtocolRevision -> right p -> Builder
forall (f :: * -> *) p.
GSerializable f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev right p
right