{-# LANGUAGE
    ConstraintKinds
  , OverloadedStrings
  , TypeFamilyDependencies
  , TupleSections
  , LambdaCase
#-}

{-# OPTIONS_GHC
  -Wno-orphans
#-}

module ClickHaskell.Columns where

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

-- GHC included
import Control.Monad (forM, replicateM)
import Data.Binary (Get)
import Data.Bits
import Data.ByteString.Builder (Builder, stringUtf8)
import Data.Kind (Type)
import Data.Typeable (Proxy (..))
import Debug.Trace (traceShowId)
import GHC.Generics
import GHC.TypeLits (ErrorMessage (..), KnownSymbol, Symbol, TypeError, symbolVal)

-- * Columns

emptyColumns :: Columns '[]
emptyColumns :: Columns '[]
emptyColumns = Columns '[]
Empty

rowsCount ::  Columns columns -> UVarInt
rowsCount :: forall (columns :: [*]). Columns columns -> UVarInt
rowsCount (AddColumn Column name chType
col Columns columns
_) = Column name chType -> UVarInt
forall (name :: Symbol) chType. Column name chType -> UVarInt
columnSize Column name chType
col
rowsCount Columns columns
Empty = UVarInt
0

{-# INLINE [0] appendColumn #-}
appendColumn
  :: KnownColumn (Column name chType)
  => Column name chType
  -> Columns columns
  -> Columns (Column name chType ': columns)
appendColumn :: forall (name :: Symbol) chType (columns :: [*]).
KnownColumn (Column name chType) =>
Column name chType
-> Columns columns -> Columns (Column name chType : columns)
appendColumn = Column name chType
-> Columns columns -> Columns (Column name chType : columns)
forall (name :: Symbol) chType (columns :: [*]).
KnownColumn (Column name chType) =>
Column name chType
-> Columns columns -> Columns (Column name chType : columns)
AddColumn


data Columns (columns :: [Type]) where
  Empty :: Columns '[]
  AddColumn
    :: KnownColumn (Column name chType)
    => Column name chType
    -> Columns columns
    -> Columns (Column name chType ': columns)

{- |
Column declaration

For example:

@
type MyColumn = Column "myColumn" ChString
@
-}
data Column (name :: Symbol) (chType :: Type) where
  ChUInt8Column :: UVarInt -> [ChUInt8] -> Column name ChUInt8
  ChUInt16Column :: UVarInt -> [ChUInt16] -> Column name ChUInt16
  ChUInt32Column :: UVarInt -> [ChUInt32] -> Column name ChUInt32
  ChUInt64Column :: UVarInt -> [ChUInt64] -> Column name ChUInt64
  ChUInt128Column :: UVarInt -> [ChUInt128] -> Column name ChUInt128
  ChInt8Column :: UVarInt -> [ChInt8] -> Column name ChInt8
  ChInt16Column :: UVarInt -> [ChInt16] -> Column name ChInt16
  ChInt32Column :: UVarInt -> [ChInt32] -> Column name ChInt32
  ChInt64Column :: UVarInt -> [ChInt64] -> Column name ChInt64
  ChInt128Column :: UVarInt -> [ChInt128] -> Column name ChInt128
  ChDateColumn :: UVarInt -> [ChDate] -> Column name ChDate
  ChDateTimeColumn :: UVarInt -> [ChDateTime] -> Column name ChDateTime
  ChUUIDColumn :: UVarInt -> [ChUUID] -> Column name ChUUID
  ChStringColumn :: UVarInt -> [ChString] -> Column name ChString
  ChArrayColumn :: IsChType chType => UVarInt -> [ChArray chType] -> Column name (ChArray chType)
  NullableColumn :: IsChType chType => UVarInt -> [Nullable chType] -> Column name (Nullable chType)
  LowCardinalityColumn :: (IsLowCardinalitySupported chType, IsChType chType) => UVarInt -> [chType] -> Column name (LowCardinality chType)

type family GetColumnName column :: Symbol
  where
  GetColumnName (Column name columnType) = name

type family GetColumnType column :: Type
  where
  GetColumnType (Column name columnType) = columnType

class
  ( IsChType (GetColumnType column)
  , KnownSymbol (GetColumnName column)
  ) =>
  KnownColumn column where
  renderColumnName :: Builder
  renderColumnName = (String -> Builder
stringUtf8 (String -> Builder)
-> (Proxy (GetColumnName column) -> String)
-> Proxy (GetColumnName column)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @(GetColumnName column)) Proxy (GetColumnName column)
forall {k} (t :: k). Proxy t
Proxy

  renderColumnType :: Builder
  renderColumnType = forall chType. IsChType chType => Builder
chTypeName @(GetColumnType column)

  mkColumn :: UVarInt -> [GetColumnType column] -> Column (GetColumnName column) (GetColumnType column)

{-# INLINE [0] columnSize #-}
columnSize :: Column name chType -> UVarInt
columnSize :: forall (name :: Symbol) chType. Column name chType -> UVarInt
columnSize Column name chType
column = case Column name chType
column of
  (ChUInt8Column UVarInt
size [ChUInt8]
_listValues) -> UVarInt
size
  (ChUInt16Column UVarInt
size [ChUInt16]
_listValues) -> UVarInt
size
  (ChUInt32Column UVarInt
size [ChUInt32]
_listValues) -> UVarInt
size
  (ChUInt64Column UVarInt
size [ChUInt64]
_listValues) -> UVarInt
size
  (ChUInt128Column UVarInt
size [ChUInt128]
_listValues) -> UVarInt
size
  (ChInt8Column UVarInt
size [ChInt8]
_listValues) -> UVarInt
size
  (ChInt16Column UVarInt
size [ChInt16]
_listValues) -> UVarInt
size
  (ChInt32Column UVarInt
size [ChInt32]
_listValues) -> UVarInt
size
  (ChInt64Column UVarInt
size [ChInt64]
_listValues) -> UVarInt
size
  (ChInt128Column UVarInt
size [ChInt128]
_listValues) -> UVarInt
size
  (ChDateColumn UVarInt
size [ChDate]
_nullableValues) -> UVarInt
size
  (ChDateTimeColumn UVarInt
size [ChDateTime]
_nullableValues) -> UVarInt
size
  (ChUUIDColumn UVarInt
size [ChUUID]
_nullableValues) -> UVarInt
size
  (ChStringColumn UVarInt
size [ChString]
_values) -> UVarInt
size
  (ChArrayColumn UVarInt
size [ChArray chType]
_nullableValues) -> UVarInt
size
  (NullableColumn UVarInt
size [Maybe chType]
_nullableValues) -> UVarInt
size
  (LowCardinalityColumn UVarInt
size [chType]
_lowCardinalityValues) -> UVarInt
size

{-# INLINE [0] columnValues #-}
columnValues :: Column name chType -> [chType]
columnValues :: forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues Column name chType
column = case Column name chType
column of
  (ChUInt8Column UVarInt
_size [ChUInt8]
values) -> [chType]
[ChUInt8]
values
  (ChUInt16Column UVarInt
_size [ChUInt16]
values) -> [chType]
[ChUInt16]
values
  (ChUInt32Column UVarInt
_size [ChUInt32]
values) -> [chType]
[ChUInt32]
values
  (ChUInt64Column UVarInt
_size [ChUInt64]
values) -> [chType]
[ChUInt64]
values
  (ChUInt128Column UVarInt
_size [ChUInt128]
values) -> [chType]
[ChUInt128]
values
  (ChInt8Column UVarInt
_size [ChInt8]
values) -> [chType]
[ChInt8]
values
  (ChInt16Column UVarInt
_size [ChInt16]
values) -> [chType]
[ChInt16]
values
  (ChInt32Column UVarInt
_size [ChInt32]
values) -> [chType]
[ChInt32]
values
  (ChInt64Column UVarInt
_size [ChInt64]
values) -> [chType]
[ChInt64]
values
  (ChInt128Column UVarInt
_size [ChInt128]
values) -> [chType]
[ChInt128]
values
  (ChDateColumn UVarInt
_size [ChDate]
values) -> [chType]
[ChDate]
values
  (ChDateTimeColumn UVarInt
_size [ChDateTime]
values) -> [chType]
[ChDateTime]
values
  (ChUUIDColumn UVarInt
_size [ChUUID]
values) -> [chType]
[ChUUID]
values
  (ChStringColumn UVarInt
_size [ChString]
values) -> [chType]
[ChString]
values
  (ChArrayColumn UVarInt
_size [ChArray chType]
arrayValues) -> [chType]
[ChArray chType]
arrayValues
  (NullableColumn UVarInt
_size [Maybe chType]
nullableValues) ->  [chType]
[Maybe chType]
nullableValues
  (LowCardinalityColumn UVarInt
_size [chType]
lowCardinalityValues) -> (chType -> chType) -> [chType] -> [chType]
forall a b. (a -> b) -> [a] -> [b]
map chType -> chType
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType [chType]
lowCardinalityValues

instance KnownSymbol name => KnownColumn (Column name ChUInt8) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChUInt8)]
-> Column
     (GetColumnName (Column name ChUInt8))
     (GetColumnType (Column name ChUInt8))
mkColumn = UVarInt -> [ChUInt8] -> Column name ChUInt8
UVarInt
-> [GetColumnType (Column name ChUInt8)]
-> Column
     (GetColumnName (Column name ChUInt8))
     (GetColumnType (Column name ChUInt8))
forall (name :: Symbol).
UVarInt -> [ChUInt8] -> Column name ChUInt8
ChUInt8Column
instance KnownSymbol name => KnownColumn (Column name ChUInt16) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChUInt16)]
-> Column
     (GetColumnName (Column name ChUInt16))
     (GetColumnType (Column name ChUInt16))
mkColumn = UVarInt -> [ChUInt16] -> Column name ChUInt16
UVarInt
-> [GetColumnType (Column name ChUInt16)]
-> Column
     (GetColumnName (Column name ChUInt16))
     (GetColumnType (Column name ChUInt16))
forall (name :: Symbol).
UVarInt -> [ChUInt16] -> Column name ChUInt16
ChUInt16Column
instance KnownSymbol name => KnownColumn (Column name ChUInt32) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChUInt32)]
-> Column
     (GetColumnName (Column name ChUInt32))
     (GetColumnType (Column name ChUInt32))
mkColumn = UVarInt -> [ChUInt32] -> Column name ChUInt32
UVarInt
-> [GetColumnType (Column name ChUInt32)]
-> Column
     (GetColumnName (Column name ChUInt32))
     (GetColumnType (Column name ChUInt32))
forall (name :: Symbol).
UVarInt -> [ChUInt32] -> Column name ChUInt32
ChUInt32Column
instance KnownSymbol name => KnownColumn (Column name ChUInt64) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChUInt64)]
-> Column
     (GetColumnName (Column name ChUInt64))
     (GetColumnType (Column name ChUInt64))
