module ClickHaskell.Protocol.Data where

-- Internal
import ClickHaskell.Primitive

-- GHC
import Control.Exception (Exception)
import Control.Monad (forM, when)
import Data.Binary (Get)
import Data.Bits ((.&.))
import Data.ByteString (isPrefixOf)
import Data.ByteString.Builder (Builder, byteString, stringUtf8)
import Data.ByteString.Char8 as BS8 (pack)
import Data.Coerce (coerce)
import Data.Data (Proxy (..))
import Data.Int
import Data.Kind (Type)
import Data.List (mapAccumL)
import GHC.Generics
import GHC.TypeError
import GHC.TypeLits

-------------------------------------------------------------------------------
-- * Data packet
-------------------------------------------------------------------------------

data DataPacket = MkDataPacket
  { DataPacket -> ChString
table_name    :: ChString
  , DataPacket -> BlockInfo
block_info    :: BlockInfo
  , DataPacket -> UVarInt
columns_count :: UVarInt
  , DataPacket -> UVarInt
rows_count    :: UVarInt
  }
  deriving ((forall x. DataPacket -> Rep DataPacket x)
-> (forall x. Rep DataPacket x -> DataPacket) -> Generic DataPacket
forall x. Rep DataPacket x -> DataPacket
forall x. DataPacket -> Rep DataPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DataPacket -> Rep DataPacket x
from :: forall x. DataPacket -> Rep DataPacket x
$cto :: forall x. Rep DataPacket x -> DataPacket
to :: forall x. Rep DataPacket x -> DataPacket
Generic, ProtocolRevision -> Get DataPacket
ProtocolRevision -> DataPacket -> Builder
(ProtocolRevision -> DataPacket -> Builder)
-> (ProtocolRevision -> Get DataPacket) -> Serializable DataPacket
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> DataPacket -> Builder
serialize :: ProtocolRevision -> DataPacket -> Builder
$cdeserialize :: ProtocolRevision -> Get DataPacket
deserialize :: ProtocolRevision -> Get DataPacket
Serializable)

mkDataPacket :: ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket :: ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
table_name UVarInt
columns_count UVarInt
rows_count =
  MkDataPacket
      { ChString
table_name :: ChString
table_name :: ChString
table_name
      , block_info :: BlockInfo
block_info    = MkBlockInfo
        { field_num1 :: UVarInt
field_num1   = UVarInt
1, is_overflows :: UInt8
is_overflows = UInt8
0
        , field_num2 :: UVarInt
field_num2   = UVarInt
2, bucket_num :: Int32
bucket_num   = -Int32
1
        , eof :: UVarInt
eof          = UVarInt
0
        }
      , UVarInt
columns_count :: UVarInt
columns_count :: UVarInt
columns_count
      , UVarInt
rows_count :: UVarInt
rows_count :: UVarInt
rows_count
      }

data BlockInfo = MkBlockInfo
  { BlockInfo -> UVarInt
field_num1   :: UVarInt, BlockInfo -> UInt8
is_overflows :: UInt8
  , BlockInfo -> UVarInt
field_num2   :: UVarInt, BlockInfo -> Int32
bucket_num   :: Int32
  , BlockInfo -> UVarInt
eof          :: UVarInt
  }
  deriving ((forall x. BlockInfo -> Rep BlockInfo x)
-> (forall x. Rep BlockInfo x -> BlockInfo) -> Generic BlockInfo
forall x. Rep BlockInfo x -> BlockInfo
forall x. BlockInfo -> Rep BlockInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockInfo -> Rep BlockInfo x
from :: forall x. BlockInfo -> Rep BlockInfo x
$cto :: forall x. Rep BlockInfo x -> BlockInfo
to :: forall x. Rep BlockInfo x -> BlockInfo
Generic, ProtocolRevision -> Get BlockInfo
ProtocolRevision -> BlockInfo -> Builder
(ProtocolRevision -> BlockInfo -> Builder)
-> (ProtocolRevision -> Get BlockInfo) -> Serializable BlockInfo
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> BlockInfo -> Builder
serialize :: ProtocolRevision -> BlockInfo -> Builder
$cdeserialize :: ProtocolRevision -> Get BlockInfo
deserialize :: ProtocolRevision -> Get BlockInfo
Serializable)




-------------------------------------------------------------------------------
-- * Columns
-------------------------------------------------------------------------------

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) 

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 = 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)

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)

mkHeader :: forall column . KnownColumn column => ColumnHeader
mkHeader :: forall column. KnownColumn column => 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
..}

type ErrorHandler = UserError -> Get ()

validateColumnHeader :: forall column . KnownColumn column => ErrorHandler -> ProtocolRevision -> ColumnHeader -> Get ()
validateColumnHeader :: forall column.
KnownColumn column =>
ErrorHandler -> ProtocolRevision -> ColumnHeader -> Get ()
validateColumnHeader ErrorHandler
errHandler ProtocolRevision
rev MkColumnHeader{SinceRevision UInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
ChString
name :: ColumnHeader -> ChString
type_ :: ColumnHeader -> ChString
is_custom :: ColumnHeader
-> SinceRevision UInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
name :: ChString
type_ :: ChString
is_custom :: SinceRevision UInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
..} = do
  let expectedColumnName :: ChString
