module ClickHaskell.Columns where

-- Internal
import ClickHaskell.Primitive

-- GHC included
import Data.Binary.Get
import Data.ByteString.Builder
import Data.ByteString.Char8 as BS8 (pack, isPrefixOf)
import Data.Traversable (forM)
import Data.Int
import Data.Kind
import Data.Coerce
import Data.Typeable (Proxy (..))
import Data.Bits (Bits ((.&.)))
import GHC.Generics (Generic)
import GHC.TypeLits (ErrorMessage (..), KnownSymbol, Symbol, TypeError, symbolVal)

-- External
import Data.WideWord (Int128 (..))

-- * Column

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

colLen :: Columns columns -> Int
colLen :: forall (columns :: [*]). Columns columns -> Int
colLen (AddColumn (Column name chType
col :: col) Columns columns
_) = [GetColumnType (Column name chType)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([GetColumnType (Column name chType)] -> Int)
-> [GetColumnType (Column name chType)] -> Int
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
Column (GetColumnName column) (GetColumnType column)
-> [GetColumnType column]
fromColumn @col Column name chType
Column
  (GetColumnName (Column name chType))
  (GetColumnType (Column name chType))
col
colLen Columns columns
Empty = Int
0

{- |
Column declaration

For example:

@
type MyColumn = Column "myColumn" ChString
@
-}
data Column (name :: Symbol) (chType :: Type) where
  UInt8Column   :: [UInt8]   -> Column name UInt8
  Int8Column   :: [Int8]   -> Column name Int8
  UInt16Column  :: [UInt16]  -> Column name UInt16
  Int16Column  :: [Int16]  -> Column name Int16
  UInt32Column  :: [UInt32]  -> Column name UInt32
  Int32Column  :: [Int32]  -> Column name Int32
  UInt64Column  :: [UInt64]  -> Column name UInt64
  Int64Column  :: [Int64]  -> Column name Int64
  UInt128Column :: [UInt128] -> Column name UInt128
  Int128Column :: [Int128] -> Column name Int128
  UInt256Column :: [UInt256] -> Column name UInt256
  DateTimeColumn :: [DateTime tz] -> Column name (DateTime tz)
  DateTime64Column :: [DateTime64 precision tz] -> Column name (DateTime64 precision tz)
  BoolColumn :: [Bool] -> Column name Bool
  Enum8Column :: [Enum8 enums] -> Column name (Enum8 enums)
  Enum16Column :: [Enum16 enums] -> Column name (Enum16 enums)
  DateColumn :: [Date] -> Column name Date
  UUIDColumn :: [UUID] -> Column name UUID
  StringColumn :: [ChString] -> Column name ChString
  ArrayColumn :: [Array chType] -> Column name (Array chType)
  NullableColumn :: [Nullable chType] -> Column name (Nullable chType)
  LowCardinalityColumn :: [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

data ColumnHeader = MkColumnHeader
  { ColumnHeader -> ChString
name :: ChString
  , ColumnHeader -> ChString
type_ :: ChString
  , ColumnHeader
-> SinceRevision UInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
is_custom :: UInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
  } deriving ((forall x. ColumnHeader -> Rep ColumnHeader x)
-> (forall x. Rep ColumnHeader x -> ColumnHeader)
-> Generic ColumnHeader
forall x. Rep ColumnHeader x -> ColumnHeader
forall x. ColumnHeader -> Rep ColumnHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnHeader -> Rep ColumnHeader x
from :: forall x. ColumnHeader -> Rep ColumnHeader x
$cto :: forall x. Rep ColumnHeader x -> ColumnHeader
to :: forall x. Rep ColumnHeader x -> ColumnHeader
Generic, ProtocolRevision -> Get ColumnHeader
ProtocolRevision -> ColumnHeader -> Builder
(ProtocolRevision -> ColumnHeader -> Builder)
-> (ProtocolRevision -> Get ColumnHeader)
-> Serializable ColumnHeader
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> ColumnHeader -> Builder
serialize :: ProtocolRevision -> ColumnHeader -> Builder
$cdeserialize :: ProtocolRevision -> Get ColumnHeader
deserialize :: ProtocolRevision -> Get ColumnHeader
Serializable)

fallbackTypeName :: ProtocolRevision -> ChString -> ChString
fallbackTypeName :: ProtocolRevision -> ChString -> ChString
fallbackTypeName ProtocolRevision
rev (MkChString ByteString
typeName) = ByteString -> ChString
MkChString (ByteString -> ChString) -> ByteString -> ChString
forall a b. (a -> b) -> a -> b
$
  if ProtocolRevision
rev ProtocolRevision -> ProtocolRevision -> Bool
forall a. Ord a => a -> a -> Bool
< forall (nat :: Nat). KnownNat nat => ProtocolRevision
mkRev @DBMS_MIN_REVISION_WITH_TIME_ZONE_PARAMETER_IN_DATETIME_DATA_TYPE
    Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
isPrefixOf ByteString
"DateTime(" ByteString
typeName
  then ByteString
"DateTime"
  else ByteString
typeName

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 = ByteString -> Builder
byteString (ByteString -> Builder)
-> (String -> ByteString) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ forall chType. IsChType chType => String
chTypeName @(GetColumnType column)

  mkHeader :: ColumnHeader
  mkHeader = let
    name :: ChString
name = Builder -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnName @column
    type_ :: ChString
type_ = String -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType (String -> ChString) -> String -> ChString
forall a b. (a -> b) -> a -> b
$ forall chType. IsChType chType => String
chTypeName @(GetColumnType column)
    is_custom :: Revisioned revisionNumber b UInt8
is_custom = UInt8 -> Revisioned revisionNumber b UInt8
forall (revisionNumber :: Nat) b a.
a -> Revisioned revisionNumber b a
AfterRevision UInt8
0
    in MkColumnHeader{SinceRevision UInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
ChString
forall {revisionNumber :: Nat} {b}.
Revisioned revisionNumber b UInt8
name :: ChString
type_ :: ChString
is_custom :: SinceRevision UInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
name :: ChString
type_ :: ChString
is_custom :: forall {revisionNumber :: Nat} {b}.
Revisioned revisionNumber b UInt8
..}

  toColumn :: [GetColumnType column] -> Column (GetColumnName column) (GetColumnType column)
  fromColumn :: Column (GetColumnName column) (GetColumnType column) -> [GetColumnType column]

instance KnownSymbol name => KnownColumn (Column name UInt8) where
  toColumn :: [GetColumnType (Column name UInt8)]
-> Column
     (GetColumnName (Column name UInt8))
     (GetColumnType (Column name UInt8))
toColumn = [UInt8] -> Column name UInt8
[GetColumnType (Column name UInt8)]
-> Column
     (GetColumnName (Column name UInt8))
     (GetColumnType (Column name UInt8))
forall (name :: Symbol). [UInt8] -> Column name UInt8
UInt8Column
  fromColumn :: Column
  (GetColumnName (Column name UInt8))
  (GetColumnType (Column name UInt8))
-> [GetColumnType (Column name UInt8)]
fromColumn (UInt8Column [UInt8]
values) = [UInt8]
[GetColumnType (Column name UInt8)]
values

instance KnownSymbol name => KnownColumn (Column name UInt16) where
  toColumn :: [GetColumnType (Column name UInt16)]
-> Column
     (GetColumnName (Column name UInt16))
     (GetColumnType (Column name UInt16))
toColumn = [UInt16] -> Column name UInt16
[GetColumnType (Column name UInt16)]
-> Column
     (GetColumnName (Column name UInt16))
     (GetColumnType (Column name UInt16))
forall (name :: Symbol). [UInt16] -> Column name UInt16
UInt16Column
  fromColumn :: Column
  (GetColumnName (Column name UInt16))
  (GetColumnType (Column name UInt16))
-> [GetColumnType (Column name UInt16)]
fromColumn (UInt16Column [UInt16]
values) = [UInt16]
[GetColumnType (Column name UInt16)]
values

instance KnownSymbol name => KnownColumn (Column name UInt32) where
  toColumn :: [GetColumnType (Column name UInt32)]
-> Column
     (GetColumnName (Column name UInt32))
     (GetColumnType (Column name UInt32))
toColumn = [UInt32] -> Column name UInt32
[GetColumnType (Column name UInt32)]
-> Column
     (GetColumnName (Column name UInt32))
     (GetColumnType (Column name UInt32))
forall (name :: Symbol). [UInt32] -> Column name UInt32
UInt32Column
  fromColumn :: Column
  (GetColumnName (Column name UInt32))
  (GetColumnType (Column name UInt32))
-> [GetColumnType (Column name UInt32)]
fromColumn (UInt32Column [UInt32]
values) = [UInt32]
[GetColumnType (Column name UInt32)]
values

instance KnownSymbol name => KnownColumn (Column name UInt64) where
  toColumn :: [GetColumnType (Column name UInt64)]
-> Column
     (GetColumnName (Column name UInt64))
     (GetColumnType (Column name UInt64))
toColumn = [UInt64] -> Column name UInt64
[GetColumnType (Column name UInt64)]
-> Column
     (GetColumnName (Column name UInt64))
     (GetColumnType (Column name UInt64))
forall (name :: Symbol). [UInt64] -> Column name UInt64
UInt64Column
  fromColumn :: Column
  (GetColumnName (Column name UInt64))
  (GetColumnType (Column name UInt64))
-> [GetColumnType (Column name UInt64)]
fromColumn (UInt64Column [UInt64]
values) = [UInt64]
[GetColumnType (Column name UInt64)]
values

instance KnownSymbol name => KnownColumn (Column name UInt128) where
  toColumn :: [GetColumnType (Column name UInt128)]
-> Column
     (GetColumnName (Column name UInt128))
     (GetColumnType (Column name UInt128))
toColumn = [UInt128] -> Column name UInt128
[GetColumnType (Column name UInt128)]
-> Column
     (GetColumnName (Column name UInt128))
     (GetColumnType (Column name UInt128))
forall (name :: Symbol). [UInt128] -> Column name UInt128
UInt128Column
  fromColumn :: Column
  (GetColumnName (Column name UInt128))
  (GetColumnType (Column name UInt128))
-> [GetColumnType (Column name UInt128)]
fromColumn (UInt128Column [UInt128]
values) = [UInt128]
[GetColumnType (Column name UInt128)]
values

instance KnownSymbol name => KnownColumn (Column name UInt256) where
  toColumn :: [GetColumnType (Column name UInt256)]
-> Column
     (GetColumnName (Column name UInt256))
     (GetColumnType (Column name UInt256))
toColumn = [UInt256] -> Column name UInt256
[GetColumnType (Column name UInt256)]
-> Column
     (GetColumnName (Column name UInt256))
     (GetColumnType (Column name UInt256))
forall (name :: Symbol). [UInt256] -> Column name UInt256
UInt256Column
  fromColumn :: Column
  (GetColumnName (Column name UInt256))
  (GetColumnType (Column name UInt256))
-> [GetColumnType (Column name UInt256)]
fromColumn (UInt256Column [UInt256]
values) = [UInt256]
[GetColumnType (Column name UInt256)]
values

instance KnownSymbol name => KnownColumn (Column name Int8)  where
  toColumn :: [GetColumnType (Column name Int8)]
-> Column
     (GetColumnName (Column name Int8))
     (GetColumnType (Column name Int8))
toColumn = [Int8] -> Column name Int8
[GetColumnType (Column name Int8)]
-> Column
     (GetColumnName (Column name Int8))
     (GetColumnType (Column name Int8))
forall (name :: Symbol). [Int8] -> Column name Int8
Int8Column
  fromColumn :: Column
  (GetColumnName (Column name Int8))
  (GetColumnType (Column name Int8))
-> [GetColumnType (Column name Int8)]
fromColumn (Int8Column [Int8]
values) = [Int8]
[GetColumnType (Column name Int8)]
values

instance KnownSymbol name => KnownColumn (Column name Int16) where
  toColumn :: [GetColumnType (Column name Int16)]
-> Column
     (GetColumnName (Column name Int16))
     (GetColumnType (Column name Int16))
toColumn = [Int16] -> Column name Int16
[GetColumnType (Column name Int16)]
-> Column
     (GetColumnName (Column name Int16))
     (GetColumnType (Column name Int16))
forall (name :: Symbol). [Int16] -> Column name Int16
Int16Column
  fromColumn :: Column
  (GetColumnName (Column name Int16))
  (GetColumnType (Column name Int16))
-> [GetColumnType (Column name Int16)]
fromColumn (Int16Column [Int16]
values) = [Int16]
[GetColumnType (Column name Int16)]
values

instance KnownSymbol name => KnownColumn (Column name Int32) where
  toColumn :: [GetColumnType (Column name Int32)]
-> Column
     (GetColumnName (Column name Int32))
     (GetColumnType (Column name Int32))
toColumn = [Int32] -> Column name Int32
[GetColumnType (Column name Int32)]
-> Column
     (GetColumnName (Column name Int32))
     (GetColumnType (Column name Int32))
forall (name :: Symbol). [Int32] -> Column name Int32
Int32Column
  fromColumn :: Column
  (GetColumnName (Column name Int32))
  (GetColumnType (Column name Int32))
-> [GetColumnType (Column name Int32)]
fromColumn (Int32Column [Int32]
values) = [Int32]
[GetColumnType (Column name Int32)]
values

instance KnownSymbol name => KnownColumn (Column name Int64) where
  toColumn :: [GetColumnType (Column name Int64)]
-> Column
     (GetColumnName (Column name Int64))
     (GetColumnType (Column name Int64))
toColumn = [Int64] -> Column name Int64
[GetColumnType (Column name Int64)]
-> Column
     (GetColumnName (Column name Int64))
     (GetColumnType (Column name Int64))
forall (name :: Symbol). [Int64] -> Column name Int64
Int64Column
  fromColumn :: Column
  (GetColumnName (Column name Int64))
  (GetColumnType (Column name Int64))
-> [GetColumnType (Column name Int64)]
fromColumn (Int64Column [Int64]
values) = [Int64]
[GetColumnType (Column name Int64)]
values

instance KnownSymbol name => KnownColumn (Column name Int128) where
  toColumn :: [GetColumnType (Column name Int128)]
-> Column
     (GetColumnName (Column name Int128))
     (GetColumnType (Column name Int128))
toColumn = [Int128] -> Column name Int128
[GetColumnType (Column name Int128)]
-> Column
     (GetColumnName (Column name Int128))
     (GetColumnType (Column name Int128))
forall (name :: Symbol). [Int128] -> Column name Int128
Int128Column
  fromColumn :: Column
  (GetColumnName (Column name Int128))
  (GetColumnType (Column name Int128))
-> [GetColumnType (Column name Int128)]
fromColumn (Int128Column [Int128]
values) = [Int128]
[GetColumnType (Column name Int128)]
values

instance KnownSymbol name => KnownColumn (Column name Date) where
  toColumn :: [GetColumnType (Column name Date)]
-> Column
     (GetColumnName (Column name Date))
     (GetColumnType (Column name Date))
toColumn = [Date] -> Column name Date
[GetColumnType (Column name Date)]
-> Column
     (GetColumnName (Column name Date))
     (GetColumnType (Column name Date))
forall (name :: Symbol). [Date] -> Column name Date
DateColumn
  fromColumn :: Column
  (GetColumnName (Column name Date))
  (GetColumnType (Column name Date))
-> [GetColumnType (Column name Date)]
fromColumn (DateColumn [Date]
values) = [Date]
[GetColumnType (Column name Date)]
values

instance
  ( KnownSymbol name
  , IsChType (DateTime tz)
  ) =>
  KnownColumn (Column name (DateTime tz))
  where
  toColumn :: [GetColumnType (Column name (DateTime tz))]
-> Column
     (GetColumnName (Column name (DateTime tz)))
     (GetColumnType (Column name (DateTime tz)))
toColumn = [DateTime tz] -> Column name (DateTime tz)
[GetColumnType (Column name (DateTime tz))]
-> Column
     (GetColumnName (Column name (DateTime tz)))
     (GetColumnType (Column name (DateTime tz)))
forall (chType :: Symbol) (name :: Symbol).
[DateTime chType] -> Column name (DateTime chType)
DateTimeColumn
  fromColumn :: Column
  (GetColumnName (Column name (DateTime tz)))
  (GetColumnType (Column name (DateTime tz)))
-> [GetColumnType (Column name (DateTime tz))]
fromColumn (DateTimeColumn [DateTime tz]
values) = [DateTime tz]
[GetColumnType (Column name (DateTime tz))]
values

instance
  ( KnownSymbol name
  , IsChType (DateTime64 precision tz)
  ) =>
  KnownColumn (Column name (DateTime64 precision tz))
  where
  toColumn :: [GetColumnType (Column name (DateTime64 precision tz))]
-> Column
     (GetColumnName (Column name (DateTime64 precision tz)))
     (GetColumnType (Column name (DateTime64 precision tz)))
toColumn = [DateTime64 precision tz] -> Column name (DateTime64 precision tz)
[GetColumnType (Column name (DateTime64 precision tz))]
-> Column
     (GetColumnName (Column name (DateTime64 precision tz)))
     (GetColumnType (Column name (DateTime64 precision tz)))
forall (chType :: Nat) (tz :: Symbol) (name :: Symbol).
[DateTime64 chType tz] -> Column name (DateTime64 chType tz)
DateTime64Column
  fromColumn :: Column
  (GetColumnName (Column name (DateTime64 precision tz)))
  (GetColumnType (Column name (DateTime64 precision tz)))
-> [GetColumnType (Column name (DateTime64 precision tz))]
fromColumn (DateTime64Column [DateTime64 precision tz]
values) = [DateTime64 precision tz]
[GetColumnType (Column name (DateTime64 precision tz))]
values

instance
  ( KnownSymbol name
  , IsChType Bool
  ) =>
  KnownColumn (Column name Bool)
  where
  toColumn :: [GetColumnType (Column name Bool)]
-> Column
     (GetColumnName (Column name Bool))
     (GetColumnType (Column name Bool))
toColumn = [Bool] -> Column name Bool
[GetColumnType (Column name Bool)]
-> Column
     (GetColumnName (Column name Bool))
     (GetColumnType (Column name Bool))
forall (name :: Symbol). [Bool] -> Column name Bool
BoolColumn
  fromColumn :: Column
  (GetColumnName (Column name Bool))
  (GetColumnType (Column name Bool))
-> [GetColumnType (Column name Bool)]
fromColumn (BoolColumn [Bool]
values) = [Bool]
[GetColumnType (Column name Bool)]
values

instance (KnownSymbol name, KnownSymbol enums) => KnownColumn (Column name (Enum8 enums)) where
  toColumn :: [GetColumnType (Column name (Enum8 enums))]
-> Column
     (GetColumnName (Column name (Enum8 enums)))
     (GetColumnType (Column name (Enum8 enums)))
toColumn = [Enum8 enums] -> Column name (Enum8 enums)
[GetColumnType (Column name (Enum8 enums))]
-> Column
     (GetColumnName (Column name (Enum8 enums)))
     (GetColumnType (Column name (Enum8 enums)))
forall (chType :: Symbol) (name :: Symbol).
[Enum8 chType] -> Column name (Enum8 chType)
Enum8Column
  fromColumn :: Column
  (GetColumnName (Column name (Enum8 enums)))
  (GetColumnType (Column name (Enum8 enums)))
-> [GetColumnType (Column name (Enum8 enums))]
fromColumn (Enum8Column [Enum8 enums]
values) = [Enum8 enums]
[GetColumnType (Column name (Enum8 enums))]
values

instance (KnownSymbol name, KnownSymbol enums) => KnownColumn (Column name (Enum16 enums)) where
  toColumn :: [GetColumnType (Column name (Enum16 enums))]
-> Column
     (GetColumnName (Column name (Enum16 enums)))
     (GetColumnType (Column name (Enum16 enums)))
toColumn = [Enum16 enums] -> Column name (Enum16 enums)
[GetColumnType (Column name (Enum16 enums))]
-> Column
     (GetColumnName (Column name (Enum16 enums)))
     (GetColumnType (Column name (Enum16 enums)))
forall (chType :: Symbol) (name :: Symbol).
[Enum16 chType] -> Column name (Enum16 chType)
Enum16Column
  fromColumn :: Column
  (GetColumnName (Column name (Enum16 enums)))
  (GetColumnType (Column name (Enum16 enums)))
-> [GetColumnType (Column name (Enum16 enums))]
fromColumn (Enum16Column [Enum16 enums]
values) = [Enum16 enums]
[GetColumnType (Column name (Enum16 enums))]
values

instance KnownSymbol name => KnownColumn (Column name UUID) where
  toColumn :: [GetColumnType (Column name UUID)]
-> Column
     (GetColumnName (Column name UUID))
     (GetColumnType (Column name UUID))
toColumn = [UUID] -> Column name UUID
[GetColumnType (Column name UUID)]
-> Column
     (GetColumnName (Column name UUID))
     (GetColumnType (Column name UUID))
forall (name :: Symbol). [UUID] -> Column name UUID
UUIDColumn
  fromColumn :: Column
  (GetColumnName (Column name UUID))
  (GetColumnType (Column name UUID))
-> [GetColumnType (Column name UUID)]
fromColumn (UUIDColumn [UUID]
values) = [UUID]
[GetColumnType (Column name UUID)]
values

instance
  ( KnownSymbol name
  , IsChType chType
  , IsChType (Nullable chType)
  ) =>
  KnownColumn (Column name (Nullable chType))
  where
  toColumn :: [GetColumnType (Column name (Nullable chType))]
-> Column
     (GetColumnName (Column name (Nullable chType)))
     (GetColumnType (Column name (Nullable chType)))
toColumn = [Nullable chType] -> Column name (Nullable chType)
[GetColumnType (Column name (Nullable chType))]
-> Column
     (GetColumnName (Column name (Nullable chType)))
     (GetColumnType (Column name (Nullable chType)))
forall chType (name :: Symbol).
[Nullable chType] -> Column name (Nullable chType)
NullableColumn
  fromColumn :: Column
  (GetColumnName (Column name (Nullable chType)))
  (GetColumnType (Column name (Nullable chType)))
-> [GetColumnType (Column name (Nullable chType))]
fromColumn (NullableColumn [Maybe chType]
values)  = [Maybe chType]
[GetColumnType (Column name (Nullable chType))]
values

instance KnownSymbol name => KnownColumn (Column name ChString) where
  toColumn :: [GetColumnType (Column name ChString)]
-> Column
     (GetColumnName (Column name ChString))
     (GetColumnType (Column name ChString))
toColumn = [ChString] -> Column name ChString
[GetColumnType (Column name ChString)]
-> Column
     (GetColumnName (Column name ChString))
     (GetColumnType (Column name ChString))
forall (name :: Symbol). [ChString] -> Column name ChString
StringColumn
  fromColumn :: Column
  (GetColumnName (Column name ChString))
  (GetColumnType (Column name ChString))
-> [GetColumnType (Column name ChString)]
fromColumn (StringColumn [ChString]
values) = [ChString]
[GetColumnType (Column name ChString)]
values

instance
  ( KnownSymbol name
  , IsChType (LowCardinality chType)
  , IsLowCardinalitySupported chType
  ) =>
  KnownColumn (Column name (LowCardinality chType))
  where
  toColumn :: [GetColumnType (Column name (LowCardinality chType))]
-> Column
     (GetColumnName (Column name (LowCardinality chType)))
     (GetColumnType (Column name (LowCardinality chType)))
toColumn = [chType] -> Column name (LowCardinality chType)
forall chType (name :: Symbol).
[chType] -> Column name (LowCardinality chType)
LowCardinalityColumn ([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 a b. Coercible a b => a -> b
coerce
  fromColumn :: Column
  (GetColumnName (Column name (LowCardinality chType)))
  (GetColumnType (Column name (LowCardinality chType)))
-> [GetColumnType (Column name (LowCardinality chType))]
fromColumn (LowCardinalityColumn [chType]
values) = (chType -> LowCardinality chType)
-> [chType] -> [LowCardinality chType]
forall a b. (a -> b) -> [a] -> [b]
map chType -> LowCardinality chType
forall a b. Coercible a b => a -> b
coerce [chType]
values

instance (KnownSymbol name, IsChType chType) => KnownColumn (Column name (Array chType)) where
  toColumn :: [GetColumnType (Column name (Array chType))]
-> Column
     (GetColumnName (Column name (Array chType)))
     (GetColumnType (Column name (Array chType)))
toColumn = [Array chType] -> Column name (Array chType)
[GetColumnType (Column name (Array chType))]
-> Column
     (GetColumnName (Column name (Array chType)))
     (GetColumnType (Column name (Array chType)))
forall chType (name :: Symbol).
[Array chType] -> Column name (Array chType)
ArrayColumn
  fromColumn :: Column
  (GetColumnName (Column name (Array chType)))
  (GetColumnType (Column name (Array chType)))
-> [GetColumnType (Column name (Array chType))]
fromColumn (ArrayColumn [Array chType]
values) = [Array chType]
[GetColumnType (Column name (Array chType))]
values


class KnownColumn column => SerializableColumn column where
  deserializeColumn :: ProtocolRevision -> UVarInt -> (GetColumnType column -> a) -> Get [a]
  serializeColumn :: ProtocolRevision -> (a -> GetColumnType column) -> [a] -> Builder

instance
  ( KnownColumn (Column name chType)
  , Serializable chType
  , IsChType chType
  ) =>
  SerializableColumn (Column name chType) where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: forall a.
ProtocolRevision
-> UVarInt -> (GetColumnType (Column name chType) -> a) -> Get [a]
deserializeColumn ProtocolRevision
rev UVarInt
rows GetColumnType (Column name chType) -> a
f = (chType -> a) -> [chType] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map chType -> a
GetColumnType (Column name chType) -> a
f ([chType] -> [a]) -> Get [chType] -> Get [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> UVarInt -> Get [chType]
forall chType.
Serializable chType =>
ProtocolRevision -> UVarInt -> Get [chType]
replicateGet ProtocolRevision
rev UVarInt
rows

  {-# INLINE serializeColumn #-}
  serializeColumn :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name chType)) -> [a] -> Builder
serializeColumn ProtocolRevision
rev a -> GetColumnType (Column name chType)
f [a]
column = (a -> Builder) -> [a] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @chType ProtocolRevision
rev (chType -> Builder) -> (a -> chType) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> chType
a -> GetColumnType (Column name chType)
f) [a]
column

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Nullable chType))
  , Serializable chType
  , IsChType chType
  ) =>
  SerializableColumn (Column name (Nullable chType)) where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: forall a.