mkColumn = UVarInt -> [ChUInt64] -> Column name ChUInt64
UVarInt
-> [GetColumnType (Column name ChUInt64)]
-> Column
     (GetColumnName (Column name ChUInt64))
     (GetColumnType (Column name ChUInt64))
forall (name :: Symbol).
UVarInt -> [ChUInt64] -> Column name ChUInt64
ChUInt64Column
instance KnownSymbol name => KnownColumn (Column name ChUInt128) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChUInt128)]
-> Column
     (GetColumnName (Column name ChUInt128))
     (GetColumnType (Column name ChUInt128))
mkColumn = UVarInt -> [ChUInt128] -> Column name ChUInt128
UVarInt
-> [GetColumnType (Column name ChUInt128)]
-> Column
     (GetColumnName (Column name ChUInt128))
     (GetColumnType (Column name ChUInt128))
forall (name :: Symbol).
UVarInt -> [ChUInt128] -> Column name ChUInt128
ChUInt128Column
instance KnownSymbol name => KnownColumn (Column name ChInt8)  where mkColumn :: UVarInt
-> [GetColumnType (Column name ChInt8)]
-> Column
     (GetColumnName (Column name ChInt8))
     (GetColumnType (Column name ChInt8))
mkColumn = UVarInt -> [ChInt8] -> Column name ChInt8
UVarInt
-> [GetColumnType (Column name ChInt8)]
-> Column
     (GetColumnName (Column name ChInt8))
     (GetColumnType (Column name ChInt8))