expectedColumnName = Builder -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType (forall column. KnownColumn column => Builder
renderColumnName @column)
      resultColumnName :: ChString
resultColumnName = ChString
name
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChString
resultColumnName ChString -> ChString -> Bool
forall a. Eq a => a -> a -> Bool
/= ChString
expectedColumnName) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
    ErrorHandler
errHandler ErrorHandler -> (String -> UserError) -> String -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UserError
UnmatchedColumn
      (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Got column \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
resultColumnName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" but expected \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
expectedColumnName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\""

  let expectedType :: ChString
expectedType = ProtocolRevision -> ChString -> ChString
fallbackTypeName ProtocolRevision
rev (ChString -> ChString) -> ChString -> ChString
forall a b. (a -> b) -> a -> b
$ Builder -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType (forall column. KnownColumn column => Builder
renderColumnType @column)
      resultType :: ChString
resultType = ProtocolRevision -> ChString -> ChString
fallbackTypeName ProtocolRevision
rev ChString
type_
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChString
resultType ChString -> ChString -> Bool
forall a. Eq a => a -> a -> Bool
/= ChString
expectedType) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
    ErrorHandler
errHandler ErrorHandler -> (String -> UserError) -> String -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UserError
UnmatchedType
      (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Column " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
resultColumnName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" has type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
resultType String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". But expected type is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChString -> String
forall a. Show a => a -> String
show ChString
expectedType

fallbackTypeName :: ProtocolRevision -> ChString -> ChString
fallbackTypeName :: ProtocolRevision -> ChString -> ChString
fallbackTypeName ProtocolRevision
rev ChString
typeName = forall chType userType.
ToChType chType userType =>
userType -> chType
toChType @ChString (ChString -> ChString) -> ChString -> 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(" (ChString -> ByteString
forall chType userType.
ToChType chType userType =>
chType -> userType
fromChType ChString
typeName)
  then ChString
"DateTime"
  else ChString
typeName

{- |
  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 -> String -> String
[UserError] -> String -> String
UserError -> String
(Int -> UserError -> String -> String)
-> (UserError -> String)
-> ([UserError] -> String -> String)
-> Show UserError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UserError -> String -> String
showsPrec :: Int -> UserError -> String -> String
$cshow :: UserError -> String
show :: UserError -> String
$cshowList :: [UserError] -> String -> String
showList :: [UserError] -> String -> String
Show, Show UserError
Typeable UserError
(Typeable UserError, Show UserError) =>
(UserError -> SomeException)
-> (SomeException -> Maybe UserError)
-> (UserError -> String)
-> (UserError -> Bool)
-> Exception UserError
SomeException -> Maybe UserError
UserError -> Bool
UserError -> String
UserError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: UserError -> SomeException
toException :: UserError -> SomeException
$cfromException :: SomeException -> Maybe UserError
fromException :: SomeException -> Maybe UserError
$cdisplayException :: UserError -> String
displayException :: UserError -> String
$cbacktraceDesired :: UserError -> Bool
backtraceDesired :: UserError -> Bool
Exception)




-------------------------------------------------------------------------------
-- * Columns serialization
-------------------------------------------------------------------------------

type ErrHandler = UserError -> Get ()

ignoreErr :: ErrHandler
ignoreErr :: ErrorHandler
ignoreErr UserError
_ = () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

class SerializableColumn col where
  {-# INLINE deserializeColumn #-}
  deserializeColumn :: KnownColumn col => ErrHandler -> ProtocolRevision -> UVarInt -> (GetColumnType col -> res) -> Get [res]
  deserializeColumn ErrorHandler
errHandler ProtocolRevision
rev UVarInt
size GetColumnType col -> res
f = do
    forall column.
KnownColumn column =>
ErrorHandler -> ProtocolRevision -> ColumnHeader -> Get ()
validateColumnHeader @col ErrorHandler
errHandler ProtocolRevision
rev (ColumnHeader -> Get ()) -> Get ColumnHeader -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @ColumnHeader ProtocolRevision
rev
    forall col a.
SerializableColumn col =>
ProtocolRevision -> UVarInt -> (GetColumnType col -> a) -> Get [a]
deserializeColumnI @col ProtocolRevision
rev UVarInt
size GetColumnType col -> res
f
  
  {-# INLINE serializeColumn #-}
  serializeColumn :: KnownColumn col => ProtocolRevision -> (a -> GetColumnType col) -> [a] -> Builder
  serializeColumn ProtocolRevision
rev a -> GetColumnType col
f [a]
values =
    ProtocolRevision -> ColumnHeader -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall column. KnownColumn column => ColumnHeader
mkHeader @col) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    forall col a.
SerializableColumn col =>
ProtocolRevision -> (a -> GetColumnType col) -> [a] -> Builder
serializeColumnI @col ProtocolRevision
rev (a -> GetColumnType col
f) [a]
values

  deserializeColumnI :: ProtocolRevision -> UVarInt -> (GetColumnType col -> a) -> Get [a]
  serializeColumnI :: ProtocolRevision -> (a -> GetColumnType col) -> [a] -> Builder

instance (IsChType chType, KnownSymbol name) => KnownColumn (Column name chType)

instance
  ( Serializable chType
  , IsChType chType
  ) =>
  SerializableColumn (Column name chType) where
  {-# INLINE deserializeColumnI #-}
  deserializeColumnI :: forall a.
ProtocolRevision
-> UVarInt -> (GetColumnType (Column name chType) -> a) -> Get [a]
deserializeColumnI 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 serializeColumnI #-}
  serializeColumnI :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name chType)) -> [a] -> Builder
serializeColumnI 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 deserializeColumnI #-}
  deserializeColumnI :: forall a.
ProtocolRevision
-> UVarInt
-> (GetColumnType (Column name (Nullable chType)) -> a)
-> Get [a]
deserializeColumnI 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 serializeColumnI #-}
  serializeColumnI :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name (Nullable chType)))