ProtocolRevision
-> UVarInt
-> (GetColumnType (Column name (Nullable chType)) -> a)
-> Get [a]
deserializeColumn ProtocolRevision
rev UVarInt
rows GetColumnType (Column name (Nullable chType)) -> a
f = do
    nulls <- forall chType.
Serializable chType =>
ProtocolRevision -> UVarInt -> Get [chType]
replicateGet @UInt8 ProtocolRevision
rev UVarInt
rows
    forM nulls (\UInt8
nulFlag -> case UInt8
nulFlag of
        UInt8
0 -> Nullable chType -> a
GetColumnType (Column name (Nullable chType)) -> a
f (Nullable chType -> a)
-> (chType -> Nullable chType) -> chType -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> Nullable chType
forall a. a -> Maybe a
Just (chType -> a) -> Get chType -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev
        UInt8
_ -> (GetColumnType (Column name (Nullable chType)) -> a
f Nullable chType
GetColumnType (Column name (Nullable chType))
forall a. Maybe a
Nothing a -> Get chType -> Get a
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
      )

  {-# INLINE serializeColumn #-}
  serializeColumn :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name (Nullable chType)))
-> [a]
-> Builder
serializeColumn ProtocolRevision
rev a -> GetColumnType (Column name (Nullable chType))
f [a]
column
    =  (a -> Builder) -> [a] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UInt8 ProtocolRevision