forall (name :: Symbol). UVarInt -> [ChInt8] -> Column name ChInt8
ChInt8Column
instance KnownSymbol name => KnownColumn (Column name ChInt16) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChInt16)]
-> Column
     (GetColumnName (Column name ChInt16))
     (GetColumnType (Column name ChInt16))
mkColumn = UVarInt -> [ChInt16] -> Column name ChInt16
UVarInt
-> [GetColumnType (Column name ChInt16)]
-> Column
     (GetColumnName (Column name ChInt16))
     (GetColumnType (Column name ChInt16))
forall (name :: Symbol).
UVarInt -> [ChInt16] -> Column name ChInt16
ChInt16Column
instance KnownSymbol name => KnownColumn (Column name ChInt32) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChInt32)]
-> Column
     (GetColumnName (Column name ChInt32))
     (GetColumnType (Column name ChInt32))
mkColumn = UVarInt -> [ChInt32] -> Column name ChInt32
UVarInt
-> [GetColumnType (Column name ChInt32)]
-> Column
     (GetColumnName (Column name ChInt32))
     (GetColumnType (Column name ChInt32))
forall (name :: Symbol).
UVarInt -> [ChInt32] -> Column name ChInt32
ChInt32Column
instance KnownSymbol name => KnownColumn (Column name ChInt64) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChInt64)]
-> Column
     (GetColumnName (Column name ChInt64))
     (GetColumnType (Column name ChInt64))
mkColumn = UVarInt -> [ChInt64] -> Column name ChInt64
UVarInt
-> [GetColumnType (Column name ChInt64)]
-> Column
     (GetColumnName (Column name ChInt64))
     (GetColumnType (Column name ChInt64))