-> [a]
-> Builder
serializeColumnI 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 deserializeColumnI #-}
  deserializeColumnI :: forall a.
ProtocolRevision
-> UVarInt
-> (GetColumnType (Column name (LowCardinality chType)) -> a)
-> Get [a]
deserializeColumnI 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 serializeColumnI #-}
  serializeColumnI :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name (LowCardinality chType)))
-> [a]
-> Builder
serializeColumnI 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 deserializeColumnI #-}
  deserializeColumnI :: forall a.
ProtocolRevision
-> UVarInt
-> (GetColumnType (Column name (Array chType)) -> a)
-> Get [a]
deserializeColumnI 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
    let lengths = (UInt64 -> UInt64 -> UInt64) -> [UInt64] -> [UInt64] -> [UInt64]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [UInt64]
offsets (UInt64
0 UInt64 -> [UInt64] -> [UInt64]
forall a. a -> [a] -> [a]
: ([UInt64] -> [UInt64]
forall a. HasCallStack => [a] -> [a]
init [UInt64]
offsets))
    forM lengths (fmap (f . MkChArray) . replicateGet @chType rev . fromIntegral)

  {-# INLINE serializeColumnI #-}
  serializeColumnI :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name (Array chType)))
-> [a]
-> Builder
serializeColumnI ProtocolRevision
rev a -> GetColumnType (Column name (Array chType))
f [a]
column
    =  (UInt64 -> Builder) -> [UInt64] -> 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]
offsets
    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
    where
    offsets :: [UInt64]
offsets =
      (UInt64, [UInt64]) -> [UInt64]
forall a b. (a, b) -> b
snd ((UInt64, [UInt64]) -> [UInt64]) -> (UInt64, [UInt64]) -> [UInt64]
forall a b. (a -> b) -> a -> b
$
        (UInt64 -> Array chType -> (UInt64, UInt64))
-> UInt64 -> [Array chType] -> (UInt64, [UInt64])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
          (\UInt64
offset Array chType
xs ->
            let nextOffset :: UInt64
nextOffset = UInt64
offset UInt64 -> UInt64 -> UInt64
forall a. Num a => a -> a -> a
+ Int -> UInt64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Array chType -> Int
forall a. Array a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Array chType
xs)
            in (UInt64
nextOffset, UInt64
nextOffset)
          )
          UInt64
0
          ((a -> Array chType) -> [a] -> [Array chType]
forall a b. (a -> b) -> [a] -> [b]
map a -> Array chType
a -> GetColumnType (Column name (Array chType))
f [a]
column)

instance {-# OVERLAPPING #-}
  ( KnownSymbol name
  , IsChType chType
  , TypeError ('Text "Nested Arrays types (column \"" :<>: 'Text name :<>: 'Text "\") are unsupported")
  )
  => SerializableColumn (Column name (Array (Array chType)))
  where
  deserializeColumnI :: forall a.
ProtocolRevision
-> UVarInt
-> (GetColumnType (Column name (Array (Array chType))) -> a)
-> Get [a]
deserializeColumnI = String
-> ProtocolRevision
-> UVarInt
-> (Array (Array chType) -> a)
-> Get [a]
forall a. HasCallStack => String -> a
error String
"Impossible"
  serializeColumnI :: forall a.
ProtocolRevision
-> (a -> GetColumnType (Column name (Array (Array chType))))
-> [a]
-> Builder
serializeColumnI = String
-> ProtocolRevision
-> (a -> Array (Array chType))
-> [a]
-> Builder
forall a. HasCallStack => String -> a
error String
"Impossible"