rev (UInt8 -> Builder) -> (a -> UInt8) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt8 -> (chType -> UInt8) -> Nullable chType -> UInt8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UInt8
1 (UInt8 -> chType -> UInt8
forall a b. a -> b -> a
const UInt8
0) (Nullable chType -> UInt8) -> (a -> Nullable chType) -> a -> UInt8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Nullable chType
a -> GetColumnType (Column name (Nullable chType))
f) [a]
column
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> [a] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @chType ProtocolRevision
rev (chType -> Builder) -> (a -> chType) -> a -> 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 (Nullable chType -> chType)
-> (a -> Nullable chType) -> a -> chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Nullable chType
a -> GetColumnType (Column name (Nullable chType))
f) [a]
column

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (LowCardinality chType))
  , Serializable chType
  , IsLowCardinalitySupported chType
  , TypeError ('Text "LowCardinality deserialization still unsupported")
  ) =>
  SerializableColumn (Column name (LowCardinality chType)) where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: forall a.
ProtocolRevision
-> UVarInt
-> (GetColumnType (Column name (LowCardinality chType)) -> a)
-> Get [a]
deserializeColumn ProtocolRevision
rev UVarInt
rows GetColumnType (Column name (LowCardinality chType)) -> a
f = do
    _serializationType <- (UInt64 -> UInt64 -> UInt64
forall a. Bits a => a -> a -> a
.&. UInt64
0xf) (UInt64 -> UInt64) -> Get UInt64 -> Get UInt64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UInt64 ProtocolRevision
rev
    _index_size <- deserialize @Int64 rev
    -- error $ "Trace | " <> show _serializationType <> " : " <> show _index_size
    map f . coerce
      <$> replicateGet @chType rev rows

  {-# INLINE serializeColumn #-}
  serializeColumn :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name (LowCardinality chType)))