forall (name :: Symbol).
UVarInt -> [ChInt64] -> Column name ChInt64
ChInt64Column
instance KnownSymbol name => KnownColumn (Column name ChInt128) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChInt128)]
-> Column
     (GetColumnName (Column name ChInt128))
     (GetColumnType (Column name ChInt128))
mkColumn = UVarInt -> [ChInt128] -> Column name ChInt128
UVarInt
-> [GetColumnType (Column name ChInt128)]
-> Column
     (GetColumnName (Column name ChInt128))
     (GetColumnType (Column name ChInt128))
forall (name :: Symbol).
UVarInt -> [ChInt128] -> Column name ChInt128
ChInt128Column
instance KnownSymbol name => KnownColumn (Column name ChDate) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChDate)]
-> Column
     (GetColumnName (Column name ChDate))
     (GetColumnType (Column name ChDate))
mkColumn = UVarInt -> [ChDate] -> Column name ChDate
UVarInt
-> [GetColumnType (Column name ChDate)]
-> Column
     (GetColumnName (Column name ChDate))
     (GetColumnType (Column name ChDate))
forall (name :: Symbol). UVarInt -> [ChDate] -> Column name ChDate
ChDateColumn
instance KnownSymbol name => KnownColumn (Column name ChDateTime) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChDateTime)]
-> Column
     (GetColumnName (Column name ChDateTime))
     (GetColumnType (Column name ChDateTime))
mkColumn = UVarInt -> [ChDateTime] -> Column name ChDateTime
UVarInt
-> [GetColumnType (Column name ChDateTime)]
-> Column
     (GetColumnName (Column name ChDateTime))
     (GetColumnType (Column name ChDateTime))
forall (name :: Symbol).
UVarInt -> [ChDateTime] -> Column name ChDateTime
ChDateTimeColumn
instance KnownSymbol name => KnownColumn (Column name ChUUID) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChUUID)]
-> Column
     (GetColumnName (Column name ChUUID))
     (GetColumnType (Column name ChUUID))
mkColumn = UVarInt -> [ChUUID] -> Column name ChUUID
UVarInt
-> [GetColumnType (Column name ChUUID)]
-> Column
     (GetColumnName (Column name ChUUID))
     (GetColumnType (Column name ChUUID))
forall (name :: Symbol). UVarInt -> [ChUUID] -> Column name ChUUID
ChUUIDColumn
instance
  ( KnownSymbol name
  , IsChType chType
  , IsChType (Nullable chType)
  ) =>
  KnownColumn (Column name (Nullable chType)) where mkColumn :: UVarInt
-> [GetColumnType (Column name (Nullable chType))]
-> Column
     (GetColumnName (Column name (Nullable chType)))
     (GetColumnType (Column name (Nullable chType)))
mkColumn = UVarInt -> [Nullable chType] -> Column name (Nullable chType)
UVarInt
-> [GetColumnType (Column name (Nullable chType))]
-> Column
     (GetColumnName (Column name (Nullable chType)))
     (GetColumnType (Column name (Nullable chType)))
forall chType (name :: Symbol).
IsChType chType =>
UVarInt -> [Nullable chType] -> Column name (Nullable chType)
NullableColumn
instance KnownSymbol name => KnownColumn (Column name ChString) where mkColumn :: UVarInt
-> [GetColumnType (Column name ChString)]
-> Column
     (GetColumnName (Column name ChString))
     (GetColumnType (Column name ChString))
mkColumn = UVarInt -> [ChString] -> Column name ChString
UVarInt
-> [GetColumnType (Column name ChString)]
-> Column
     (GetColumnName (Column name ChString))
     (GetColumnType (Column name ChString))
forall (name :: Symbol).
UVarInt -> [ChString] -> Column name ChString
ChStringColumn
instance
  ( KnownSymbol name
  , IsChType (LowCardinality chType)
  , IsLowCardinalitySupported chType
  ) =>
  KnownColumn (Column name (LowCardinality chType)) where mkColumn :: UVarInt
-> [GetColumnType (Column name (LowCardinality chType))]
-> Column
     (GetColumnName (Column name (LowCardinality chType)))
     (GetColumnType (Column name (LowCardinality chType)))
mkColumn UVarInt
size = UVarInt -> [chType] -> Column name (LowCardinality chType)
forall chType (name :: Symbol).
(IsLowCardinalitySupported chType, IsChType chType) =>
UVarInt -> [chType] -> Column name (LowCardinality chType)
LowCardinalityColumn UVarInt
size ([chType] -> Column name (LowCardinality chType))
-> ([LowCardinality chType] -> [chType])
-> [LowCardinality chType]
-> Column name (LowCardinality chType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LowCardinality chType -> chType)
-> [LowCardinality chType] -> [chType]
forall a b. (a -> b) -> [a] -> [b]
map LowCardinality chType -> chType
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance KnownSymbol name => KnownColumn (Column name (ChArray ChString)) where mkColumn :: UVarInt
-> [GetColumnType (Column name (ChArray ChString))]
-> Column
     (GetColumnName (Column name (ChArray ChString)))
     (GetColumnType (Column name (ChArray ChString)))
