{-# LANGUAGE OverloadedStrings #-}
module ClickHaskell.DeSerialization where
import ClickHaskell.Versioning (ProtocolRevision(..), SinceRevision (..), afterRevision)
import ClickHaskell.DbTypes
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 (KnownNat, natVal)
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
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
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
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"
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
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
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
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