module ClickHaskell.Columns where

-- Internal
import ClickHaskell.Primitive

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

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

-- * Column

{- |
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
  DateTimeColumn :: [DateTime tz] -> Column name (DateTime tz)
  DateTime64Column :: [DateTime64 precision tz] -> Column name (DateTime64 precision tz)
  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

{-# 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
  (UInt8Column [Word8]
values) -> [chType]
[Word8]
values
  (UInt16Column [Word16]
values) -> [chType]
[Word16]
values
  (UInt32Column [Word32]
values) -> [chType]
[Word32]
values
  (UInt64Column [Word64]
values) -> [chType]
[Word64]
values
  (UInt128Column [Word128]
values) -> [chType]
[Word128]
values
  (Int8Column [Int8]
values) -> [chType]
[Int8]
values
  (Int16Column [Int16]
values) -> [chType]
[Int16]
values
  (Int32Column [Int32]
values) -> [chType]
[Int32]
values
  (Int64Column [Int64]
values) -> [chType]
[Int64]
values
  (Int128Column [Int128]
values) -> [chType]
[Int128]
values
  (DateColumn [Date]
values) -> [chType]
[Date]
values
  (DateTimeColumn [DateTime tz]
values) -> [chType]
[DateTime tz]
values
  (DateTime64Column [DateTime64 precision tz]
values) -> [chType]
[DateTime64 precision tz]
values;
  (UUIDColumn [UUID]
values) -> [chType]
[UUID]
values
  (StringColumn [ChString]
values) -> [chType]
[ChString]
values
  (ArrayColumn [Array chType]
values) -> [chType]
[Array chType]
values
  (NullableColumn [Maybe chType]
values) ->  [chType]
[Maybe chType]
values
  (LowCardinalityColumn [chType]
values) -> (chType -> chType) -> [chType] -> [chType]
forall a b. (a -> b) -> [a] -> [b]
map chType -> chType
forall a b. Coercible a b => a -> b
coerce [chType]
values

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

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

instance KnownSymbol name => KnownColumn (Column name UInt8) where mkColumn :: [GetColumnType (Column name Word8)]
-> Column
     (GetColumnName (Column name Word8))
     (GetColumnType (Column name Word8))
mkColumn = [Word8] -> Column name Word8
[GetColumnType (Column name Word8)]
-> Column
     (GetColumnName (Column name Word8))
     (GetColumnType (Column name Word8))
forall (name :: Symbol). [Word8] -> Column name Word8
UInt8Column
instance KnownSymbol name => KnownColumn (Column name UInt16) where mkColumn :: [GetColumnType (Column name Word16)]
-> Column
     (GetColumnName (Column name Word16))
     (GetColumnType (Column name Word16))
mkColumn = [Word16] -> Column name Word16
[GetColumnType (Column name Word16)]
-> Column
     (GetColumnName (Column name Word16))
     (GetColumnType (Column name Word16))
forall (name :: Symbol). [Word16] -> Column name Word16
UInt16Column
instance KnownSymbol name => KnownColumn (Column name UInt32) where mkColumn :: [GetColumnType (Column name Word32)]
-> Column
     (GetColumnName (Column name Word32))
     (GetColumnType (Column name Word32))
mkColumn = [Word32] -> Column name Word32
[GetColumnType (Column name Word32)]
-> Column
     (GetColumnName (Column name Word32))
     (GetColumnType (Column name Word32))
forall (name :: Symbol). [Word32] -> Column name Word32
UInt32Column
instance KnownSymbol name => KnownColumn (Column name UInt64) where mkColumn :: [GetColumnType (Column name Word64)]
-> Column
     (GetColumnName (Column name Word64))
     (GetColumnType (Column name Word64))
mkColumn = [Word64] -> Column name Word64
[GetColumnType (Column name Word64)]
-> Column
     (GetColumnName (Column name Word64))
     (GetColumnType (Column name Word64))
forall (name :: Symbol). [Word64] -> Column name Word64
UInt64Column
instance KnownSymbol name => KnownColumn (Column name UInt128) where mkColumn :: [GetColumnType (Column name Word128)]
-> Column
     (GetColumnName (Column name Word128))
     (GetColumnType (Column name Word128))
mkColumn = [Word128] -> Column name Word128
[GetColumnType (Column name Word128)]
-> Column
     (GetColumnName (Column name Word128))
     (GetColumnType (Column name Word128))
forall (name :: Symbol). [Word128] -> Column name Word128
UInt128Column
instance KnownSymbol name => KnownColumn (Column name Int8)  where mkColumn :: [GetColumnType (Column name Int8)]
-> Column
     (GetColumnName (Column name Int8))
     (GetColumnType (Column name Int8))
mkColumn = [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
instance KnownSymbol name => KnownColumn (Column name Int16) where mkColumn :: [GetColumnType (Column name Int16)]
-> Column
     (GetColumnName (Column name Int16))
     (GetColumnType (Column name Int16))
mkColumn = [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
instance KnownSymbol name => KnownColumn (Column name Int32) where mkColumn :: [GetColumnType (Column name Int32)]
-> Column
     (GetColumnName (Column name Int32))
     (GetColumnType (Column name Int32))
mkColumn = [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
instance KnownSymbol name => KnownColumn (Column name Int64) where mkColumn :: [GetColumnType (Column name Int64)]
-> Column
     (GetColumnName (Column name Int64))
     (GetColumnType (Column name Int64))
mkColumn = [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
instance KnownSymbol name => KnownColumn (Column name Int128) where mkColumn :: [GetColumnType (Column name Int128)]
-> Column
     (GetColumnName (Column name Int128))
     (GetColumnType (Column name Int128))
mkColumn = [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
instance KnownSymbol name => KnownColumn (Column name Date) where mkColumn :: [GetColumnType (Column name Date)]
-> Column
     (GetColumnName (Column name Date))
     (GetColumnType (Column name Date))
mkColumn = [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
instance
  ( KnownSymbol name
  , IsChType (DateTime tz)
  ) =>
  KnownColumn (Column name (DateTime tz)) where mkColumn :: [GetColumnType (Column name (DateTime tz))]
-> Column
     (GetColumnName (Column name (DateTime tz)))
     (GetColumnType (Column name (DateTime tz)))
mkColumn = [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
instance
  ( KnownSymbol name
  , IsChType (DateTime64 precision tz)
  ) =>
  KnownColumn (Column name (DateTime64 precision tz)) where mkColumn :: [GetColumnType (Column name (DateTime64 precision tz))]
-> Column
     (GetColumnName (Column name (DateTime64 precision tz)))
     (GetColumnType (Column name (DateTime64 precision tz)))
mkColumn = [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
instance KnownSymbol name => KnownColumn (Column name UUID) where mkColumn :: [GetColumnType (Column name UUID)]
-> Column
     (GetColumnName (Column name UUID))
     (GetColumnType (Column name UUID))
mkColumn = [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
instance
  ( KnownSymbol name
  , IsChType chType
  , IsChType (Nullable chType)
  ) =>
  KnownColumn (Column name (Nullable chType)) where mkColumn :: [GetColumnType (Column name (Nullable chType))]
-> Column
     (GetColumnName (Column name (Nullable chType)))
     (GetColumnType (Column name (Nullable chType)))
mkColumn = [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
instance KnownSymbol name => KnownColumn (Column name ChString) where mkColumn :: [GetColumnType (Column name ChString)]
-> Column
     (GetColumnName (Column name ChString))
     (GetColumnType (Column name ChString))
mkColumn = [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
instance
  ( KnownSymbol name
  , IsChType (LowCardinality chType)
  , IsLowCardinalitySupported chType
  ) =>
  KnownColumn (Column name (LowCardinality chType)) where mkColumn :: [GetColumnType (Column name (LowCardinality chType))]
-> Column
     (GetColumnName (Column name (LowCardinality chType)))
     (GetColumnType (Column name (LowCardinality chType)))
mkColumn = [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
instance KnownSymbol name => KnownColumn (Column name (Array ChString)) where mkColumn :: [GetColumnType (Column name (Array ChString))]
-> Column
     (GetColumnName (Column name (Array ChString)))
     (GetColumnType (Column name (Array ChString)))
mkColumn = [Array ChString] -> Column name (Array ChString)
[GetColumnType (Column name (Array ChString))]
-> Column
     (GetColumnName (Column name (Array ChString)))
     (GetColumnType (Column name (Array ChString)))
forall chType (name :: Symbol).
[Array chType] -> Column name (Array chType)
ArrayColumn

-- * Serialization

{- |
  Errors intended to be handled by developers
-} 
data UserError
  = UnmatchedType String
  -- ^ Column type mismatch in data packet
  | UnmatchedColumn String
  -- ^ Column name mismatch in data packet
  | UnmatchedColumnsCount String
  -- ^ Occurs when actual columns count less or more than expected
  deriving (Int -> UserError -> ShowS
[UserError] -> ShowS
UserError -> String
(Int -> UserError -> ShowS)
-> (UserError -> String)
-> ([UserError] -> ShowS)
-> Show UserError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserError -> ShowS
showsPrec :: Int -> UserError -> ShowS
$cshow :: UserError -> String
show :: UserError -> String
$cshowList :: [UserError] -> ShowS
showList :: [UserError] -> ShowS
Show, Show UserError
Typeable UserError
(Typeable UserError, Show UserError) =>
(UserError -> SomeException)
-> (SomeException -> Maybe UserError)
-> (UserError -> String)
-> Exception UserError
SomeException -> Maybe UserError
UserError -> String
UserError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: UserError -> SomeException
toException :: UserError -> SomeException
$cfromException :: SomeException -> Maybe UserError
fromException :: SomeException -> Maybe UserError
$cdisplayException :: UserError -> String
displayException :: UserError -> String
Exception)

class SerializableColumn column where
  deserializeColumn :: ProtocolRevision -> Bool -> UVarInt -> Get (Either UserError column)
  serializeColumn :: ProtocolRevision -> column -> Builder

handleColumnHeader :: forall column . KnownColumn column => ProtocolRevision -> Bool -> Get (Maybe UserError)
handleColumnHeader :: forall column.
KnownColumn column =>
ProtocolRevision -> Bool -> Get (Maybe UserError)
handleColumnHeader ProtocolRevision
rev Bool
isCheckRequired = do
  let expectedColumnName :: ChString
expectedColumnName = (StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString) (forall column. KnownColumn column => Builder
renderColumnName @column)
  ChString
resultColumnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev 
  let expectedType :: ChString
expectedType = (StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString) (forall column. KnownColumn column => Builder
renderColumnType @column)
  ChString
resultType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
  SinceRevision Word8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(UInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
  if Bool -> Bool
not Bool
isCheckRequired 
  then Maybe UserError -> Get (Maybe UserError)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UserError
forall a. Maybe a
Nothing
  else
    if ChString
resultColumnName ChString -> ChString -> Bool
forall a. Eq a => a -> a -> Bool
/= ChString
expectedColumnName
    then Maybe UserError -> Get (Maybe UserError)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UserError -> Get (Maybe UserError))
-> (String -> Maybe UserError) -> String -> Get (Maybe UserError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserError -> Maybe UserError
forall a. a -> Maybe a
Just (UserError -> Maybe UserError)
-> (String -> UserError) -> String -> Maybe UserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UserError
UnmatchedColumn
      (String -> Get (Maybe UserError))
-> String -> Get (Maybe UserError)
forall a b. (a -> b) -> a -> b
$ String
"Got column \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
resultColumnName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\" but expected \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
expectedColumnName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""
    else
      if ChString
resultType ChString -> ChString -> Bool
forall a. Eq a => a -> a -> Bool
/= ChString
expectedType
      then Maybe UserError -> Get (Maybe UserError)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UserError -> Get (Maybe UserError))
-> (String -> Maybe UserError) -> String -> Get (Maybe UserError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserError -> Maybe UserError
forall a. a -> Maybe a
Just (UserError -> Maybe UserError)
-> (String -> UserError) -> String -> Maybe UserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UserError
UnmatchedType
        (String -> Get (Maybe UserError))
-> String -> Get (Maybe UserError)
forall a b. (a -> b) -> a -> b
$  String
"Column " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
resultColumnName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" has type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
resultType String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". But expected type is " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
expectedType
      else Maybe UserError -> Get (Maybe UserError)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UserError
forall a. Maybe a
Nothing

instance
  ( KnownColumn (Column name chType)
  , Deserializable chType
  , Serializable chType
  , IsChType chType
  ) =>
  SerializableColumn (Column name chType) where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: ProtocolRevision
-> Bool -> UVarInt -> Get (Either UserError (Column name chType))
deserializeColumn ProtocolRevision
rev Bool
isCheckRequired UVarInt
rows = do
    Maybe UserError
mErr <- forall column.
KnownColumn column =>
ProtocolRevision -> Bool -> Get (Maybe UserError)
handleColumnHeader @(Column name chType) ProtocolRevision
rev Bool
isCheckRequired
    case Maybe UserError
mErr of
      Just UserError
err -> Either UserError (Column name chType)
-> Get (Either UserError (Column name chType))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserError -> Either UserError (Column name chType)
forall a b. a -> Either a b
Left UserError
err)
      Maybe UserError
Nothing -> do
        Column name chType -> Either UserError (Column name chType)
forall a b. b -> Either a b
Right (Column name chType -> Either UserError (Column name chType))
-> ([chType] -> Column name chType)
-> [chType]
-> Either UserError (Column name chType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name chType)
          ([chType] -> Either UserError (Column name chType))
-> Get [chType] -> Get (Either UserError (Column name chType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UVarInt -> Get chType -> Get [chType]
forall chType. UVarInt -> Get chType -> Get [chType]
replicateGet (UVarInt -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)

  {-# INLINE serializeColumn #-}
  serializeColumn :: ProtocolRevision -> Column name chType -> Builder
serializeColumn ProtocolRevision
rev Column name chType
column
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev ((StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString) (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 ((StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString) (forall column. KnownColumn column => Builder
renderColumnType @(Column name chType)))
    -- serialization is not custom
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (rev :: Nat) monoid.
(KnownNat rev, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UInt8 ProtocolRevision
rev Word8
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))
  , Deserializable chType
  , Serializable chType
  , IsChType chType
  ) =>
  SerializableColumn (Column name (Nullable chType)) where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: ProtocolRevision
-> Bool
-> UVarInt
-> Get (Either UserError (Column name (Nullable chType)))
deserializeColumn ProtocolRevision
rev Bool
isCheckRequired UVarInt
rows = do
    Maybe UserError
mErr <- forall column.
KnownColumn column =>
ProtocolRevision -> Bool -> Get (Maybe UserError)
handleColumnHeader @(Column name (Nullable chType)) ProtocolRevision
rev Bool
isCheckRequired
    case Maybe UserError
mErr of
      Just UserError
err -> Either UserError (Column name (Nullable chType))
-> Get (Either UserError (Column name (Nullable chType)))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserError -> Either UserError (Column name (Nullable chType))
forall a b. a -> Either a b
Left UserError
err)
      Maybe UserError
Nothing -> do 
        [Word8]
nulls <- UVarInt -> Get Word8 -> Get [Word8]
forall chType. UVarInt -> Get chType -> Get [chType]
replicateGet (UVarInt -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UInt8 ProtocolRevision
rev)
        Column name (Nullable chType)
-> Either UserError (Column name (Nullable chType))
forall a b. b -> Either a b
Right (Column name (Nullable chType)
 -> Either UserError (Column name (Nullable chType)))
-> ([Nullable chType] -> Column name (Nullable chType))
-> [Nullable chType]
-> Either UserError (Column name (Nullable chType))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (Nullable chType)) ([Nullable chType]
 -> Either UserError (Column name (Nullable chType)))
-> Get [Nullable chType]
-> Get (Either UserError (Column name (Nullable chType)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          [Word8]
-> (Word8 -> Get (Nullable chType)) -> Get [Nullable chType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
            [Word8]
nulls
            (\case
              Word8
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
              Word8
_ -> (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)
            )

  {-# INLINE serializeColumn #-}
  serializeColumn :: ProtocolRevision -> Column name (Nullable chType) -> Builder
serializeColumn ProtocolRevision
rev Column name (Nullable chType)
column
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev ((StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString) (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 ((StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString) (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 (rev :: Nat) monoid.
(KnownNat rev, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UInt8 ProtocolRevision
rev Word8
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 @UInt8 ProtocolRevision
rev (Word8 -> Builder)
-> (Nullable chType -> Word8) -> Nullable chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> (chType -> Word8) -> Nullable chType -> Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word8
1 (Word8 -> chType -> Word8
forall a b. a -> b -> a
const Word8
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 (LowCardinality chType))
  , Deserializable chType
  , IsLowCardinalitySupported chType
  , TypeError ('Text "LowCardinality deserialization still unsupported")
  ) =>
  SerializableColumn (Column name (LowCardinality chType)) where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: ProtocolRevision
-> Bool
-> UVarInt
-> Get (Either UserError (Column name (LowCardinality chType)))
deserializeColumn ProtocolRevision
rev Bool
isCheckRequired UVarInt
rows = do
    Maybe UserError
mErr <- forall column.
KnownColumn column =>
ProtocolRevision -> Bool -> Get (Maybe UserError)
handleColumnHeader @(Column name (LowCardinality chType)) ProtocolRevision
rev Bool
isCheckRequired
    case Maybe UserError
mErr of
      Just UserError
err -> Either UserError (Column name (LowCardinality chType))
-> Get (Either UserError (Column name (LowCardinality chType)))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserError -> Either UserError (Column name (LowCardinality chType))
forall a b. a -> Either a b
Left UserError
err)
      Maybe UserError
Nothing -> do
        Word64
_serializationType <- (Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xf) (Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UInt64 ProtocolRevision
rev
        Int64
_index_size <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @Int64 ProtocolRevision
rev
        -- error $ "Trace | " <> show _serializationType <> " : " <> show _index_size
        Column name (LowCardinality chType)
-> Either UserError (Column name (LowCardinality chType))
forall a b. b -> Either a b
Right (Column name (LowCardinality chType)
 -> Either UserError (Column name (LowCardinality chType)))
-> ([LowCardinality chType] -> Column name (LowCardinality chType))
-> [LowCardinality chType]
-> Either UserError (Column name (LowCardinality chType))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (LowCardinality chType))
          ([LowCardinality chType]
 -> Either UserError (Column name (LowCardinality chType)))
-> Get [LowCardinality chType]
-> Get (Either UserError (Column name (LowCardinality chType)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UVarInt
-> Get (LowCardinality chType) -> Get [LowCardinality chType]
forall chType. UVarInt -> Get chType -> Get [chType]
replicateGet (UVarInt -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (chType -> LowCardinality chType
forall a b. Coercible a b => a -> b
coerce (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)

  {-# INLINE serializeColumn #-}
  serializeColumn :: ProtocolRevision -> Column name (LowCardinality chType) -> Builder
serializeColumn ProtocolRevision
rev (LowCardinalityColumn [chType]
column)
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev ((StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString) (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 ((StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString) (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 (rev :: Nat) monoid.
(KnownNat rev, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UInt8 ProtocolRevision
rev Word8
0)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [chType] -> Builder
forall a. HasCallStack => a
undefined [chType]
column

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Array chType))
  , Deserializable chType
  , TypeError ('Text "Arrays deserialization still unsupported")
  )
  => SerializableColumn (Column name (Array chType)) where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: ProtocolRevision
-> Bool
-> UVarInt
-> Get (Either UserError (Column name (Array chType)))
deserializeColumn ProtocolRevision
rev Bool
isCheckRequired UVarInt
_rows = do
    Maybe UserError
mErr <- forall column.
KnownColumn column =>
ProtocolRevision -> Bool -> Get (Maybe UserError)
handleColumnHeader @(Column name (Array chType)) ProtocolRevision
rev Bool
isCheckRequired
    case Maybe UserError
mErr of
      Just UserError
err -> Either UserError (Column name (Array chType))
-> Get (Either UserError (Column name (Array chType)))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserError -> Either UserError (Column name (Array chType))
forall a b. a -> Either a b
Left UserError
err)
      Maybe UserError
Nothing -> do
        (Word64
arraySize, [Word64]
_offsets) <- ProtocolRevision -> Get (Word64, [Word64])
readOffsets ProtocolRevision
rev
        [chType]
_types <- UVarInt -> Get chType -> Get [chType]
forall chType. UVarInt -> Get chType -> Get [chType]
replicateGet (Word64 -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
arraySize) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
        Either UserError (Column name (Array chType))
-> Get (Either UserError (Column name (Array chType)))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError (Column name (Array chType))
 -> Get (Either UserError (Column name (Array chType))))
-> (Column
      (GetColumnName (Column name (Array chType)))
      (GetColumnType (Column name (Array chType)))
    -> Either UserError (Column name (Array chType)))
-> Column
     (GetColumnName (Column name (Array chType)))
     (GetColumnType (Column name (Array chType)))
-> Get (Either UserError (Column name (Array chType)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column name (Array chType)
-> Either UserError (Column name (Array chType))
Column
  (GetColumnName (Column name (Array chType)))
  (GetColumnType (Column name (Array chType)))
-> Either UserError (Column name (Array chType))
forall a b. b -> Either a b
Right (Column
   (GetColumnName (Column name (Array chType)))
   (GetColumnType (Column name (Array chType)))
 -> Get (Either UserError (Column name (Array chType))))
-> Column
     (GetColumnName (Column name (Array chType)))
     (GetColumnType (Column name (Array chType)))
-> Get (Either UserError (Column name (Array chType)))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (Array chType)) []
        where
        readOffsets :: ProtocolRevision -> Get (UInt64, [UInt64])
        readOffsets :: ProtocolRevision -> Get (Word64, [Word64])
readOffsets ProtocolRevision
revivion = do
          Word64
size <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UInt64 ProtocolRevision
rev
          (Word64
size, ) ([Word64] -> (Word64, [Word64]))
-> Get [Word64] -> Get (Word64, [Word64])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Get [Word64]
go Word64
size
          where
          go :: Word64 -> Get [Word64]
go Word64
arraySize =
            do
            Word64
nextOffset <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UInt64 ProtocolRevision
revivion
            if Word64
arraySize Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
nextOffset
              then [Word64] -> Get [Word64]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word64
nextOffset]
              else (Word64
nextOffset Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:) ([Word64] -> [Word64]) -> Get [Word64] -> Get [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Get [Word64]
go Word64
arraySize

  {-# INLINE serializeColumn #-}
  serializeColumn :: ProtocolRevision -> Column name (Array chType) -> Builder
serializeColumn ProtocolRevision
_rev Column name (Array chType)
_column = Builder
forall a. HasCallStack => a
undefined