mkColumn = UVarInt -> [ChArray ChString] -> Column name (ChArray ChString)
UVarInt
-> [GetColumnType (Column name (ChArray ChString))]
-> Column
     (GetColumnName (Column name (ChArray ChString)))
     (GetColumnType (Column name (ChArray ChString)))
forall chType (name :: Symbol).
IsChType chType =>
UVarInt -> [ChArray chType] -> Column name (ChArray chType)
ChArrayColumn


-- ** 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 columns
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 columns -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev Columns columns
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
  , TypeError ('Text "LowCardinality serialization still unsupported")
  ) => Serializable (Column name (LowCardinality chType)) where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Column name (LowCardinality chType) -> Builder
serialize ProtocolRevision
rev (LowCardinalityColumn UVarInt
_ [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
<> [chType] -> Builder
forall a. HasCallStack => a
undefined [chType]
column










-- * (De)serialization

-- ** Serialization

-- *** Generic API

type GenericWritable record columns =
  ( Generic record
  , GWritable columns (Rep record)
  )

class
  ( HasColumns (Columns (GetColumns columns))
  , Serializable (Columns (GetColumns columns))
  , DeserializableColumns (Columns (GetColumns columns))
  ) =>
  WritableInto columns record
  where
  default serializeRecords :: GenericWritable record (GetColumns columns) => ProtocolRevision -> UVarInt -> [record] -> Builder
  serializeRecords :: ProtocolRevision -> UVarInt -> [record] -> Builder
  serializeRecords ProtocolRevision
rev UVarInt
size = forall (columns :: [*]) (f :: * -> *) p.
GWritable columns f =>
ProtocolRevision -> UVarInt -> [f p] -> Builder
gSerializeRecords @(GetColumns columns) ProtocolRevision
rev UVarInt
size ([Rep record Any] -> Builder)
-> ([record] -> [Rep record Any]) -> [record] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (record -> Rep record Any) -> [record] -> [Rep record Any]
forall a b. (a -> b) -> [a] -> [b]
map record -> Rep record Any
forall x. record -> Rep record x
forall a x. Generic a => a -> Rep a x
from

  default writingColumns :: GenericWritable record (GetColumns columns) => Builder
  writingColumns :: Builder
  writingColumns = forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
Builder
gWritingColumns @(GetColumns columns) @(Rep record)

  default columnsCount :: GenericWritable record (GetColumns columns) => UVarInt
  columnsCount :: UVarInt
  columnsCount = forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
UVarInt
gColumnsCount @(GetColumns columns) @(Rep record)

class GWritable (columns :: [Type]) f
  where
  gSerializeRecords :: ProtocolRevision -> UVarInt -> [f p] -> Builder
  gWritingColumns :: Builder
  gColumnsCount :: UVarInt

instance
  GWritable columns f
  =>
  GWritable columns (D1 c (C1 c2 f))
  where
  {-# INLINE gSerializeRecords #-}
  gSerializeRecords :: forall p.
ProtocolRevision -> UVarInt -> [D1 c (C1 c2 f) p] -> Builder
gSerializeRecords ProtocolRevision
rev UVarInt
size = forall (columns :: [*]) (f :: * -> *) p.
GWritable columns f =>
ProtocolRevision -> UVarInt -> [f p] -> Builder
gSerializeRecords @columns ProtocolRevision
rev UVarInt
size ([f p] -> Builder)
-> ([D1 c (C1 c2 f) p] -> [f p]) -> [D1 c (C1 c2 f) p] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D1 c (C1 c2 f) p -> f p) -> [D1 c (C1 c2 f) p] -> [f p]
forall a b. (a -> b) -> [a] -> [b]
map (M1 C c2 f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 C c2 f p -> f p)
-> (D1 c (C1 c2 f) p -> M1 C c2 f p) -> D1 c (C1 c2 f) p -> f p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 c (C1 c2 f) p -> M1 C c2 f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1)
  {-# INLINE gWritingColumns #-}
  gWritingColumns :: Builder
gWritingColumns = forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
Builder
gWritingColumns @columns @f
  gColumnsCount :: UVarInt
gColumnsCount = forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
UVarInt
gColumnsCount @columns @f

instance
  GWritable columns (left1 :*: (left2 :*: right))
  =>
  GWritable columns ((left1 :*: left2) :*: right)
  where
  {-# INLINE gSerializeRecords #-}
  gSerializeRecords :: forall p.
ProtocolRevision
-> UVarInt -> [(:*:) (left1 :*: left2) right p] -> Builder
gSerializeRecords ProtocolRevision
rev UVarInt
size = forall (columns :: [*]) (f :: * -> *) p.
GWritable columns f =>
ProtocolRevision -> UVarInt -> [f p] -> Builder
gSerializeRecords @columns ProtocolRevision
rev UVarInt
size ([(:*:) left1 (left2 :*: right) p] -> Builder)
-> ([(:*:) (left1 :*: left2) right p]
    -> [(:*:) left1 (left2 :*: right) p])
-> [(:*:) (left1 :*: left2) right p]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((:*:) (left1 :*: left2) right p
 -> (:*:) left1 (left2 :*: right) p)
-> [(:*:) (left1 :*: left2) right p]
-> [(:*:) left1 (left2 :*: right) p]
forall a b. (a -> b) -> [a] -> [b]
map (\((left1 p
l1 :*: left2 p
l2) :*: right p
r) -> 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))
  {-# INLINE gWritingColumns #-}
  gWritingColumns :: Builder
gWritingColumns = forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
Builder
gWritingColumns @columns @(left1 :*: (left2 :*: right))
  gColumnsCount :: UVarInt
gColumnsCount = forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
UVarInt
gColumnsCount @columns @(left1 :*: (left2 :*: right))

instance
  ( GWritable '[Column name chType] (S1 (MetaSel (Just name) a b f) rec)
  , GWritable restColumns right
  , '(Column name chType, restColumns)~ TakeColumn name columns
  )
  =>
  GWritable columns (S1 (MetaSel (Just name) a b f) rec :*: right)
  where
  {-# INLINE gSerializeRecords #-}
  gSerializeRecords :: forall p.
ProtocolRevision
-> UVarInt
-> [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p]
-> Builder
gSerializeRecords ProtocolRevision
rev UVarInt
size
    = (\([M1 S ('MetaSel ('Just name) a b f) rec p]
a, [right p]
b) -> forall (columns :: [*]) (f :: * -> *) p.
GWritable columns f =>
ProtocolRevision -> UVarInt -> [f p] -> Builder
gSerializeRecords @'[Column name chType] ProtocolRevision
rev UVarInt
size [M1 S ('MetaSel ('Just name) a b f) rec p]
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) (f :: * -> *) p.
GWritable columns f =>
ProtocolRevision -> UVarInt -> [f p] -> Builder
gSerializeRecords @restColumns ProtocolRevision
rev UVarInt
size [right p]
b)
    (([M1 S ('MetaSel ('Just name) a b f) rec p], [right p])
 -> Builder)