-> [a]
-> Builder
serializeColumn ProtocolRevision
_rev a -> GetColumnType (Column name (LowCardinality chType))
column = (a -> LowCardinality chType) -> [a] -> Builder
forall a. HasCallStack => a
undefined a -> LowCardinality chType
a -> GetColumnType (Column name (LowCardinality chType))
column

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Array chType))
  , Serializable chType
  )
  => SerializableColumn (Column name (Array chType)) where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: forall a.
ProtocolRevision
-> UVarInt
-> (GetColumnType (Column name (Array chType)) -> a)
-> Get [a]
deserializeColumn ProtocolRevision
rev UVarInt
rows GetColumnType (Column name (Array chType)) -> a
f = do
    offsets <- forall chType.
Serializable chType =>
ProtocolRevision -> UVarInt -> Get [chType]
replicateGet @UInt64 ProtocolRevision
rev UVarInt
rows
    forM offsets (fmap (f . MkChArray) . replicateGet @chType rev . fromIntegral)

  {-# INLINE serializeColumn #-}
  serializeColumn :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name (Array chType)))
-> [a]
-> Builder
serializeColumn ProtocolRevision
rev a -> GetColumnType (Column name (Array chType))
f [a]
column
    =  (a -> Builder) -> [a] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UInt64 ProtocolRevision
rev (UInt64 -> Builder) -> (a -> UInt64) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UInt64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt64) -> (a -> Int) -> a -> UInt64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array chType -> Int
forall a. Array a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Array chType -> Int) -> (a -> Array chType) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Array chType
a -> GetColumnType (Column name (Array chType))
f) [a]
column
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> [a] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((chType -> Builder) -> Array chType -> Builder
forall m a. Monoid m => (a -> m) -> Array a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @chType ProtocolRevision
rev) (Array chType -> Builder) -> (a -> Array chType) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Array chType
a -> GetColumnType (Column name (Array chType))
f) [a]
column