-> ([(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p]
    -> ([M1 S ('MetaSel ('Just name) a b f) rec p], [right p]))
-> [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(M1 S ('MetaSel ('Just name) a b f) rec p, right p)]
-> ([M1 S ('MetaSel ('Just name) a b f) rec p], [right p])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(M1 S ('MetaSel ('Just name) a b f) rec p, right p)]
 -> ([M1 S ('MetaSel ('Just name) a b f) rec p], [right p]))
-> ([(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p]
    -> [(M1 S ('MetaSel ('Just name) a b f) rec p, right p)])
-> [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p]
-> ([M1 S ('MetaSel ('Just name) a b f) rec p], [right p])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p
 -> (M1 S ('MetaSel ('Just name) a b f) rec p, right p))
-> [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p]
-> [(M1 S ('MetaSel ('Just name) a b f) rec p, right p)]
forall a b. (a -> b) -> [a] -> [b]
map (\(M1 S ('MetaSel ('Just name) a b f) rec p
l :*: right p
r) -> (M1 S ('MetaSel ('Just name) a b f) rec p
l, right p
r))

  {-# INLINE gWritingColumns #-}
  gWritingColumns :: Builder
gWritingColumns =
    forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
Builder
gWritingColumns @'[Column name chType] @(S1 (MetaSel (Just name) a b f) rec)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
Builder
gWritingColumns @restColumns @right
  gColumnsCount :: UVarInt
gColumnsCount = forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
UVarInt
gColumnsCount @'[Column name chType] @(S1 (MetaSel (Just name) a b f) rec) UVarInt -> UVarInt -> UVarInt
forall a. Num a => a -> a -> a
+ forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
UVarInt
gColumnsCount @restColumns @right

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name chType)
  , ToChType chType inputType
  , Serializable (Column name chType)
  , '(Column name chType, restColumns) ~ TakeColumn name columns
  ) =>
  GWritable columns (S1 (MetaSel (Just name) a b f) (Rec0 inputType))
  where
  {-# INLINE gSerializeRecords #-}
  gSerializeRecords :: forall p.
ProtocolRevision
-> UVarInt
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
-> Builder
gSerializeRecords ProtocolRevision
rev UVarInt
size = ProtocolRevision -> Column name chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (Column name chType -> Builder)
-> ([S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
    -> Column name chType)
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall column.
KnownColumn column =>
UVarInt
-> [GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name chType) UVarInt
size ([chType] -> Column name chType)
-> ([S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
    -> [chType])
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
-> Column name chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p -> chType)
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
-> [chType]
forall a b. (a -> b) -> [a] -> [b]
map (inputType -> chType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (inputType -> chType)
-> (S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
    -> inputType)
-> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
-> chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R inputType p -> inputType
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R inputType p -> inputType)
-> (S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
    -> K1 R inputType p)
-> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
-> inputType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
-> K1 R inputType p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1)
  {-# INLINE gWritingColumns #-}
  gWritingColumns :: Builder
gWritingColumns = forall column. KnownColumn column => Builder
renderColumnName @(Column name chType)
  gColumnsCount :: UVarInt
gColumnsCount = UVarInt
1




-- ** Deserialization

-- *** Generic API

type GenericReadable record hasColumns =
  ( Generic record
  , GReadable (GetColumns hasColumns) (Rep record)
  )

class
  ( HasColumns hasColumns
  , DeserializableColumns (Columns (GetColumns hasColumns))
  ) =>
  ReadableFrom hasColumns record
  where
  default deserializeColumns :: GenericReadable record hasColumns => ProtocolRevision -> UVarInt -> Get [record]
  deserializeColumns :: ProtocolRevision -> UVarInt -> Get [record]
  deserializeColumns ProtocolRevision
rev UVarInt
size = (Rep record Any -> record) -> [Rep record Any] -> [record]
forall a b. (a -> b) -> [a] -> [b]
map Rep record Any -> record
forall a x. Generic a => Rep a x -> a
forall x. Rep record x -> record
to ([Rep record Any] -> [record])
-> Get [Rep record Any] -> Get [record]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (columns :: [*]) (f :: * -> *) p.
GReadable columns f =>
ProtocolRevision -> UVarInt -> Get [f p]
gFromColumns @(GetColumns hasColumns) ProtocolRevision
rev UVarInt
size

  default readingColumns :: GenericReadable record hasColumns => Builder
  readingColumns :: Builder
  readingColumns = forall (columns :: [*]) (f :: * -> *).
GReadable columns f =>
Builder
gReadingColumns @(GetColumns hasColumns) @(Rep record)


class GReadable (columns :: [Type]) f
  where
  gFromColumns :: ProtocolRevision -> UVarInt -> Get [f p]
  gReadingColumns :: Builder

instance
  GReadable columns f
  =>
  GReadable columns (D1 c (C1 c2 f))
  where
  {-# INLINE gFromColumns #-}
  gFromColumns :: forall p. ProtocolRevision -> UVarInt -> Get [D1 c (C1 c2 f) p]
gFromColumns ProtocolRevision
rev UVarInt
size = (f p -> D1 c (C1 c2 f) p) -> [f p] -> [D1 c (C1 c2 f) p]
forall a b. (a -> b) -> [a] -> [b]
map (C1 c2 f p -> D1 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 -> D1 c (C1 c2 f) p)
-> (f p -> C1 c2 f p) -> f p -> D1 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] -> [D1 c (C1 c2 f) p])
-> Get [f p] -> Get [D1 c (C1 c2 f) p]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (columns :: [*]) (f :: * -> *) p.
GReadable columns f =>
ProtocolRevision -> UVarInt -> Get [f p]
gFromColumns @columns ProtocolRevision
rev UVarInt
size
  gReadingColumns :: Builder
gReadingColumns = forall (columns :: [*]) (f :: * -> *).
GReadable columns f =>
Builder
gReadingColumns @columns @f

instance
  GReadable columns (left :*: (right1 :*: right2))
  =>
  GReadable columns ((left :*: right1) :*: right2)
  where
  {-# INLINE gFromColumns #-}
  gFromColumns :: forall p.
ProtocolRevision
-> UVarInt -> Get [(:*:) (left :*: right1) right2 p]
gFromColumns ProtocolRevision
rev UVarInt
size = do
    [(:*:) left (right1 :*: right2) p]
list <- forall (columns :: [*]) (f :: * -> *) p.
GReadable columns f =>
ProtocolRevision -> UVarInt -> Get [f p]
gFromColumns @columns ProtocolRevision
rev UVarInt
size
    [(:*:) (left :*: right1) right2 p]
-> Get [(:*:) (left :*: right1) right2 p]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(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 p
l :*: (right1 p
r1 :*: right2 p
r2)) <- [(:*:) left (right1 :*: right2) p]
list]
  gReadingColumns :: Builder
gReadingColumns = forall (columns :: [*]) (f :: * -> *).
GReadable columns f =>
Builder
gReadingColumns @columns @(left :*: (right1 :*: right2))


instance
  ( KnownColumn (Column name chType)
  , GReadable '[Column name chType] (S1 (MetaSel (Just name) a b f) rec)
  , GReadable restColumns right
  , '(Column name chType, restColumns) ~ TakeColumn name columns
  )
  =>
  GReadable columns (S1 (MetaSel (Just name) a b f) rec :*: right)
  where
  {-# INLINE gFromColumns #-}
  gFromColumns :: forall p.
ProtocolRevision
-> UVarInt
-> Get [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p]
gFromColumns ProtocolRevision
rev UVarInt
size = do
    (S1 ('MetaSel ('Just name) a b f) rec p
 -> right p -> (:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p)
-> [S1 ('MetaSel ('Just name) a b f) rec p]
-> [right p]
-> [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith S1 ('MetaSel ('Just name) a b f) rec p
-> right p -> (:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
      ([S1 ('MetaSel ('Just name) a b f) rec p]
 -> [right p]
 -> [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p])
-> Get [S1 ('MetaSel ('Just name) a b f) rec p]
-> Get
     ([right p]
      -> [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (columns :: [*]) (f :: * -> *) p.
GReadable columns f =>
ProtocolRevision -> UVarInt -> Get [f p]
gFromColumns @'[Column name chType] ProtocolRevision
rev UVarInt
size
      Get
  ([right p]
   -> [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) right p])
-> Get [right p]
-> Get [(:*:) (S1 ('MetaSel ('Just name) a b f) rec) 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
<*> forall (columns :: [*]) (f :: * -> *) p.
GReadable columns f =>
ProtocolRevision -> UVarInt -> Get [f p]
gFromColumns @restColumns ProtocolRevision
rev UVarInt
size
  gReadingColumns :: Builder
gReadingColumns =
    forall column. KnownColumn column => Builder
renderColumnName @(Column name chType)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) (f :: * -> *).
GReadable columns f =>
Builder
gReadingColumns @restColumns @right

instance
  ( KnownColumn (Column name chType)
  , DeserializableColumn (Column name chType)
  , FromChType chType inputType
  , '(Column name chType, restColumns) ~ TakeColumn name columns
  ) => GReadable columns ((S1 (MetaSel (Just name) a b f)) (Rec0 inputType))
  where
  {-# INLINE gFromColumns #-}
  gFromColumns :: forall p.
ProtocolRevision
-> UVarInt
-> Get [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
gFromColumns ProtocolRevision
rev UVarInt
size = (chType -> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p)
-> [chType]
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall a b. (a -> b) -> [a] -> [b]
map (Rec0 inputType p
-> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 inputType p
 -> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p)
-> (chType -> Rec0 inputType p)
-> chType
-> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. inputType -> Rec0 inputType p
forall k i c (p :: k). c -> K1 i c p
K1 (inputType -> Rec0 inputType p)
-> (chType -> inputType) -> chType -> Rec0 inputType p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @chType) ([chType] -> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p])
-> (Column name chType -> [chType])
-> Column name chType
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column name chType -> [chType]
forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues (Column name chType
 -> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p])
-> Get (Column name chType)
-> Get [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall column.
DeserializableColumn column =>
ProtocolRevision -> UVarInt -> Get column
deserializeColumn @(Column name chType) ProtocolRevision
rev UVarInt
size
  gReadingColumns :: Builder
gReadingColumns = forall column. KnownColumn column => Builder
renderColumnName @(Column name chType)

-- ***

-- ** 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 (columns :: [*]).
KnownColumn (Column name chType) =>
Column name chType
-> Columns columns -> Columns (Column name chType : columns)
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 [LowCardinality chType]
[GetColumnType (Column name (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



-- ** Columns extraction helper

class
  HasColumns hasColumns
  where
  type GetColumns hasColumns :: [Type]

instance HasColumns (Columns columns)
  where
  type GetColumns (Columns columns) = columns


-- ** Take column by name from list of columns

type family
  TakeColumn (name :: Symbol) (columns :: [Type]) :: (Type, [Type])
  where
  TakeColumn name columns = GoTakeColumn name columns '[]

type family
  GoTakeColumn name (columns :: [Type]) (acc :: [Type]) :: (Type, [Type])
  where
  GoTakeColumn name (Column name chType ': columns) acc = '(Column name chType, acc ++ columns)
  GoTakeColumn name (Column name1 chType ': columns) acc = (GoTakeColumn name columns (Column name1 chType ': acc))
  GoTakeColumn name '[]                 acc = TypeError
    (    'Text "There is no column \"" :<>: 'Text name :<>: 'Text "\" in table"
    :$$: 'Text "You can't use this field"
    )

type family
  (++) (list1 :: [Type]) (list2 :: [Type]) :: [Type]
  where
  (++) '[]            list = list
  (++) (head ': tail) list = tail ++ (head ': list)