{-# LANGUAGE
    ConstraintKinds
  , DuplicateRecordFields
  , GeneralizedNewtypeDeriving
  , LambdaCase
  , TupleSections
  , OverloadedStrings
  , RecordWildCards
  , NoFieldSelectors
#-}

{-# OPTIONS_GHC
  -Wno-orphans
#-}

module ClickHaskell.NativeProtocol where

-- Internal dependencies
import Paths_ClickHaskell (version)

-- GHC included
import Control.DeepSeq (NFData)
import Control.Monad (forM, replicateM, (<$!>))
import Data.Binary.Get
import Data.Binary.Get.Internal (readN)
import Data.Binary.Put
import Data.Bits
import Data.ByteString as BS (StrictByteString, length, take, toStrict)
import Data.ByteString.Builder (Builder, byteString, stringUtf8, word8)
import Data.ByteString.Builder as BS (Builder, byteString, toLazyByteString)
import Data.ByteString.Char8 as BS8 (concatMap, length, pack, replicate, singleton)
import Data.Coerce (coerce)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Constraint, Type)
import Data.List (uncons)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text.Encoding as Text (encodeUtf8)
import Data.Time (UTCTime, ZonedTime, zonedTimeToUTC)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Data.Typeable (Proxy (..))
import Data.Vector.Primitive.Mutable (Prim)
import Data.Version (Version (..))
import Data.Word (Word16, Word32, Word8)
import Debug.Trace (traceShowId)
import GHC.Generics
import GHC.TypeLits (AppendSymbol, ErrorMessage (..), KnownNat, KnownSymbol, Nat, Symbol, TypeError, natVal, symbolVal)
import GHC.Word (Word64)

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

-- * Compatibility

latestSupportedRevision :: ProtocolRevision
latestSupportedRevision :: ProtocolRevision
latestSupportedRevision = ProtocolRevision
mostRecentRevision

-- * Client packets

data ClientPacketType
  = Hello
  | Query
  | Data
  | Cancel
  | Ping
  | TablesStatusRequest
  | KeepAlive
  | Scalar
  | IgnoredPartUUIDs
  | ReadTaskResponse
  | MergeTreeReadTaskResponse
  | SSHChallengeRequest
  | SSHChallengeResponse
  deriving (Int -> ClientPacketType
ClientPacketType -> Int
ClientPacketType -> [ClientPacketType]
ClientPacketType -> ClientPacketType
ClientPacketType -> ClientPacketType -> [ClientPacketType]
ClientPacketType
-> ClientPacketType -> ClientPacketType -> [ClientPacketType]
(ClientPacketType -> ClientPacketType)
-> (ClientPacketType -> ClientPacketType)
-> (Int -> ClientPacketType)
-> (ClientPacketType -> Int)
-> (ClientPacketType -> [ClientPacketType])
-> (ClientPacketType -> ClientPacketType -> [ClientPacketType])
-> (ClientPacketType -> ClientPacketType -> [ClientPacketType])
-> (ClientPacketType
    -> ClientPacketType -> ClientPacketType -> [ClientPacketType])
-> Enum ClientPacketType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ClientPacketType -> ClientPacketType
succ :: ClientPacketType -> ClientPacketType
$cpred :: ClientPacketType -> ClientPacketType
pred :: ClientPacketType -> ClientPacketType
$ctoEnum :: Int -> ClientPacketType
toEnum :: Int -> ClientPacketType
$cfromEnum :: ClientPacketType -> Int
fromEnum :: ClientPacketType -> Int
$cenumFrom :: ClientPacketType -> [ClientPacketType]
enumFrom :: ClientPacketType -> [ClientPacketType]
$cenumFromThen :: ClientPacketType -> ClientPacketType -> [ClientPacketType]
enumFromThen :: ClientPacketType -> ClientPacketType -> [ClientPacketType]
$cenumFromTo :: ClientPacketType -> ClientPacketType -> [ClientPacketType]
enumFromTo :: ClientPacketType -> ClientPacketType -> [ClientPacketType]
$cenumFromThenTo :: ClientPacketType
-> ClientPacketType -> ClientPacketType -> [ClientPacketType]
enumFromThenTo :: ClientPacketType
-> ClientPacketType -> ClientPacketType -> [ClientPacketType]
Enum, Int -> ClientPacketType -> ShowS
[ClientPacketType] -> ShowS
ClientPacketType -> String
(Int -> ClientPacketType -> ShowS)
-> (ClientPacketType -> String)
-> ([ClientPacketType] -> ShowS)
-> Show ClientPacketType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientPacketType -> ShowS
showsPrec :: Int -> ClientPacketType -> ShowS
$cshow :: ClientPacketType -> String
show :: ClientPacketType -> String
$cshowList :: [ClientPacketType] -> ShowS
showList :: [ClientPacketType] -> ShowS
Show)

type family PacketTypeNumber (packetType :: ClientPacketType)
  where
  PacketTypeNumber Hello = 0
  PacketTypeNumber Query = 1
  PacketTypeNumber Data = 2
  PacketTypeNumber Cancel = 3
  PacketTypeNumber Ping = 4
  PacketTypeNumber TablesStatusRequest = 5
  PacketTypeNumber KeepAlive = 6
  PacketTypeNumber Scalar = 7
  PacketTypeNumber IgnoredPartUUIDs = 8
  PacketTypeNumber ReadTaskResponse = 9
  PacketTypeNumber MergeTreeReadTaskResponse = 10
  PacketTypeNumber SSHChallengeRequest = 11
  PacketTypeNumber SSHChallengeResponse = 12

data Packet (packetType :: ClientPacketType) = MkPacket
instance KnownNat (PacketTypeNumber packetType) => Show (Packet (packetType :: ClientPacketType)) where
  show :: Packet packetType -> String
show Packet packetType
_ = ClientPacketType -> String
forall a. Show a => a -> String
show (ClientPacketType -> String)
-> (UVarInt -> ClientPacketType) -> UVarInt -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum @ClientPacketType (Int -> ClientPacketType)
-> (UVarInt -> Int) -> UVarInt -> ClientPacketType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UVarInt -> String) -> UVarInt -> String
forall a b. (a -> b) -> a -> b
$ forall (packetType :: ClientPacketType).
KnownNat (PacketTypeNumber packetType) =>
UVarInt
packetNumVal @packetType

packetNumVal :: forall packetType . KnownNat (PacketTypeNumber packetType) => UVarInt
packetNumVal :: forall (packetType :: ClientPacketType).
KnownNat (PacketTypeNumber packetType) =>
UVarInt
packetNumVal = Integer -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> UVarInt)
-> (Proxy (PacketTypeNumber packetType) -> Integer)
-> Proxy (PacketTypeNumber packetType)
-> UVarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (PacketTypeNumber packetType) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (PacketTypeNumber packetType) -> UVarInt)
-> Proxy (PacketTypeNumber packetType) -> UVarInt
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(PacketTypeNumber packetType)

instance
  KnownNat (PacketTypeNumber packetType)
  =>
  Serializable (Packet (packetType :: ClientPacketType)) where
  serialize :: ProtocolRevision -> Packet packetType -> Builder
serialize ProtocolRevision
rev Packet packetType
_ = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (forall (packetType :: ClientPacketType).
KnownNat (PacketTypeNumber packetType) =>
UVarInt
packetNumVal @packetType)

instance Deserializable (Packet (packetType :: ClientPacketType)) where
  deserialize :: ProtocolRevision -> Get (Packet packetType)
deserialize ProtocolRevision
_rev = Packet packetType -> Get (Packet packetType)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (packetType :: ClientPacketType). Packet packetType
MkPacket @packetType)


-- ** Hello

data HelloParameters = MkHelloParameters
  { HelloParameters -> Text
chDatabase :: Text
  , HelloParameters -> Text
chLogin :: Text
  , HelloParameters -> Text
chPass :: Text
  }

mkHelloPacket :: HelloParameters -> HelloPacket
mkHelloPacket :: HelloParameters -> HelloPacket
mkHelloPacket MkHelloParameters{Text
$sel:chDatabase:MkHelloParameters :: HelloParameters -> Text
chDatabase :: Text
chDatabase, Text
$sel:chLogin:MkHelloParameters :: HelloParameters -> Text
chLogin :: Text
chLogin, Text
$sel:chPass:MkHelloParameters :: HelloParameters -> Text
chPass :: Text
chPass} =
  MkHelloPacket
    { $sel:packet_type:MkHelloPacket :: Packet 'Hello
packet_type          = Packet 'Hello
forall (packetType :: ClientPacketType). Packet packetType
MkPacket
    , ChString
$sel:client_name:MkHelloPacket :: ChString
client_name :: ChString
client_name, UVarInt
$sel:client_version_major:MkHelloPacket :: UVarInt
client_version_major :: UVarInt
client_version_major, UVarInt
$sel:client_version_minor:MkHelloPacket :: UVarInt
client_version_minor :: UVarInt
client_version_minor
    , $sel:tcp_protocol_version:MkHelloPacket :: ProtocolRevision
tcp_protocol_version = ProtocolRevision
latestSupportedRevision
    , $sel:default_database:MkHelloPacket :: ChString
default_database     = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
chDatabase
    , $sel:user:MkHelloPacket :: ChString
user                 = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
chLogin
    , $sel:password:MkHelloPacket :: ChString
password             = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
chPass
    }

data HelloPacket = MkHelloPacket
  { HelloPacket -> Packet 'Hello
packet_type          :: Packet Hello
  , HelloPacket -> ChString
client_name          :: ChString
  , HelloPacket -> UVarInt
client_version_major :: UVarInt
  , HelloPacket -> UVarInt
client_version_minor :: UVarInt
  , HelloPacket -> ProtocolRevision
tcp_protocol_version :: ProtocolRevision
  , HelloPacket -> ChString
default_database     :: ChString
  , HelloPacket -> ChString
user                 :: ChString
  , HelloPacket -> ChString
password             :: ChString
  }
  deriving ((forall x. HelloPacket -> Rep HelloPacket x)
-> (forall x. Rep HelloPacket x -> HelloPacket)
-> Generic HelloPacket
forall x. Rep HelloPacket x -> HelloPacket
forall x. HelloPacket -> Rep HelloPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HelloPacket -> Rep HelloPacket x
from :: forall x. HelloPacket -> Rep HelloPacket x
$cto :: forall x. Rep HelloPacket x -> HelloPacket
to :: forall x. Rep HelloPacket x -> HelloPacket
Generic, ProtocolRevision -> HelloPacket -> Builder
(ProtocolRevision -> HelloPacket -> Builder)
-> Serializable HelloPacket
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> HelloPacket -> Builder
serialize :: ProtocolRevision -> HelloPacket -> Builder
Serializable)


mkAddendum :: Addendum
mkAddendum :: Addendum
mkAddendum = MkAddendum
  { $sel:quota_key:MkAddendum :: SinceRevision ChString DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
quota_key = ChString
-> SinceRevision ChString DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
  }

data Addendum = MkAddendum
  { Addendum
-> SinceRevision ChString DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
quota_key :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
  }
  deriving ((forall x. Addendum -> Rep Addendum x)
-> (forall x. Rep Addendum x -> Addendum) -> Generic Addendum
forall x. Rep Addendum x -> Addendum
forall x. Addendum -> Rep Addendum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Addendum -> Rep Addendum x
from :: forall x. Addendum -> Rep Addendum x
$cto :: forall x. Rep Addendum x -> Addendum
to :: forall x. Rep Addendum x -> Addendum
Generic, ProtocolRevision -> Addendum -> Builder
(ProtocolRevision -> Addendum -> Builder) -> Serializable Addendum
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> Addendum -> Builder
serialize :: ProtocolRevision -> Addendum -> Builder
Serializable)


-- ** Ping

mkPingPacket :: PingPacket
mkPingPacket :: PingPacket
mkPingPacket = MkPingPacket{$sel:packet_type:MkPingPacket :: Packet 'Ping
packet_type = Packet 'Ping
forall (packetType :: ClientPacketType). Packet packetType
MkPacket}

data PingPacket = MkPingPacket{PingPacket -> Packet 'Ping
packet_type :: Packet Ping}
  deriving ((forall x. PingPacket -> Rep PingPacket x)
-> (forall x. Rep PingPacket x -> PingPacket) -> Generic PingPacket
forall x. Rep PingPacket x -> PingPacket
forall x. PingPacket -> Rep PingPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PingPacket -> Rep PingPacket x
from :: forall x. PingPacket -> Rep PingPacket x
$cto :: forall x. Rep PingPacket x -> PingPacket
to :: forall x. Rep PingPacket x -> PingPacket
Generic, ProtocolRevision -> PingPacket -> Builder
(ProtocolRevision -> PingPacket -> Builder)
-> Serializable PingPacket
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> PingPacket -> Builder
serialize :: ProtocolRevision -> PingPacket -> Builder
Serializable)


-- ** Query

mkQueryPacket :: ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket :: ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
chosenRev ChString
user ChString
query = MkQueryPacket
  { $sel:query_packet:MkQueryPacket :: Packet 'Query
query_packet = Packet 'Query
forall (packetType :: ClientPacketType). Packet packetType
MkPacket
  , $sel:query_id:MkQueryPacket :: ChString
query_id = ChString
""
  , $sel:client_info:MkQueryPacket :: SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
client_info                    = ClientInfo
-> SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision MkClientInfo
    { $sel:query_kind:MkClientInfo :: QueryKind
query_kind                   = QueryKind
InitialQuery
    , $sel:initial_user:MkClientInfo :: ChString
initial_user                 = ChString
user
    , $sel:initial_query_id:MkClientInfo :: ChString
initial_query_id             = ChString
""
    , $sel:initial_adress:MkClientInfo :: ChString
initial_adress               = ChString
"0.0.0.0:0"
    , $sel:initial_time:MkClientInfo :: SinceRevision
  ChInt64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
initial_time                 = ChInt64
-> SinceRevision
     ChInt64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChInt64
0
    , $sel:interface_type:MkClientInfo :: ChUInt8
interface_type               = ChUInt8
1 -- [tcp - 1, http - 2]
    , $sel:os_user:MkClientInfo :: ChString
os_user                      = ChString
"dmitry"
    , $sel:hostname:MkClientInfo :: ChString
hostname                     = ChString
"desktop"
    , ChString
client_name :: ChString
$sel:client_name:MkClientInfo :: ChString
client_name, UVarInt
client_version_major :: UVarInt
$sel:client_version_major:MkClientInfo :: UVarInt
client_version_major, UVarInt
client_version_minor :: UVarInt
$sel:client_version_minor:MkClientInfo :: UVarInt
client_version_minor
    , $sel:client_revision:MkClientInfo :: ProtocolRevision
client_revision              = ProtocolRevision
chosenRev
    , $sel:quota_key:MkClientInfo :: SinceRevision
  ChString DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
quota_key                    = ChString
-> SinceRevision
     ChString DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
    , $sel:distrubuted_depth:MkClientInfo :: SinceRevision UVarInt DBMS_TCP_PROTOCOL_VERSION
distrubuted_depth            = UVarInt -> SinceRevision UVarInt DBMS_TCP_PROTOCOL_VERSION
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
$sel:client_version_patch:MkClientInfo :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_patch :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_patch
    , $sel:open_telemetry:MkClientInfo :: SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
open_telemetry               = ChUInt8
-> SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChUInt8
0
    , $sel:collaborate_with_initiator:MkClientInfo :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
collaborate_with_initiator   = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , $sel:count_participating_replicas:MkClientInfo :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
count_participating_replicas = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , $sel:number_of_current_replica:MkClientInfo :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
number_of_current_replica    = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    }
  , $sel:settings:MkQueryPacket :: DbSettings
settings           = DbSettings
MkDbSettings
  , $sel:interserver_secret:MkQueryPacket :: SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
interserver_secret = ChString
-> SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
  , $sel:query_stage:MkQueryPacket :: QueryStage
query_stage        = QueryStage
Complete
  , $sel:compression:MkQueryPacket :: UVarInt
compression        = UVarInt
0
  , $sel:query:MkQueryPacket :: ChString
query              = ChString
query
  , $sel:parameters:MkQueryPacket :: SinceRevision
  QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
parameters         = QueryParameters
-> SinceRevision
     QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision QueryParameters
MkQueryParameters
  }

data QueryPacket = MkQueryPacket
  { QueryPacket -> Packet 'Query
query_packet       :: Packet Query
  , QueryPacket -> ChString
query_id           :: ChString
  , QueryPacket
-> SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
client_info        :: ClientInfo `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_INFO
  , QueryPacket -> DbSettings
settings           :: DbSettings
  , QueryPacket
-> SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
interserver_secret :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
  , QueryPacket -> QueryStage
query_stage        :: QueryStage
  , QueryPacket -> UVarInt
compression        :: UVarInt
  , QueryPacket -> ChString
query              :: ChString
  , QueryPacket
-> SinceRevision
     QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
parameters         :: QueryParameters `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
  }
  deriving ((forall x. QueryPacket -> Rep QueryPacket x)
-> (forall x. Rep QueryPacket x -> QueryPacket)
-> Generic QueryPacket
forall x. Rep QueryPacket x -> QueryPacket
forall x. QueryPacket -> Rep QueryPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QueryPacket -> Rep QueryPacket x
from :: forall x. QueryPacket -> Rep QueryPacket x
$cto :: forall x. Rep QueryPacket x -> QueryPacket
to :: forall x. Rep QueryPacket x -> QueryPacket
Generic, ProtocolRevision -> QueryPacket -> Builder
(ProtocolRevision -> QueryPacket -> Builder)
-> Serializable QueryPacket
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> QueryPacket -> Builder
serialize :: ProtocolRevision -> QueryPacket -> Builder
Serializable)

data DbSettings = MkDbSettings
instance Serializable DbSettings where serialize :: ProtocolRevision -> DbSettings -> Builder
serialize ProtocolRevision
rev DbSettings
_ = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChString ProtocolRevision
rev ChString
""

data QueryParameters = MkQueryParameters
instance Serializable QueryParameters where serialize :: ProtocolRevision -> QueryParameters -> Builder
serialize ProtocolRevision
rev QueryParameters
_ = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChString ProtocolRevision
rev ChString
""

data QueryStage
  = FetchColumns
  | WithMergeableState
  | Complete
  | WithMergeableStateAfterAggregation
  | WithMergeableStateAfterAggregationAndLimit
  deriving (Int -> QueryStage
QueryStage -> Int
QueryStage -> [QueryStage]
QueryStage -> QueryStage
QueryStage -> QueryStage -> [QueryStage]
QueryStage -> QueryStage -> QueryStage -> [QueryStage]
(QueryStage -> QueryStage)
-> (QueryStage -> QueryStage)
-> (Int -> QueryStage)
-> (QueryStage -> Int)
-> (QueryStage -> [QueryStage])
-> (QueryStage -> QueryStage -> [QueryStage])
-> (QueryStage -> QueryStage -> [QueryStage])
-> (QueryStage -> QueryStage -> QueryStage -> [QueryStage])
-> Enum QueryStage
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: QueryStage -> QueryStage
succ :: QueryStage -> QueryStage
$cpred :: QueryStage -> QueryStage
pred :: QueryStage -> QueryStage
$ctoEnum :: Int -> QueryStage
toEnum :: Int -> QueryStage
$cfromEnum :: QueryStage -> Int
fromEnum :: QueryStage -> Int
$cenumFrom :: QueryStage -> [QueryStage]
enumFrom :: QueryStage -> [QueryStage]
$cenumFromThen :: QueryStage -> QueryStage -> [QueryStage]
enumFromThen :: QueryStage -> QueryStage -> [QueryStage]
$cenumFromTo :: QueryStage -> QueryStage -> [QueryStage]
enumFromTo :: QueryStage -> QueryStage -> [QueryStage]
$cenumFromThenTo :: QueryStage -> QueryStage -> QueryStage -> [QueryStage]
enumFromThenTo :: QueryStage -> QueryStage -> QueryStage -> [QueryStage]
Enum)

instance Serializable QueryStage where
  serialize :: ProtocolRevision -> QueryStage -> Builder
serialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (UVarInt -> Builder)
-> (QueryStage -> UVarInt) -> QueryStage -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> (QueryStage -> Int) -> QueryStage -> UVarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryStage -> Int
forall a. Enum a => a -> Int
fromEnum

queryStageCode :: QueryStage -> UVarInt
queryStageCode :: QueryStage -> UVarInt
queryStageCode = Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> (QueryStage -> Int) -> QueryStage -> UVarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryStage -> Int
forall a. Enum a => a -> Int
fromEnum

data Flags = IMPORTANT | CUSTOM | OBSOLETE
flagCode :: Flags -> ChUInt64
flagCode :: Flags -> ChUInt64
flagCode Flags
IMPORTANT = ChUInt64
0x01
flagCode Flags
CUSTOM    = ChUInt64
0x02
flagCode Flags
OBSOLETE  = ChUInt64
0x04

data ClientInfo = MkClientInfo
  { ClientInfo -> QueryKind
query_kind                   :: QueryKind
  , ClientInfo -> ChString
initial_user                 :: ChString
  , ClientInfo -> ChString
initial_query_id             :: ChString
  , ClientInfo -> ChString
initial_adress               :: ChString
  , ClientInfo
-> SinceRevision
     ChInt64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
initial_time                 :: ChInt64 `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
  , ClientInfo -> ChUInt8
interface_type               :: ChUInt8
  , ClientInfo -> ChString
os_user                      :: ChString
  , ClientInfo -> ChString
hostname                     :: ChString
  , ClientInfo -> ChString
client_name                  :: ChString
  , ClientInfo -> UVarInt
client_version_major         :: UVarInt
  , ClientInfo -> UVarInt
client_version_minor         :: UVarInt
  , ClientInfo -> ProtocolRevision
client_revision              :: ProtocolRevision
  , ClientInfo
-> SinceRevision
     ChString DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
quota_key                    :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
  , ClientInfo -> SinceRevision UVarInt DBMS_TCP_PROTOCOL_VERSION
distrubuted_depth            :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
  , ClientInfo
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_patch         :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_VERSION_PATCH
  , ClientInfo
-> SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
open_telemetry               :: ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_OPENTELEMETRY
  , ClientInfo
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
collaborate_with_initiator   :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
  , ClientInfo
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
count_participating_replicas :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
  , ClientInfo
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
number_of_current_replica    :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
  }
  deriving ((forall x. ClientInfo -> Rep ClientInfo x)
-> (forall x. Rep ClientInfo x -> ClientInfo) -> Generic ClientInfo
forall x. Rep ClientInfo x -> ClientInfo
forall x. ClientInfo -> Rep ClientInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientInfo -> Rep ClientInfo x
from :: forall x. ClientInfo -> Rep ClientInfo x
$cto :: forall x. Rep ClientInfo x -> ClientInfo
to :: forall x. Rep ClientInfo x -> ClientInfo
Generic, ProtocolRevision -> ClientInfo -> Builder
(ProtocolRevision -> ClientInfo -> Builder)
-> Serializable ClientInfo
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> ClientInfo -> Builder
serialize :: ProtocolRevision -> ClientInfo -> Builder
Serializable)

data QueryKind = NoQuery | InitialQuery | SecondaryQuery
  deriving (Int -> QueryKind
QueryKind -> Int
QueryKind -> [QueryKind]
QueryKind -> QueryKind
QueryKind -> QueryKind -> [QueryKind]
QueryKind -> QueryKind -> QueryKind -> [QueryKind]
(QueryKind -> QueryKind)
-> (QueryKind -> QueryKind)
-> (Int -> QueryKind)
-> (QueryKind -> Int)
-> (QueryKind -> [QueryKind])
-> (QueryKind -> QueryKind -> [QueryKind])
-> (QueryKind -> QueryKind -> [QueryKind])
-> (QueryKind -> QueryKind -> QueryKind -> [QueryKind])
-> Enum QueryKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: QueryKind -> QueryKind
succ :: QueryKind -> QueryKind
$cpred :: QueryKind -> QueryKind
pred :: QueryKind -> QueryKind
$ctoEnum :: Int -> QueryKind
toEnum :: Int -> QueryKind
$cfromEnum :: QueryKind -> Int
fromEnum :: QueryKind -> Int
$cenumFrom :: QueryKind -> [QueryKind]
enumFrom :: QueryKind -> [QueryKind]
$cenumFromThen :: QueryKind -> QueryKind -> [QueryKind]
enumFromThen :: QueryKind -> QueryKind -> [QueryKind]
$cenumFromTo :: QueryKind -> QueryKind -> [QueryKind]
enumFromTo :: QueryKind -> QueryKind -> [QueryKind]
$cenumFromThenTo :: QueryKind -> QueryKind -> QueryKind -> [QueryKind]
enumFromThenTo :: QueryKind -> QueryKind -> QueryKind -> [QueryKind]
Enum)

instance Serializable QueryKind where
  serialize :: ProtocolRevision -> QueryKind -> Builder
serialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev (ChUInt8 -> Builder)
-> (QueryKind -> ChUInt8) -> QueryKind -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ChUInt8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ChUInt8) -> (QueryKind -> Int) -> QueryKind -> ChUInt8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryKind -> Int
forall a. Enum a => a -> Int
fromEnum


-- ** Data

mkDataPacket :: ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket :: ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
table_name UVarInt
columns_count UVarInt
rows_count =
  MkDataPacket
    { $sel:packet_type:MkDataPacket :: Packet 'Data
packet_type   = Packet 'Data
forall (packetType :: ClientPacketType). Packet packetType
MkPacket
    , ChString
table_name :: ChString
$sel:table_name:MkDataPacket :: ChString
table_name
    , $sel:block_info:MkDataPacket :: BlockInfo
block_info    = MkBlockInfo
      { $sel:field_num1:MkBlockInfo :: UVarInt
field_num1   = UVarInt
1, $sel:is_overflows:MkBlockInfo :: ChUInt8
is_overflows = ChUInt8
0
      , $sel:field_num2:MkBlockInfo :: UVarInt
field_num2   = UVarInt
2, $sel:bucket_num:MkBlockInfo :: ChInt32
bucket_num   = -ChInt32
1
      , $sel:eof:MkBlockInfo :: UVarInt
eof          = UVarInt
0
      }
    , UVarInt
columns_count :: UVarInt
$sel:columns_count:MkDataPacket :: UVarInt
columns_count
    , UVarInt
rows_count :: UVarInt
$sel:rows_count:MkDataPacket :: UVarInt
rows_count
    }

data DataPacket = MkDataPacket
  { DataPacket -> Packet 'Data
packet_type   :: Packet Data
  , 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 -> DataPacket -> Builder
(ProtocolRevision -> DataPacket -> Builder)
-> Serializable DataPacket
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> DataPacket -> Builder
serialize :: ProtocolRevision -> DataPacket -> Builder
Serializable, ProtocolRevision -> Get DataPacket
(ProtocolRevision -> Get DataPacket) -> Deserializable DataPacket
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get DataPacket
deserialize :: ProtocolRevision -> Get DataPacket
Deserializable, Int -> DataPacket -> ShowS
[DataPacket] -> ShowS
DataPacket -> String
(Int -> DataPacket -> ShowS)
-> (DataPacket -> String)
-> ([DataPacket] -> ShowS)
-> Show DataPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataPacket -> ShowS
showsPrec :: Int -> DataPacket -> ShowS
$cshow :: DataPacket -> String
show :: DataPacket -> String
$cshowList :: [DataPacket] -> ShowS
showList :: [DataPacket] -> ShowS
Show)

data BlockInfo = MkBlockInfo
  { BlockInfo -> UVarInt
field_num1   :: UVarInt, BlockInfo -> ChUInt8
is_overflows :: ChUInt8
  , BlockInfo -> UVarInt
field_num2   :: UVarInt, BlockInfo -> ChInt32
bucket_num   :: ChInt32
  , 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 -> BlockInfo -> Builder
(ProtocolRevision -> BlockInfo -> Builder)
-> Serializable BlockInfo
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> BlockInfo -> Builder
serialize :: ProtocolRevision -> BlockInfo -> Builder
Serializable, ProtocolRevision -> Get BlockInfo
(ProtocolRevision -> Get BlockInfo) -> Deserializable BlockInfo
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get BlockInfo
deserialize :: ProtocolRevision -> Get BlockInfo
Deserializable, Int -> BlockInfo -> ShowS
[BlockInfo] -> ShowS
BlockInfo -> String
(Int -> BlockInfo -> ShowS)
-> (BlockInfo -> String)
-> ([BlockInfo] -> ShowS)
-> Show BlockInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockInfo -> ShowS
showsPrec :: Int -> BlockInfo -> ShowS
$cshow :: BlockInfo -> String
show :: BlockInfo -> String
$cshowList :: [BlockInfo] -> ShowS
showList :: [BlockInfo] -> ShowS
Show)




-- * Server packets

data ServerPacketType where
  HelloResponse :: HelloResponse -> ServerPacketType
  DataResponse :: DataPacket -> ServerPacketType
  Exception :: ExceptionPacket -> ServerPacketType
  Progress :: ProgressPacket -> ServerPacketType
  Pong :: ServerPacketType
  EndOfStream :: ServerPacketType
  ProfileInfo :: ProfileInfo -> ServerPacketType
  Totals :: ServerPacketType
  Extremes :: ServerPacketType
  TablesStatusResponse :: ServerPacketType
  Log :: ServerPacketType
  TableColumns :: TableColumns -> ServerPacketType
  UUIDs :: ServerPacketType
  ReadTaskRequest :: ServerPacketType
  ProfileEvents :: ServerPacketType
  UnknownPacket :: UVarInt -> ServerPacketType

instance Deserializable ServerPacketType where
  deserialize :: ProtocolRevision -> Get ServerPacketType
deserialize ProtocolRevision
rev = do
    UVarInt
packetNum <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    case UVarInt
packetNum of
      UVarInt
0  -> HelloResponse -> ServerPacketType
HelloResponse (HelloResponse -> ServerPacketType)
-> Get HelloResponse -> Get ServerPacketType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get HelloResponse
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
1  -> DataPacket -> ServerPacketType
DataResponse (DataPacket -> ServerPacketType)
-> Get DataPacket -> Get ServerPacketType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get DataPacket
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
2  -> ExceptionPacket -> ServerPacketType
Exception (ExceptionPacket -> ServerPacketType)
-> Get ExceptionPacket -> Get ServerPacketType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ExceptionPacket
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
3  -> ProgressPacket -> ServerPacketType
Progress (ProgressPacket -> ServerPacketType)
-> Get ProgressPacket -> Get ServerPacketType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ProgressPacket
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
4  -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
Pong
      UVarInt
5  -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
EndOfStream
      UVarInt
6  -> ProfileInfo -> ServerPacketType
ProfileInfo (ProfileInfo -> ServerPacketType)
-> Get ProfileInfo -> Get ServerPacketType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ProfileInfo
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
7  -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
Totals
      UVarInt
8  -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
Extremes
      UVarInt
9  -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
TablesStatusResponse
      UVarInt
10 -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
Log
      UVarInt
11 -> TableColumns -> ServerPacketType
TableColumns (TableColumns -> ServerPacketType)
-> Get TableColumns -> Get ServerPacketType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get TableColumns
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
12 -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
UUIDs
      UVarInt
13 -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
ReadTaskRequest
      UVarInt
14 -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacketType
ProfileEvents
      UVarInt
_  -> ServerPacketType -> Get ServerPacketType
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerPacketType -> Get ServerPacketType)
-> ServerPacketType -> Get ServerPacketType
forall a b. (a -> b) -> a -> b
$ UVarInt -> ServerPacketType
UnknownPacket UVarInt
packetNum

instance Show ServerPacketType where
  show :: ServerPacketType -> String
show (HelloResponse HelloResponse
hello) = String
"HelloResponse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HelloResponse -> String
forall a. Show a => a -> String
show HelloResponse
hello
  show (DataResponse DataPacket
dataPacket) = String
"DataResponse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DataPacket -> String
forall a. Show a => a -> String
show DataPacket
dataPacket
  show (Exception ExceptionPacket
exception) = String
"Exception " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ExceptionPacket -> String
forall a. Show a => a -> String
show ExceptionPacket
exception
  show (Progress ProgressPacket
progress) = String
"Progress " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProgressPacket -> String
forall a. Show a => a -> String
show ProgressPacket
progress
  show ServerPacketType
Pong = String
"Pong"
  show ServerPacketType
EndOfStream = String
"EndOfStream"
  show (ProfileInfo ProfileInfo
profileInfo) = String
"ProfileInfo " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProfileInfo -> String
forall a. Show a => a -> String
show ProfileInfo
profileInfo
  show ServerPacketType
Totals = String
"Totals"
  show ServerPacketType
Extremes = String
"Extremes"
  show ServerPacketType
TablesStatusResponse = String
"TablesStatusResponse"
  show ServerPacketType
Log = String
"Log"
  show (TableColumns TableColumns
tabelColumnsPacket) = String
"TableColumns " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TableColumns -> String
forall a. Show a => a -> String
show TableColumns
tabelColumnsPacket
  show ServerPacketType
UUIDs = String
"UUIDs"
  show ServerPacketType
ReadTaskRequest = String
"ReadTaskRequest"
  show ServerPacketType
ProfileEvents = String
"ProfileEvents"
  show (UnknownPacket UVarInt
packetNum) = String
"UnknownPacket: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
packetNum

-- ** HelloResponse

{-
  https://github.com/ClickHouse/ClickHouse/blob/eb4a74d7412a1fcf52727cd8b00b365d6b9ed86c/src/Client/Connection.cpp#L520
-}
data HelloResponse = MkHelloResponse
  { HelloResponse -> ChString
server_name                    :: ChString
  , HelloResponse -> UVarInt
server_version_major           :: UVarInt
  , HelloResponse -> UVarInt
server_version_minor           :: UVarInt
  , HelloResponse -> ProtocolRevision
server_revision                :: ProtocolRevision
  , HelloResponse
-> SinceRevision
     UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
server_parallel_replicas_proto :: UVarInt  `SinceRevision` DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
  , HelloResponse
-> SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
server_timezone                :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
  , HelloResponse
-> SinceRevision
     ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
server_display_name            :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
  , HelloResponse
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
server_version_patch           :: UVarInt  `SinceRevision` DBMS_MIN_REVISION_WITH_VERSION_PATCH
  , HelloResponse
-> SinceRevision
     ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_send_chunked_srv         :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
  , HelloResponse
-> SinceRevision
     ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_recv_chunked_srv         :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
  , HelloResponse
-> SinceRevision
     [PasswordComplexityRules]
     DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
password_complexity_rules      :: [PasswordComplexityRules] `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
  , HelloResponse
-> SinceRevision
     ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
read_nonce                     :: ChUInt64 `SinceRevision` DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
  }
  deriving ((forall x. HelloResponse -> Rep HelloResponse x)
-> (forall x. Rep HelloResponse x -> HelloResponse)
-> Generic HelloResponse
forall x. Rep HelloResponse x -> HelloResponse
forall x. HelloResponse -> Rep HelloResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HelloResponse -> Rep HelloResponse x
from :: forall x. HelloResponse -> Rep HelloResponse x
$cto :: forall x. Rep HelloResponse x -> HelloResponse
to :: forall x. Rep HelloResponse x -> HelloResponse
Generic, Int -> HelloResponse -> ShowS
[HelloResponse] -> ShowS
HelloResponse -> String
(Int -> HelloResponse -> ShowS)
-> (HelloResponse -> String)
-> ([HelloResponse] -> ShowS)
-> Show HelloResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HelloResponse -> ShowS
showsPrec :: Int -> HelloResponse -> ShowS
$cshow :: HelloResponse -> String
show :: HelloResponse -> String
$cshowList :: [HelloResponse] -> ShowS
showList :: [HelloResponse] -> ShowS
Show)

instance Deserializable HelloResponse where
  deserialize :: ProtocolRevision -> Get HelloResponse
deserialize ProtocolRevision
revision = do
    ChString
server_name                    <- ProtocolRevision -> Get ChString
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision
    UVarInt
server_version_major           <- ProtocolRevision -> Get UVarInt
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision
    UVarInt
server_version_minor           <- ProtocolRevision -> Get UVarInt
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision
    ProtocolRevision
server_revision                <- ProtocolRevision -> Get ProtocolRevision
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision
    -- Override current protocol revision for backward compatibility
    let chosenRevision :: ProtocolRevision
chosenRevision = ProtocolRevision -> ProtocolRevision -> ProtocolRevision
forall a. Ord a => a -> a -> a
min ProtocolRevision
server_revision ProtocolRevision
revision
    SinceRevision
  UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
server_parallel_replicas_proto <- ProtocolRevision
-> Get
     (SinceRevision
        UVarInt
        DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
server_timezone                <- ProtocolRevision
-> Get
     (SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
server_display_name            <- ProtocolRevision
-> Get
     (SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
server_version_patch           <- ProtocolRevision
-> Get (SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_send_chunked_srv         <- ProtocolRevision
-> Get
     (SinceRevision
        ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_recv_chunked_srv         <- ProtocolRevision
-> Get
     (SinceRevision
        ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision
  [PasswordComplexityRules]
  DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
password_complexity_rules      <- ProtocolRevision
-> Get
     (SinceRevision
        [PasswordComplexityRules]
        DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
read_nonce                     <- ProtocolRevision
-> Get
     (SinceRevision
        ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    HelloResponse -> Get HelloResponse
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkHelloResponse{SinceRevision
  [PasswordComplexityRules]
  DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
SinceRevision
  UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
SinceRevision ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
ProtocolRevision
UVarInt
ChString
$sel:server_name:MkHelloResponse :: ChString
$sel:server_version_major:MkHelloResponse :: UVarInt
$sel:server_version_minor:MkHelloResponse :: UVarInt
$sel:server_revision:MkHelloResponse :: ProtocolRevision
$sel:server_parallel_replicas_proto:MkHelloResponse :: SinceRevision
  UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
$sel:server_timezone:MkHelloResponse :: SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
$sel:server_display_name:MkHelloResponse :: SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
$sel:server_version_patch:MkHelloResponse :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
$sel:proto_send_chunked_srv:MkHelloResponse :: SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
$sel:proto_recv_chunked_srv:MkHelloResponse :: SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
$sel:password_complexity_rules:MkHelloResponse :: SinceRevision
  [PasswordComplexityRules]
  DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
$sel:read_nonce:MkHelloResponse :: SinceRevision ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
server_name :: ChString
server_version_major :: UVarInt
server_version_minor :: UVarInt
server_revision :: ProtocolRevision
server_parallel_replicas_proto :: SinceRevision
  UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
server_timezone :: SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
server_display_name :: SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
server_version_patch :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
proto_send_chunked_srv :: SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_recv_chunked_srv :: SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
password_complexity_rules :: SinceRevision
  [PasswordComplexityRules]
  DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
read_nonce :: SinceRevision ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
..}

data PasswordComplexityRules = MkPasswordComplexityRules
  { PasswordComplexityRules -> ChString
original_pattern  :: ChString
  , PasswordComplexityRules -> ChString
exception_message :: ChString
  }
  deriving ((forall x.
 PasswordComplexityRules -> Rep PasswordComplexityRules x)
-> (forall x.
    Rep PasswordComplexityRules x -> PasswordComplexityRules)
-> Generic PasswordComplexityRules
forall x. Rep PasswordComplexityRules x -> PasswordComplexityRules
forall x. PasswordComplexityRules -> Rep PasswordComplexityRules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PasswordComplexityRules -> Rep PasswordComplexityRules x
from :: forall x. PasswordComplexityRules -> Rep PasswordComplexityRules x
$cto :: forall x. Rep PasswordComplexityRules x -> PasswordComplexityRules
to :: forall x. Rep PasswordComplexityRules x -> PasswordComplexityRules
Generic, ProtocolRevision -> Get PasswordComplexityRules
(ProtocolRevision -> Get PasswordComplexityRules)
-> Deserializable PasswordComplexityRules
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get PasswordComplexityRules
deserialize :: ProtocolRevision -> Get PasswordComplexityRules
Deserializable, Int -> PasswordComplexityRules -> ShowS
[PasswordComplexityRules] -> ShowS
PasswordComplexityRules -> String
(Int -> PasswordComplexityRules -> ShowS)
-> (PasswordComplexityRules -> String)
-> ([PasswordComplexityRules] -> ShowS)
-> Show PasswordComplexityRules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordComplexityRules -> ShowS
showsPrec :: Int -> PasswordComplexityRules -> ShowS
$cshow :: PasswordComplexityRules -> String
show :: PasswordComplexityRules -> String
$cshowList :: [PasswordComplexityRules] -> ShowS
showList :: [PasswordComplexityRules] -> ShowS
Show)

instance Deserializable [PasswordComplexityRules] where
  deserialize :: ProtocolRevision -> Get [PasswordComplexityRules]
deserialize ProtocolRevision
rev = do
    UVarInt
len <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    Int -> Get PasswordComplexityRules -> Get [PasswordComplexityRules]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
len) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @PasswordComplexityRules ProtocolRevision
rev)

-- ** Exception

data ExceptionPacket = MkExceptionPacket
  { ExceptionPacket -> ChInt32
code        :: ChInt32
  , ExceptionPacket -> ChString
name        :: ChString
  , ExceptionPacket -> ChString
message     :: ChString
  , ExceptionPacket -> ChString
stack_trace :: ChString
  , ExceptionPacket -> ChUInt8
nested      :: ChUInt8
  }
  deriving ((forall x. ExceptionPacket -> Rep ExceptionPacket x)
-> (forall x. Rep ExceptionPacket x -> ExceptionPacket)
-> Generic ExceptionPacket
forall x. Rep ExceptionPacket x -> ExceptionPacket
forall x. ExceptionPacket -> Rep ExceptionPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExceptionPacket -> Rep ExceptionPacket x
from :: forall x. ExceptionPacket -> Rep ExceptionPacket x
$cto :: forall x. Rep ExceptionPacket x -> ExceptionPacket
to :: forall x. Rep ExceptionPacket x -> ExceptionPacket
Generic, ProtocolRevision -> Get ExceptionPacket
(ProtocolRevision -> Get ExceptionPacket)
-> Deserializable ExceptionPacket
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get ExceptionPacket
deserialize :: ProtocolRevision -> Get ExceptionPacket
Deserializable, Int -> ExceptionPacket -> ShowS
[ExceptionPacket] -> ShowS
ExceptionPacket -> String
(Int -> ExceptionPacket -> ShowS)
-> (ExceptionPacket -> String)
-> ([ExceptionPacket] -> ShowS)
-> Show ExceptionPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExceptionPacket -> ShowS
showsPrec :: Int -> ExceptionPacket -> ShowS
$cshow :: ExceptionPacket -> String
show :: ExceptionPacket -> String
$cshowList :: [ExceptionPacket] -> ShowS
showList :: [ExceptionPacket] -> ShowS
Show)

-- ** Progress

data ProgressPacket = MkProgressPacket
  { ProgressPacket -> UVarInt
rows        :: UVarInt
  , ProgressPacket -> UVarInt
bytes       :: UVarInt
  , ProgressPacket -> UVarInt
total_rows  :: UVarInt
  , ProgressPacket
-> SinceRevision
     UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS
total_bytes :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS
  , ProgressPacket
-> SinceRevision
     UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS
wrote_rows  :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS
  , ProgressPacket
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
wrote_bytes :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
  , ProgressPacket
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
elapsed_ns  :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
  }
  deriving ((forall x. ProgressPacket -> Rep ProgressPacket x)
-> (forall x. Rep ProgressPacket x -> ProgressPacket)
-> Generic ProgressPacket
forall x. Rep ProgressPacket x -> ProgressPacket
forall x. ProgressPacket -> Rep ProgressPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProgressPacket -> Rep ProgressPacket x
from :: forall x. ProgressPacket -> Rep ProgressPacket x
$cto :: forall x. Rep ProgressPacket x -> ProgressPacket
to :: forall x. Rep ProgressPacket x -> ProgressPacket
Generic, ProtocolRevision -> Get ProgressPacket
(ProtocolRevision -> Get ProgressPacket)
-> Deserializable ProgressPacket
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get ProgressPacket
deserialize :: ProtocolRevision -> Get ProgressPacket
Deserializable, Int -> ProgressPacket -> ShowS
[ProgressPacket] -> ShowS
ProgressPacket -> String
(Int -> ProgressPacket -> ShowS)
-> (ProgressPacket -> String)
-> ([ProgressPacket] -> ShowS)
-> Show ProgressPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgressPacket -> ShowS
showsPrec :: Int -> ProgressPacket -> ShowS
$cshow :: ProgressPacket -> String
show :: ProgressPacket -> String
$cshowList :: [ProgressPacket] -> ShowS
showList :: [ProgressPacket] -> ShowS
Show)

-- ** ProfileInfo

data ProfileInfo = MkProfileInfo
  { ProfileInfo -> UVarInt
rows                         :: UVarInt
  , ProfileInfo -> UVarInt
blocks                       :: UVarInt
  , ProfileInfo -> UVarInt
bytes                        :: UVarInt
  , ProfileInfo -> ChUInt8
applied_limit                :: ChUInt8
  , ProfileInfo -> UVarInt
rows_before_limit            :: UVarInt
  , ProfileInfo -> ChUInt8
calculated_rows_before_limit :: ChUInt8
  , ProfileInfo
-> SinceRevision
     ChUInt8 DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
applied_aggregation          :: ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
  , ProfileInfo
-> SinceRevision
     UVarInt DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
rows_before_aggregation      :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
  }
  deriving ((forall x. ProfileInfo -> Rep ProfileInfo x)
-> (forall x. Rep ProfileInfo x -> ProfileInfo)
-> Generic ProfileInfo
forall x. Rep ProfileInfo x -> ProfileInfo
forall x. ProfileInfo -> Rep ProfileInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProfileInfo -> Rep ProfileInfo x
from :: forall x. ProfileInfo -> Rep ProfileInfo x
$cto :: forall x. Rep ProfileInfo x -> ProfileInfo
to :: forall x. Rep ProfileInfo x -> ProfileInfo
Generic, ProtocolRevision -> Get ProfileInfo
(ProtocolRevision -> Get ProfileInfo) -> Deserializable ProfileInfo
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get ProfileInfo
deserialize :: ProtocolRevision -> Get ProfileInfo
Deserializable, Int -> ProfileInfo -> ShowS
[ProfileInfo] -> ShowS
ProfileInfo -> String
(Int -> ProfileInfo -> ShowS)
-> (ProfileInfo -> String)
-> ([ProfileInfo] -> ShowS)
-> Show ProfileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfileInfo -> ShowS
showsPrec :: Int -> ProfileInfo -> ShowS
$cshow :: ProfileInfo -> String
show :: ProfileInfo -> String
$cshowList :: [ProfileInfo] -> ShowS
showList :: [ProfileInfo] -> ShowS
Show)

-- ** TableColumns

data TableColumns = MkTableColumns
  { TableColumns -> ChString
table_name :: ChString
  , TableColumns -> ChString
table_columns :: ChString
  }
  deriving ((forall x. TableColumns -> Rep TableColumns x)
-> (forall x. Rep TableColumns x -> TableColumns)
-> Generic TableColumns
forall x. Rep TableColumns x -> TableColumns
forall x. TableColumns -> Rep TableColumns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableColumns -> Rep TableColumns x
from :: forall x. TableColumns -> Rep TableColumns x
$cto :: forall x. Rep TableColumns x -> TableColumns
to :: forall x. Rep TableColumns x -> TableColumns
Generic, ProtocolRevision -> Get TableColumns
(ProtocolRevision -> Get TableColumns)
-> Deserializable TableColumns
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get TableColumns
deserialize :: ProtocolRevision -> Get TableColumns
Deserializable, Int -> TableColumns -> ShowS
[TableColumns] -> ShowS
TableColumns -> String
(Int -> TableColumns -> ShowS)
-> (TableColumns -> String)
-> ([TableColumns] -> ShowS)
-> Show TableColumns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableColumns -> ShowS
showsPrec :: Int -> TableColumns -> ShowS
$cshow :: TableColumns -> String
show :: TableColumns -> String
$cshowList :: [TableColumns] -> ShowS
showList :: [TableColumns] -> ShowS
Show)








-- * Deserialization

-- ** Generic API

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

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

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


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

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

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


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

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


-- ** Raw columns deserialization

class DeserializableColumns columns where
  deserializeRawColumns :: ProtocolRevision -> UVarInt -> Get columns

instance
  DeserializableColumns (Columns '[])
  where
  {-# INLINE deserializeRawColumns #-}
  deserializeRawColumns :: ProtocolRevision -> UVarInt -> Get (Columns '[])
deserializeRawColumns ProtocolRevision
_rev UVarInt
_rows = Columns '[] -> Get (Columns '[])
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Columns '[]
Empty

instance
  ( KnownColumn (Column name chType)
  , DeserializableColumn (Column name chType)
  , DeserializableColumns (Columns extraColumns)
  )
  =>
  DeserializableColumns (Columns (Column name chType ': extraColumns))
  where
  {-# INLINE deserializeRawColumns #-}
  deserializeRawColumns :: ProtocolRevision
-> UVarInt -> Get (Columns (Column name chType : extraColumns))
deserializeRawColumns ProtocolRevision
rev UVarInt
rows =
    Column name chType
-> Columns extraColumns
-> Columns (Column name chType : extraColumns)
forall (name :: Symbol) chType (parameters :: [*]).
KnownColumn (Column name chType) =>
Column name chType
-> Columns parameters -> Columns (Column name chType : parameters)
AddColumn
      (Column name chType
 -> Columns extraColumns
 -> Columns (Column name chType : extraColumns))
-> Get (Column name chType)
-> Get
     (Columns extraColumns
      -> Columns (Column name chType : extraColumns))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> UVarInt -> Get (Column name chType)
forall column.
DeserializableColumn column =>
ProtocolRevision -> UVarInt -> Get column
deserializeColumn ProtocolRevision
rev UVarInt
rows
      Get
  (Columns extraColumns
   -> Columns (Column name chType : extraColumns))
-> Get (Columns extraColumns)
-> Get (Columns (Column name chType : extraColumns))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall columns.
DeserializableColumns columns =>
ProtocolRevision -> UVarInt -> Get columns
deserializeRawColumns @(Columns extraColumns) ProtocolRevision
rev UVarInt
rows


-- ** Column deserialization

{-# SPECIALIZE replicateM :: Int -> Get chType -> Get [chType] #-}

class DeserializableColumn column where
  deserializeColumn :: ProtocolRevision -> UVarInt -> Get column

instance
  ( KnownColumn (Column name chType)
  , Deserializable chType
  ) =>
  DeserializableColumn (Column name chType) where
  deserializeColumn :: ProtocolRevision -> UVarInt -> Get (Column name chType)
deserializeColumn ProtocolRevision
rev UVarInt
rows = do
    ChString
_columnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    ChString
_columnType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
    [chType]
column <- Int -> Get chType -> Get [chType]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
    Column
  (GetColumnName (Column name chType))
  (GetColumnType (Column name chType))
-> Get
     (Column
        (GetColumnName (Column name chType))
        (GetColumnType (Column name chType)))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column
   (GetColumnName (Column name chType))
   (GetColumnType (Column name chType))
 -> Get
      (Column
         (GetColumnName (Column name chType))
         (GetColumnType (Column name chType))))
-> Column
     (GetColumnName (Column name chType))
     (GetColumnType (Column name chType))
-> Get
     (Column
        (GetColumnName (Column name chType))
        (GetColumnType (Column name chType)))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name chType) [chType]
[GetColumnType (Column name chType)]
column

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Nullable chType))
  , Deserializable chType
  ) =>
  DeserializableColumn (Column name (Nullable chType)) where
  deserializeColumn :: ProtocolRevision -> UVarInt -> Get (Column name (Nullable chType))
deserializeColumn ProtocolRevision
rev UVarInt
rows = do
    ChString
_columnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    ChString
_columnType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
    [ChUInt8]
nulls <- Int -> Get ChUInt8 -> Get [ChUInt8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChUInt8 ProtocolRevision
rev)
    [Nullable chType]
nullable <-
      [ChUInt8]
-> (ChUInt8 -> Get (Nullable chType)) -> Get [Nullable chType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
        [ChUInt8]
nulls
        (\case
          ChUInt8
0 -> chType -> Nullable chType
forall a. a -> Maybe a
Just (chType -> Nullable chType) -> Get chType -> Get (Nullable chType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev
          ChUInt8
_ -> (Nullable chType
forall a. Maybe a
Nothing Nullable chType -> Get chType -> Get (Nullable chType)
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
        )
    Column
  (GetColumnName (Column name (Nullable chType)))
  (GetColumnType (Column name (Nullable chType)))
-> Get
     (Column
        (GetColumnName (Column name (Nullable chType)))
        (GetColumnType (Column name (Nullable chType))))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column
   (GetColumnName (Column name (Nullable chType)))
   (GetColumnType (Column name (Nullable chType)))
 -> Get
      (Column
         (GetColumnName (Column name (Nullable chType)))
         (GetColumnType (Column name (Nullable chType)))))
-> Column
     (GetColumnName (Column name (Nullable chType)))
     (GetColumnType (Column name (Nullable chType)))
-> Get
     (Column
        (GetColumnName (Column name (Nullable chType)))
        (GetColumnType (Column name (Nullable chType))))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (Nullable chType)) [Nullable chType]
[GetColumnType (Column name (Nullable chType))]
nullable

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (LowCardinality chType))
  , Deserializable chType
  , ToChType (LowCardinality chType) chType
  , IsLowCardinalitySupported chType
  , TypeError ('Text "LowCardinality deserialization still unsupported")
  ) =>
  DeserializableColumn (Column name (LowCardinality chType)) where
  deserializeColumn :: ProtocolRevision
-> UVarInt -> Get (Column name (LowCardinality chType))
deserializeColumn ProtocolRevision
rev UVarInt
rows = do
    ChString
_columnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    ChString
_columnType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
    ChUInt64
_serializationType <- (ChUInt64 -> ChUInt64 -> ChUInt64
forall a. Bits a => a -> a -> a
.&. ChUInt64
0xf) (ChUInt64 -> ChUInt64) -> Get ChUInt64 -> Get ChUInt64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChUInt64 ProtocolRevision
rev
    ChInt64
_index_size <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChInt64 ProtocolRevision
rev
    -- error $ "Trace | " <> show _serializationType <> " : " <> show _index_size
    [LowCardinality chType]
lc <- Int -> Get (LowCardinality chType) -> Get [LowCardinality chType]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
rows) (chType -> LowCardinality chType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (chType -> LowCardinality chType)
-> Get chType -> Get (LowCardinality chType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
    Column
  (GetColumnName (Column name (LowCardinality chType)))
  (GetColumnType (Column name (LowCardinality chType)))
-> Get
     (Column
        (GetColumnName (Column name (LowCardinality chType)))
        (GetColumnType (Column name (LowCardinality chType))))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column
   (GetColumnName (Column name (LowCardinality chType)))
   (GetColumnType (Column name (LowCardinality chType)))
 -> Get
      (Column
         (GetColumnName (Column name (LowCardinality chType)))
         (GetColumnType (Column name (LowCardinality chType)))))
-> Column
     (GetColumnName (Column name (LowCardinality chType)))
     (GetColumnType (Column name (LowCardinality chType)))
-> Get
     (Column
        (GetColumnName (Column name (LowCardinality chType)))
        (GetColumnType (Column name (LowCardinality chType))))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (LowCardinality chType)) [LowCardinality chType]
[GetColumnType (Column name (LowCardinality chType))]
lc

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (ChArray chType))
  , Deserializable chType
  , TypeError ('Text "Arrays deserialization still unsupported")
  )
  => DeserializableColumn (Column name (ChArray chType)) where
  deserializeColumn :: ProtocolRevision -> UVarInt -> Get (Column name (ChArray chType))
deserializeColumn ProtocolRevision
rev UVarInt
_rows = do
    ChString
_columnName <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    ChString
_columnType <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChString ProtocolRevision
rev
    SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION
_isCustom <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) ProtocolRevision
rev
    (ChUInt64
arraySize, [ChUInt64]
_offsets) <- (ChUInt64, [ChUInt64]) -> (ChUInt64, [ChUInt64])
forall a. Show a => a -> a
traceShowId ((ChUInt64, [ChUInt64]) -> (ChUInt64, [ChUInt64]))
-> Get (ChUInt64, [ChUInt64]) -> Get (ChUInt64, [ChUInt64])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (ChUInt64, [ChUInt64])
readOffsets ProtocolRevision
rev
    [chType]
_types <- Int -> Get chType -> Get [chType]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (ChUInt64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ChUInt64
arraySize) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev)
    Column
  (GetColumnName (Column name (ChArray chType)))
  (GetColumnType (Column name (ChArray chType)))
-> Get
     (Column
        (GetColumnName (Column name (ChArray chType)))
        (GetColumnType (Column name (ChArray chType))))
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column
   (GetColumnName (Column name (ChArray chType)))
   (GetColumnType (Column name (ChArray chType)))
 -> Get
      (Column
         (GetColumnName (Column name (ChArray chType)))
         (GetColumnType (Column name (ChArray chType)))))
-> Column
     (GetColumnName (Column name (ChArray chType)))
     (GetColumnType (Column name (ChArray chType)))
-> Get
     (Column
        (GetColumnName (Column name (ChArray chType)))
        (GetColumnType (Column name (ChArray chType))))
forall a b. (a -> b) -> a -> b
$ forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name (ChArray chType)) []
    where
    readOffsets :: ProtocolRevision -> Get (ChUInt64, [ChUInt64])
    readOffsets :: ProtocolRevision -> Get (ChUInt64, [ChUInt64])
readOffsets ProtocolRevision
revivion = do
      ChUInt64
size <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChUInt64 ProtocolRevision
rev
      (ChUInt64
size, ) ([ChUInt64] -> (ChUInt64, [ChUInt64]))
-> Get [ChUInt64] -> Get (ChUInt64, [ChUInt64])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChUInt64 -> Get [ChUInt64]
go ChUInt64
size
      where
      go :: ChUInt64 -> Get [ChUInt64]
go ChUInt64
arraySize =
        do
        ChUInt64
nextOffset <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @ChUInt64 ProtocolRevision
revivion
        if ChUInt64
arraySize ChUInt64 -> ChUInt64 -> Bool
forall a. Ord a => a -> a -> Bool
>= ChUInt64
nextOffset
          then [ChUInt64] -> Get [ChUInt64]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ChUInt64
nextOffset]
          else (ChUInt64
nextOffset ChUInt64 -> [ChUInt64] -> [ChUInt64]
forall a. a -> [a] -> [a]
:) ([ChUInt64] -> [ChUInt64]) -> Get [ChUInt64] -> Get [ChUInt64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChUInt64 -> Get [ChUInt64]
go ChUInt64
arraySize


class
  Deserializable chType
  where
  default deserialize :: (Generic chType, GDeserializable (Rep chType)) => ProtocolRevision -> Get chType
  deserialize :: ProtocolRevision -> Get chType
  deserialize ProtocolRevision
rev = Rep chType Any -> chType
forall a x. Generic a => Rep a x -> a
forall x. Rep chType x -> chType
to (Rep chType Any -> chType) -> Get (Rep chType Any) -> Get chType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (Rep chType Any)
forall p. ProtocolRevision -> Get (Rep chType p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev


-- ** Generics

class GDeserializable f
  where
  gDeserialize :: ProtocolRevision -> Get (f p)

instance
  GDeserializable f
  =>
  GDeserializable (D1 c (C1 c2 f))
  where
  {-# INLINE gDeserialize #-}
  gDeserialize :: forall p. ProtocolRevision -> Get (D1 c (C1 c2 f) p)
gDeserialize ProtocolRevision
rev = C1 c2 f p -> M1 D c (C1 c2 f) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (C1 c2 f p -> M1 D c (C1 c2 f) p)
-> (f p -> C1 c2 f p) -> f p -> M1 D c (C1 c2 f) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f p -> C1 c2 f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D c (C1 c2 f) p)
-> Get (f p) -> Get (M1 D c (C1 c2 f) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (f p)
forall p. ProtocolRevision -> Get (f p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev

instance
  GDeserializable (left :*: (right1 :*: right2))
  =>
  GDeserializable ((left :*: right1) :*: right2)
  where
  {-# INLINE gDeserialize #-}
  gDeserialize :: forall p.
ProtocolRevision -> Get ((:*:) (left :*: right1) right2 p)
gDeserialize ProtocolRevision
rev = (\(left p
l :*: (right1 p
r1 :*: right2 p
r2)) -> (left p
l left p -> right1 p -> (:*:) left right1 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: right1 p
r1) (:*:) left right1 p -> right2 p -> (:*:) (left :*: right1) right2 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: right2 p
r2) ((:*:) left (right1 :*: right2) p
 -> (:*:) (left :*: right1) right2 p)
-> Get ((:*:) left (right1 :*: right2) p)
-> Get ((:*:) (left :*: right1) right2 p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ((:*:) left (right1 :*: right2) p)
forall p.
ProtocolRevision -> Get ((:*:) left (right1 :*: right2) p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev

instance
  (GDeserializable (S1 metaSel field), GDeserializable right)
  =>
  GDeserializable (S1 metaSel field :*: right)
  where
  {-# INLINE gDeserialize #-}
  gDeserialize :: forall p.
ProtocolRevision -> Get ((:*:) (S1 metaSel field) right p)
gDeserialize ProtocolRevision
rev = S1 metaSel field p -> right p -> (:*:) (S1 metaSel field) right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (S1 metaSel field p -> right p -> (:*:) (S1 metaSel field) right p)
-> Get (S1 metaSel field p)
-> Get (right p -> (:*:) (S1 metaSel field) right p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (S1 metaSel field p)
forall p. ProtocolRevision -> Get (S1 metaSel field p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev Get (right p -> (:*:) (S1 metaSel field) right p)
-> Get (right p) -> Get ((:*:) (S1 metaSel field) right p)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolRevision -> Get (right p)
forall p. ProtocolRevision -> Get (right p)
forall (f :: * -> *) p.
GDeserializable f =>
ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev

instance
  Deserializable chType
  =>
  GDeserializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType))
  where
  {-# INLINE gDeserialize #-}
  gDeserialize :: forall p.
ProtocolRevision
-> Get (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p)
gDeserialize ProtocolRevision
rev =  Rec0 chType p
-> M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 chType p
 -> M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p)
-> (chType -> Rec0 chType p)
-> chType
-> M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> Rec0 chType p
forall k i c (p :: k). c -> K1 i c p
K1 (chType -> M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p)
-> Get chType
-> Get (M1 S ('MetaSel ('Just typeName) a b f) (Rec0 chType) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev


-- ** Database types

instance Deserializable ChUUID where
  deserialize :: ProtocolRevision -> Get ChUUID
deserialize ProtocolRevision
_ = Word128 -> ChUUID
MkChUUID (Word128 -> ChUUID) -> Get Word128 -> Get ChUUID
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ((Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128 (Word64 -> Word64 -> Word128)
-> Get Word64 -> Get (Word64 -> Word128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le Get (Word64 -> Word128) -> Get Word64 -> Get Word128
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le)

instance Deserializable ChString where
  deserialize :: ProtocolRevision -> Get ChString
deserialize ProtocolRevision
rev = do
    Int
strSize <- UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UVarInt -> Int) -> Get UVarInt -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    ByteString -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (ByteString -> ChString) -> Get ByteString -> Get ChString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
strSize (Int -> ByteString -> ByteString
BS.take Int
strSize)


instance Deserializable ChInt8 where deserialize :: ProtocolRevision -> Get ChInt8
deserialize ProtocolRevision
_ = Int8 -> ChInt8
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int8 -> ChInt8) -> Get Int8 -> Get ChInt8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
instance Deserializable ChInt16 where deserialize :: ProtocolRevision -> Get ChInt16
deserialize ProtocolRevision
_ = Int16 -> ChInt16
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int16 -> ChInt16) -> Get Int16 -> Get ChInt16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16le
instance Deserializable ChInt32 where deserialize :: ProtocolRevision -> Get ChInt32
deserialize ProtocolRevision
_ = Int32 -> ChInt32
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int32 -> ChInt32) -> Get Int32 -> Get ChInt32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32le
instance Deserializable ChInt64 where deserialize :: ProtocolRevision -> Get ChInt64
deserialize ProtocolRevision
_ = Int64 -> ChInt64
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int64 -> ChInt64) -> Get Int64 -> Get ChInt64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
instance Deserializable ChInt128 where deserialize :: ProtocolRevision -> Get ChInt128
deserialize ProtocolRevision
_ = Int128 -> ChInt128
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Int128 -> ChInt128) -> Get Int128 -> Get ChInt128
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word64 -> Word64 -> Int128) -> Word64 -> Word64 -> Int128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Int128
Int128 (Word64 -> Word64 -> Int128)
-> Get Word64 -> Get (Word64 -> Int128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le Get (Word64 -> Int128) -> Get Word64 -> Get Int128
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le)
instance Deserializable ChUInt8 where deserialize :: ProtocolRevision -> Get ChUInt8
deserialize ProtocolRevision
_ = Word8 -> ChUInt8
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word8 -> ChUInt8) -> Get Word8 -> Get ChUInt8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
instance Deserializable ChUInt16 where deserialize :: ProtocolRevision -> Get ChUInt16
deserialize ProtocolRevision
_ = Word16 -> ChUInt16
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word16 -> ChUInt16) -> Get Word16 -> Get ChUInt16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
instance Deserializable ChUInt32 where deserialize :: ProtocolRevision -> Get ChUInt32
deserialize ProtocolRevision
_ = Word32 -> ChUInt32
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word32 -> ChUInt32) -> Get Word32 -> Get ChUInt32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
instance Deserializable ChUInt64 where deserialize :: ProtocolRevision -> Get ChUInt64
deserialize ProtocolRevision
_ = Word64 -> ChUInt64
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word64 -> ChUInt64) -> Get Word64 -> Get ChUInt64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
instance Deserializable ChUInt128 where deserialize :: ProtocolRevision -> Get ChUInt128
deserialize ProtocolRevision
_ = Word128 -> ChUInt128
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word128 -> ChUInt128) -> Get Word128 -> Get ChUInt128
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128 (Word64 -> Word64 -> Word128)
-> Get Word64 -> Get (Word64 -> Word128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le Get (Word64 -> Word128) -> Get Word64 -> Get Word128
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le)
instance Deserializable ChDateTime where deserialize :: ProtocolRevision -> Get ChDateTime
deserialize ProtocolRevision
_ = Word32 -> ChDateTime
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word32 -> ChDateTime) -> Get Word32 -> Get ChDateTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
instance Deserializable ChDate where deserialize :: ProtocolRevision -> Get ChDate
deserialize ProtocolRevision
_ = Word16 -> ChDate
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Word16 -> ChDate) -> Get Word16 -> Get ChDate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le

instance Deserializable UVarInt where
  deserialize :: ProtocolRevision -> Get UVarInt
deserialize ProtocolRevision
_ = Int -> UVarInt -> Get UVarInt
forall {a}. (Bits a, Num a) => Int -> a -> Get a
go Int
0 (UVarInt
0 :: UVarInt)
    where
    go :: Int -> a -> Get a
go Int
i a
o | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = do
      Word8
byte <- Get Word8
getWord8
      let o' :: a
o' = a
o a -> a -> a
forall a. Bits a => a -> a -> a
.|. ((Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7f) a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i))
      if Word8
byte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then a -> Get a
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! a
o' else Int -> a -> Get a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! a
o'
    go Int
_ a
_ = String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"input exceeds varuint size"








-- * Columns

-- ** Columns extraction helper

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

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


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

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

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

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

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

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


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

{- |
Column declaration

For example:

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

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

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

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

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

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

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

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


-- ** Columns

instance
  Serializable (Columns '[])
  where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Columns '[] -> Builder
serialize ProtocolRevision
_rev Columns '[]
Empty = Builder
""

instance
  ( Serializable (Columns columns)
  , Serializable col
  ) =>
  Serializable (Columns (col ': columns))
  where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Columns (col : columns) -> Builder
serialize ProtocolRevision
rev (AddColumn Column name chType
col Columns columns
columns) = ProtocolRevision -> Column name chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev Column name chType
col Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> Columns columns -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev Columns columns
columns

instance
  ( KnownColumn (Column name chType)
  , IsChType chType
  , Serializable chType
  ) => Serializable (Column name chType) where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Column name chType -> Builder
serialize ProtocolRevision
rev Column name chType
column
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnName @(Column name chType))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnType @(Column name chType))
    -- serialization is not custom
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev ChUInt8
0)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((chType -> Builder) -> [chType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @chType ProtocolRevision
rev) (Column name chType -> [chType]
forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues Column name chType
column))

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Nullable chType))
  , IsChType chType
  , Serializable chType
  ) => Serializable (Column name (Nullable chType)) where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Column name (Nullable chType) -> Builder
serialize ProtocolRevision
rev Column name (Nullable chType)
column
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnName @(Column name (Nullable chType)))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnType @(Column name (Nullable chType)))
    -- serialization is not custom
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev ChUInt8
0)
    -- Nulls
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Nullable chType -> Builder) -> [Nullable chType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev (ChUInt8 -> Builder)
-> (Nullable chType -> ChUInt8) -> Nullable chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt8 -> (chType -> ChUInt8) -> Nullable chType -> ChUInt8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChUInt8
1 (ChUInt8 -> chType -> ChUInt8
forall a b. a -> b -> a
const ChUInt8
0)) (Column name (Nullable chType) -> [Nullable chType]
forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues Column name (Nullable chType)
column))
    -- Values
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Nullable chType -> Builder) -> [Nullable chType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @chType ProtocolRevision
rev (chType -> Builder)
-> (Nullable chType -> chType) -> Nullable chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> (chType -> chType) -> Nullable chType -> chType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe chType
forall chType. IsChType chType => chType
defaultValueOfTypeName chType -> chType
forall a. a -> a
id) (Column name (Nullable chType) -> [Nullable chType]
forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues Column name (Nullable chType)
column))

instance {-# OVERLAPPING #-}
  ( KnownColumn (Column name (Nullable chType))
  , IsChType chType
  , Serializable chType
  , TypeError ('Text "LowCardinality serialization still unsupported")
  ) => Serializable (Column name (LowCardinality chType)) where
  {-# INLINE serialize #-}
  serialize :: ProtocolRevision -> Column name (LowCardinality chType) -> Builder
serialize ProtocolRevision
rev (LowCardinalityColumn [chType]
column)
    =  ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnName @(Column name (Nullable chType)))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ChString -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChString (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$ forall column. KnownColumn column => Builder
renderColumnType @(Column name (Nullable chType)))
    -- serialization is not custom
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION ProtocolRevision
rev (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev ChUInt8
0)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [chType] -> Builder
forall a. HasCallStack => a
undefined [chType]
column








-- * Parameters

type family KnownParameter param
  where
  KnownParameter (Parameter name parType) = (KnownSymbol name, ToQueryPart parType)

data Parameter (name :: Symbol) (chType :: Type) = MkParamater chType

data Parameters parameters where
  NoParameters :: Parameters '[]
  AddParameter
    :: KnownParameter (Parameter name chType)
    => Parameter name chType
    -> Parameters parameters
    -> Parameters (Parameter name chType ': parameters)

-- >>> import ClickHaskell.DbTypes
{- |
>>> parameters (parameter @"a3" @ChString ("a3Val" :: String) . parameter @"a2" @ChString ("a2Val" :: String))
"(a3='a3Val', a2='a2Val')"
-}
viewParameters :: (Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters :: forall (passedParameters :: [*]).
(Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters Parameters '[] -> Parameters passedParameters
interpreter = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Parameters passedParameters -> Builder
forall (params :: [*]). Parameters params -> Builder
renderParameters (Parameters '[] -> Parameters passedParameters
interpreter Parameters '[]
NoParameters) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

renderParameters :: Parameters params -> Builder
renderParameters :: forall (params :: [*]). Parameters params -> Builder
renderParameters Parameters params
NoParameters                      = Builder
""
renderParameters (AddParameter Parameter name chType
param Parameters parameters
NoParameters) = Parameter name chType -> Builder
forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter Parameter name chType
param
renderParameters (AddParameter Parameter name chType
param Parameters parameters
moreParams)   = Parameter name chType -> Builder
forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter Parameter name chType
param Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Parameters parameters -> Builder
forall (params :: [*]). Parameters params -> Builder
renderParameters Parameters parameters
moreParams


parameter
  :: forall name chType parameters userType
  . (ToChType chType userType, KnownParameter (Parameter name chType))
  => userType -> Parameters parameters -> Parameters (Parameter name chType ': parameters)
parameter :: forall (name :: Symbol) chType (parameters :: [*]) userType.
(ToChType chType userType,
 KnownParameter (Parameter name chType)) =>
userType
-> Parameters parameters
-> Parameters (Parameter name chType : parameters)
parameter userType
val = Parameter name chType
-> Parameters parameters
-> Parameters (Parameter name chType : parameters)
forall (name :: Symbol) chType (parameters :: [*]).
KnownParameter (Parameter name chType) =>
Parameter name chType
-> Parameters parameters
-> Parameters (Parameter name chType : parameters)
AddParameter (chType -> Parameter name chType
forall (name :: Symbol) chType. chType -> Parameter name chType
MkParamater (chType -> Parameter name chType)
-> chType -> Parameter name chType
forall a b. (a -> b) -> a -> b
$ userType -> chType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType userType
val)

renderParameter :: forall name chType . KnownParameter (Parameter name chType) => Parameter name chType -> Builder
renderParameter :: forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter (MkParamater chType
chType) = (ByteString -> Builder
byteString (ByteString -> Builder)
-> (Proxy name -> ByteString) -> Proxy name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (Proxy name -> String) -> Proxy name -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @name) Proxy name
forall {k} (t :: k). Proxy t
Proxy Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"=" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> chType -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart chType
chType

type family CheckParameters (required :: [Type]) (passed :: [Type]) :: Constraint
  where
  CheckParameters required passed = GoCheckParameters required passed '[]

type family GoCheckParameters required passed acc :: Constraint
  where
  GoCheckParameters '[] '[] '[] = ()
  GoCheckParameters (Parameter name _ ': _) '[] '[] = TypeError ('Text "Missing parameter \"" :<>: 'Text name :<>: 'Text "\".")
  GoCheckParameters '[] (p ': _) _ = TypeError ('Text "More parameters passed than used in the view")
  GoCheckParameters '[] '[] (p ': _) = TypeError ('Text "More parameters passed than used in the view")
  GoCheckParameters (Parameter name1 _ ': ps) '[] (Parameter name2 _ ': ps') = TypeError ('Text "Missing  \"" :<>: 'Text name1 :<>: 'Text "\" in passed parameters")
  GoCheckParameters (p ': ps) '[] (p' ': ps') = GoCheckParameters (p ': ps) (p' ': ps') '[]
  GoCheckParameters (Parameter name1 _ ': ps) (Parameter name1 _ ': ps') acc = (GoCheckParameters ps ps' acc)
  GoCheckParameters (Parameter name1 chType1 ': ps) (Parameter name2 chType2 ': ps') acc
    = (GoCheckParameters (Parameter name1 chType1 ': ps) ps' (Parameter name2 chType2 ': acc))








-- * Serialization

-- *** Generic API

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

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

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

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

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

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

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

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

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

class Serializable chType
  where
  default serialize :: (Generic chType, GSerializable (Rep chType)) => ProtocolRevision -> chType -> Builder
  serialize :: ProtocolRevision -> chType -> Builder
  serialize ProtocolRevision
rev = ProtocolRevision -> Rep chType Any -> Builder
forall p. ProtocolRevision -> Rep chType p -> Builder
forall (f :: * -> *) p.
GSerializable f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev (Rep chType Any -> Builder)
-> (chType -> Rep chType Any) -> chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> Rep chType Any
forall x. chType -> Rep chType x
forall a x. Generic a => a -> Rep a x
from


-- ** Database types
instance Serializable UVarInt where
  serialize :: ProtocolRevision -> UVarInt -> Builder
serialize ProtocolRevision
_ = UVarInt -> Builder
forall {t}. (Integral t, Bits t) => t -> Builder
go
    where
    go :: t -> Builder
go t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0x80 = Word8 -> Builder
word8 (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i)
      | Bool
otherwise = Word8 -> Builder
word8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i) Int
7) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> t -> Builder
go (t -> Int -> t
forall a. Bits a => a -> Int -> a
unsafeShiftR t
i Int
7)

instance Serializable ChString where
  serialize :: ProtocolRevision -> ChString -> Builder
serialize ProtocolRevision
rev ChString
str
    =  (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (UVarInt -> Builder)
-> (ChString -> UVarInt) -> ChString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> (ChString -> Int) -> ChString -> UVarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Int) -> (ChString -> ByteString) -> ChString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChString -> ByteString
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType) ChString
str
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChString -> PutM ()) -> ChString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PutM ()
putByteString (ByteString -> PutM ())
-> (ChString -> ByteString) -> ChString -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChString -> ByteString
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType) ChString
str

instance Serializable ChUUID where serialize :: ProtocolRevision -> ChUUID -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChUUID -> PutM ()) -> ChUUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Word64
hi, Word64
lo) -> Word64 -> PutM ()
putWord64le Word64
lo PutM () -> PutM () -> PutM ()
forall a. Semigroup a => a -> a -> a
<> Word64 -> PutM ()
putWord64le Word64
hi) ((Word64, Word64) -> PutM ())
-> (ChUUID -> (Word64, Word64)) -> ChUUID -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUUID -> (Word64, Word64)
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt8 where serialize :: ProtocolRevision -> ChInt8 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChInt8 -> PutM ()) -> ChInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> PutM ()
putInt8 (Int8 -> PutM ()) -> (ChInt8 -> Int8) -> ChInt8 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt8 -> Int8
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt16 where serialize :: ProtocolRevision -> ChInt16 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChInt16 -> PutM ()) -> ChInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> PutM ()
putInt16le (Int16 -> PutM ()) -> (ChInt16 -> Int16) -> ChInt16 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt16 -> Int16
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt32 where serialize :: ProtocolRevision -> ChInt32 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChInt32 -> PutM ()) -> ChInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> PutM ()
putInt32le (Int32 -> PutM ()) -> (ChInt32 -> Int32) -> ChInt32 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt32 -> Int32
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt64 where serialize :: ProtocolRevision -> ChInt64 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChInt64 -> PutM ()) -> ChInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> PutM ()
putInt64le (Int64 -> PutM ()) -> (ChInt64 -> Int64) -> ChInt64 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt64 -> Int64
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChInt128 where serialize :: ProtocolRevision -> ChInt128 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChInt128 -> PutM ()) -> ChInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Int128 Word64
hi Word64
lo) -> Word64 -> PutM ()
putWord64le Word64
lo PutM () -> PutM () -> PutM ()
forall a. Semigroup a => a -> a -> a
<> Word64 -> PutM ()
putWord64le Word64
hi) (Int128 -> PutM ()) -> (ChInt128 -> Int128) -> ChInt128 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt128 -> Int128
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt8 where serialize :: ProtocolRevision -> ChUInt8 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChUInt8 -> PutM ()) -> ChUInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> PutM ()
putWord8 (Word8 -> PutM ()) -> (ChUInt8 -> Word8) -> ChUInt8 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt8 -> Word8
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt16 where serialize :: ProtocolRevision -> ChUInt16 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChUInt16 -> PutM ()) -> ChUInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> PutM ()
putWord16le (Word16 -> PutM ()) -> (ChUInt16 -> Word16) -> ChUInt16 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt16 -> Word16
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt32 where serialize :: ProtocolRevision -> ChUInt32 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChUInt32 -> PutM ()) -> ChUInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> PutM ()
putWord32le (Word32 -> PutM ()) -> (ChUInt32 -> Word32) -> ChUInt32 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt32 -> Word32
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt64 where serialize :: ProtocolRevision -> ChUInt64 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChUInt64 -> PutM ()) -> ChUInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> PutM ()
putWord64le (Word64 -> PutM ()) -> (ChUInt64 -> Word64) -> ChUInt64 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt64 -> Word64
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChUInt128 where serialize :: ProtocolRevision -> ChUInt128 -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChUInt128 -> PutM ()) -> ChUInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Word128 Word64
hi Word64
lo) -> Word64 -> PutM ()
putWord64le Word64
lo PutM () -> PutM () -> PutM ()
forall a. Semigroup a => a -> a -> a
<> Word64 -> PutM ()
putWord64le Word64
hi) (Word128 -> PutM ())
-> (ChUInt128 -> Word128) -> ChUInt128 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt128 -> Word128
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChDateTime where serialize :: ProtocolRevision -> ChDateTime -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder)
-> (ChDateTime -> PutM ()) -> ChDateTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> PutM ()
putWord32le (Word32 -> PutM ())
-> (ChDateTime -> Word32) -> ChDateTime -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChDateTime -> Word32
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType
instance Serializable ChDate where serialize :: ProtocolRevision -> ChDate -> Builder
serialize ProtocolRevision
_ = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (ChDate -> PutM ()) -> ChDate -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> PutM ()
putWord16le (Word16 -> PutM ()) -> (ChDate -> Word16) -> ChDate -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChDate -> Word16
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType


-- ** Generics

class GSerializable f
  where
  gSerialize :: ProtocolRevision -> f p -> Builder

instance
  GSerializable f
  =>
  GSerializable (D1 c (C1 c2 f))
  where
  {-# INLINE gSerialize #-}
  gSerialize :: forall p. ProtocolRevision -> D1 c (C1 c2 f) p -> Builder
gSerialize ProtocolRevision
rev (M1 (M1 f p
re)) = ProtocolRevision -> f p -> Builder
forall p. ProtocolRevision -> f p -> Builder
forall (f :: * -> *) p.
GSerializable f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev f p
re

instance
  GSerializable (left1 :*: (left2 :*: right))
  =>
  GSerializable ((left1 :*: left2) :*: right)
  where
  {-# INLINE gSerialize #-}
  gSerialize :: forall p.
ProtocolRevision -> (:*:) (left1 :*: left2) right p -> Builder
gSerialize ProtocolRevision
rev ((left1 p
l1 :*: left2 p
l2) :*: right p
r) = ProtocolRevision -> (:*:) left1 (left2 :*: right) p -> Builder
forall p.
ProtocolRevision -> (:*:) left1 (left2 :*: right) p -> Builder
forall (f :: * -> *) p.
GSerializable f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev (left1 p
l1 left1 p -> (:*:) left2 right p -> (:*:) left1 (left2 :*: right) p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (left2 p
l2 left2 p -> right p -> (:*:) left2 right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: right p
r))

instance
  Serializable chType
  =>
  GSerializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType))
  where
  {-# INLINE gSerialize #-}
  gSerialize :: forall p.
ProtocolRevision
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> Builder
gSerialize ProtocolRevision
rev = ProtocolRevision -> chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (chType -> Builder)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> chType)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R chType p -> chType
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R chType p -> chType)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
    -> K1 R chType p)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> K1 R chType p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

instance
  (Serializable chType, GSerializable right)
  =>
  GSerializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType) :*: right)
  where
  {-# INLINE gSerialize #-}
  gSerialize :: forall p.
ProtocolRevision
-> (:*:)
     (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType)) right p
-> Builder
gSerialize ProtocolRevision
rev (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
left :*: right p
right)
    = (ProtocolRevision -> chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (chType -> Builder)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> chType)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R chType p -> chType
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R chType p -> chType)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
    -> K1 R chType p)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
-> K1 R chType p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> Builder)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p -> Builder
forall a b. (a -> b) -> a -> b
$ S1 ('MetaSel ('Just typeName) a b f) (Rec0 chType) p
left) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> right p -> Builder
forall p. ProtocolRevision -> right p -> Builder
forall (f :: * -> *) p.
GSerializable f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev right p
right








class
  KnownSymbol (ToChTypeName chType) =>
  IsChType chType
  where
  -- | Shows database original type name
  --
  -- @
  -- type ToChTypeName ChString = \"String\"
  -- type ToChTypeName (Nullable ChUInt32) = \"Nullable(UInt32)\"
  -- @
  type ToChTypeName chType :: Symbol

  chTypeName :: Builder
  chTypeName = ByteString -> Builder
byteString (ByteString -> Builder)
-> (Proxy (ToChTypeName chType) -> ByteString)
-> Proxy (ToChTypeName chType)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (Proxy (ToChTypeName chType) -> String)
-> Proxy (ToChTypeName chType)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @(ToChTypeName chType) (Proxy (ToChTypeName chType) -> Builder)
-> Proxy (ToChTypeName chType) -> Builder
forall a b. (a -> b) -> a -> b
$ Proxy (ToChTypeName chType)
forall {k} (t :: k). Proxy t
Proxy

  defaultValueOfTypeName :: chType

class IsChType chType => ToChType chType inputType    where toChType    :: inputType -> chType
class IsChType chType => FromChType chType outputType where fromChType  :: chType -> outputType
class IsChType chType => ToQueryPart chType           where toQueryPart :: chType -> BS.Builder

instance {-# OVERLAPPABLE #-} (IsChType chType, chType ~ inputType) => ToChType chType inputType where toChType :: inputType -> chType
toChType = inputType -> chType
inputType -> inputType
forall a. a -> a
id
instance {-# OVERLAPPABLE #-} (IsChType chType, chType ~ inputType) => FromChType chType inputType where fromChType :: chType -> inputType
fromChType = chType -> chType
chType -> inputType
forall a. a -> a
id



-- | ClickHouse Nullable(T) column type
-- (type synonym for Maybe)
type Nullable = Maybe

type NullableTypeName chType = "Nullable(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")"

{-
This instance leads to disable -Wmissing-methods
Need to move it's semantics to another instances

instance {-# OVERLAPPING #-}
  ( TypeError
    (     'Text (ToChTypeName (Nullable (LowCardinality chType))) ':<>: 'Text " is unsupported type in ClickHouse."
    ':$$: 'Text "Use " ':<>: 'Text (ToChTypeName (LowCardinality (Nullable chType))) ':<>: 'Text " instead."
    )
  , IsChType chType
  ) => IsChType (Nullable (LowCardinality chType))
  where
  defaultValueOfTypeName = error "Unreachable"
  chTypeName = error "Unreachable"
-}

instance
  ( IsChType chType
  , KnownSymbol ("Nullable(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")")
  )
  =>
  IsChType (Nullable chType)
  where
  type ToChTypeName (Nullable chType) = NullableTypeName chType
  defaultValueOfTypeName :: Nullable chType
defaultValueOfTypeName = Nullable chType
forall a. Maybe a
Nothing

instance
  ( ToQueryPart chType
  , IsChType (Nullable chType)
  )
  =>
  ToQueryPart (Nullable chType)
  where
  toQueryPart :: Nullable chType -> Builder
toQueryPart = Builder -> (chType -> Builder) -> Nullable chType -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"null" chType -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart

instance
  ( ToChType inputType chType
  , IsChType (Nullable inputType)
  )
  =>
  ToChType (Nullable inputType) (Nullable chType)
  where
  toChType :: Nullable chType -> Nullable inputType
toChType = (chType -> inputType) -> Nullable chType -> Nullable inputType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @inputType @chType)

instance
  ( FromChType chType inputType
  , IsChType (Nullable chType)
  )
  =>
  FromChType (Nullable chType) (Nullable inputType)
  where
  fromChType :: Nullable chType -> Nullable inputType
fromChType = (chType -> inputType) -> Nullable chType -> Nullable inputType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @chType)




-- | ClickHouse LowCardinality(T) column type
newtype LowCardinality chType = MkLowCardinality chType
deriving newtype instance (Eq chType, IsLowCardinalitySupported chType) => Eq (LowCardinality chType)
deriving newtype instance (Show chType, IsLowCardinalitySupported chType) => Show (LowCardinality chType)
deriving newtype instance (NFData chType, IsLowCardinalitySupported chType) => NFData (LowCardinality chType)
deriving newtype instance IsString (LowCardinality ChString)

class IsChType chType => IsLowCardinalitySupported chType
instance IsLowCardinalitySupported ChString
instance
  ( IsLowCardinalitySupported chType
  , IsChType (Nullable chType)
  ) =>
  IsLowCardinalitySupported (Nullable chType)

instance {-# OVERLAPPABLE #-}
  ( IsChType chType
  , TypeError
    (    'Text "LowCardinality("  ':<>: 'ShowType chType  ':<>: 'Text ") is unsupported"
    ':$$: 'Text "Use one of these types:"
    ':$$: 'Text "  ChString"
    ':$$: 'Text "  ChDateTime"
    ':$$: 'Text "  Nullable(T)"
    )
  ) => IsLowCardinalitySupported chType

instance
  ( IsLowCardinalitySupported chType
  , KnownSymbol ("LowCardinality(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")")
  ) =>
  IsChType (LowCardinality chType)
  where
  type ToChTypeName (LowCardinality chType) = "LowCardinality(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")"
  defaultValueOfTypeName :: LowCardinality chType
defaultValueOfTypeName = chType -> LowCardinality chType
forall chType. chType -> LowCardinality chType
MkLowCardinality (chType -> LowCardinality chType)
-> chType -> LowCardinality chType
forall a b. (a -> b) -> a -> b
$ forall chType. IsChType chType => chType
defaultValueOfTypeName @chType

instance
  ( ToChType inputType chType
  , IsChType (LowCardinality inputType)
  , IsLowCardinalitySupported inputType
  )
  =>
  ToChType (LowCardinality inputType) chType
  where
  toChType :: chType -> LowCardinality inputType
toChType = inputType -> LowCardinality inputType
forall chType. chType -> LowCardinality chType
MkLowCardinality (inputType -> LowCardinality inputType)
-> (chType -> inputType) -> chType -> LowCardinality inputType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> inputType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType

instance {-# OVERLAPPING #-}
  ( IsChType (LowCardinality chType)
  , IsLowCardinalitySupported chType
  )
  =>
  ToChType (LowCardinality chType) chType
  where
  toChType :: chType -> LowCardinality chType
toChType = chType -> LowCardinality chType
forall chType. chType -> LowCardinality chType
MkLowCardinality

instance IsLowCardinalitySupported chType => ToChType chType (LowCardinality chType)
  where
  toChType :: LowCardinality chType -> chType
toChType (MkLowCardinality chType
value) = chType
value

instance IsLowCardinalitySupported chType => FromChType chType (LowCardinality chType)
  where
  fromChType :: chType -> LowCardinality chType
fromChType = chType -> LowCardinality chType
forall chType. chType -> LowCardinality chType
MkLowCardinality

instance
  ( FromChType chType outputType
  , IsChType (LowCardinality chType)
  , IsLowCardinalitySupported chType
  )
  =>
  FromChType (LowCardinality chType) outputType
  where
  fromChType :: LowCardinality chType -> outputType
fromChType (MkLowCardinality chType
value) = chType -> outputType
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType chType
value

instance {-# OVERLAPPING #-}
  ( IsChType (LowCardinality chType)
  , IsLowCardinalitySupported chType
  )
  =>
  FromChType (LowCardinality chType) chType
  where
  fromChType :: LowCardinality chType -> chType
fromChType (MkLowCardinality chType
value) = chType
value

instance
  ( ToQueryPart chType
  , IsChType (LowCardinality chType)
  , IsLowCardinalitySupported chType
  )
  =>
  ToQueryPart (LowCardinality chType)
  where
  toQueryPart :: LowCardinality chType -> Builder
toQueryPart (MkLowCardinality chType
chType) = chType -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart chType
chType




-- | ClickHouse UUID column type
newtype ChUUID = MkChUUID Word128
  deriving newtype ((forall x. ChUUID -> Rep ChUUID x)
-> (forall x. Rep ChUUID x -> ChUUID) -> Generic ChUUID
forall x. Rep ChUUID x -> ChUUID
forall x. ChUUID -> Rep ChUUID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChUUID -> Rep ChUUID x
from :: forall x. ChUUID -> Rep ChUUID x
$cto :: forall x. Rep ChUUID x -> ChUUID
to :: forall x. Rep ChUUID x -> ChUUID
Generic, Int -> ChUUID -> ShowS
[ChUUID] -> ShowS
ChUUID -> String
(Int -> ChUUID -> ShowS)
-> (ChUUID -> String) -> ([ChUUID] -> ShowS) -> Show ChUUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUUID -> ShowS
showsPrec :: Int -> ChUUID -> ShowS
$cshow :: ChUUID -> String
show :: ChUUID -> String
$cshowList :: [ChUUID] -> ShowS
showList :: [ChUUID] -> ShowS
Show, ChUUID -> ChUUID -> Bool
(ChUUID -> ChUUID -> Bool)
-> (ChUUID -> ChUUID -> Bool) -> Eq ChUUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUUID -> ChUUID -> Bool
== :: ChUUID -> ChUUID -> Bool
$c/= :: ChUUID -> ChUUID -> Bool
/= :: ChUUID -> ChUUID -> Bool
Eq, ChUUID -> ()
(ChUUID -> ()) -> NFData ChUUID
forall a. (a -> ()) -> NFData a
$crnf :: ChUUID -> ()
rnf :: ChUUID -> ()
NFData, ChUUID
ChUUID -> ChUUID -> Bounded ChUUID
forall a. a -> a -> Bounded a
$cminBound :: ChUUID
minBound :: ChUUID
$cmaxBound :: ChUUID
maxBound :: ChUUID
Bounded, Addr# -> Int# -> ChUUID
ByteArray# -> Int# -> ChUUID
ChUUID -> Int#
(ChUUID -> Int#)
-> (ChUUID -> Int#)
-> (ByteArray# -> Int# -> ChUUID)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUUID #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUUID -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUUID -> State# s -> State# s)
-> (Addr# -> Int# -> ChUUID)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChUUID #))
-> (forall s. Addr# -> Int# -> ChUUID -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUUID -> State# s -> State# s)
-> Prim ChUUID
forall s. Addr# -> Int# -> Int# -> ChUUID -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUUID #)
forall s. Addr# -> Int# -> ChUUID -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUUID -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUUID #)
forall s.
MutableByteArray# s -> Int# -> ChUUID -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUUID -> Int#
sizeOf# :: ChUUID -> Int#
$calignment# :: ChUUID -> Int#
alignment# :: ChUUID -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUUID
indexByteArray# :: ByteArray# -> Int# -> ChUUID
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUUID #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUUID #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUUID -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUUID -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUUID -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUUID -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUUID
indexOffAddr# :: Addr# -> Int# -> ChUUID
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUUID #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUUID #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUUID -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUUID -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUUID -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUUID -> State# s -> State# s
Prim, Int -> ChUUID
ChUUID -> Int
ChUUID -> [ChUUID]
ChUUID -> ChUUID
ChUUID -> ChUUID -> [ChUUID]
ChUUID -> ChUUID -> ChUUID -> [ChUUID]
(ChUUID -> ChUUID)
-> (ChUUID -> ChUUID)
-> (Int -> ChUUID)
-> (ChUUID -> Int)
-> (ChUUID -> [ChUUID])
-> (ChUUID -> ChUUID -> [ChUUID])
-> (ChUUID -> ChUUID -> [ChUUID])
-> (ChUUID -> ChUUID -> ChUUID -> [ChUUID])
-> Enum ChUUID
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUUID -> ChUUID
succ :: ChUUID -> ChUUID
$cpred :: ChUUID -> ChUUID
pred :: ChUUID -> ChUUID
$ctoEnum :: Int -> ChUUID
toEnum :: Int -> ChUUID
$cfromEnum :: ChUUID -> Int
fromEnum :: ChUUID -> Int
$cenumFrom :: ChUUID -> [ChUUID]
enumFrom :: ChUUID -> [ChUUID]
$cenumFromThen :: ChUUID -> ChUUID -> [ChUUID]
enumFromThen :: ChUUID -> ChUUID -> [ChUUID]
$cenumFromTo :: ChUUID -> ChUUID -> [ChUUID]
enumFromTo :: ChUUID -> ChUUID -> [ChUUID]
$cenumFromThenTo :: ChUUID -> ChUUID -> ChUUID -> [ChUUID]
enumFromThenTo :: ChUUID -> ChUUID -> ChUUID -> [ChUUID]
Enum)

instance IsChType ChUUID where
  type ToChTypeName ChUUID = "UUID"
  defaultValueOfTypeName :: ChUUID
defaultValueOfTypeName = Word128 -> ChUUID
MkChUUID Word128
0


instance ToChType ChUUID Word64 where toChType :: Word64 -> ChUUID
toChType = Word128 -> ChUUID
MkChUUID (Word128 -> ChUUID) -> (Word64 -> Word128) -> Word64 -> ChUUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128 Word64
0
instance ToChType ChUUID (Word64, Word64) where toChType :: (Word64, Word64) -> ChUUID
toChType = Word128 -> ChUUID
MkChUUID (Word128 -> ChUUID)
-> ((Word64, Word64) -> Word128) -> (Word64, Word64) -> ChUUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word128) -> (Word64, Word64) -> Word128
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128)

instance FromChType ChUUID (Word64, Word64) where fromChType :: ChUUID -> (Word64, Word64)
fromChType (MkChUUID (Word128 Word64
w64hi Word64
w64lo)) = (Word64
w64hi, Word64
w64lo)




-- | ClickHouse String column type
newtype ChString = MkChString StrictByteString
  deriving newtype (Int -> ChString -> ShowS
[ChString] -> ShowS
ChString -> String
(Int -> ChString -> ShowS)
-> (ChString -> String) -> ([ChString] -> ShowS) -> Show ChString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChString -> ShowS
showsPrec :: Int -> ChString -> ShowS
$cshow :: ChString -> String
show :: ChString -> String
$cshowList :: [ChString] -> ShowS
showList :: [ChString] -> ShowS
Show, ChString -> ChString -> Bool
(ChString -> ChString -> Bool)
-> (ChString -> ChString -> Bool) -> Eq ChString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChString -> ChString -> Bool
== :: ChString -> ChString -> Bool
$c/= :: ChString -> ChString -> Bool
/= :: ChString -> ChString -> Bool
Eq, String -> ChString
(String -> ChString) -> IsString ChString
forall a. (String -> a) -> IsString a
$cfromString :: String -> ChString
fromString :: String -> ChString
IsString, ChString -> ()
(ChString -> ()) -> NFData ChString
forall a. (a -> ()) -> NFData a
$crnf :: ChString -> ()
rnf :: ChString -> ()
NFData)

instance IsChType ChString where
  type ToChTypeName ChString = "String"
  defaultValueOfTypeName :: ChString
defaultValueOfTypeName = ChString
""


instance ToQueryPart ChString where toQueryPart :: ChString -> Builder
toQueryPart (MkChString ByteString
string) =  Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
escapeQuery ByteString
string Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"

escapeQuery :: StrictByteString -> Builder
escapeQuery :: ByteString -> Builder
escapeQuery -- [ClickHaskell.DbTypes.ToDo.1]: Optimize
  = ByteString -> Builder
BS.byteString
  (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ByteString) -> ByteString -> ByteString
BS8.concatMap (\case Char
'\'' -> ByteString
"\\\'"; Char
'\\' -> ByteString
"\\\\"; Char
sym -> Char -> ByteString
BS8.singleton Char
sym;)

instance ToChType ChString StrictByteString where toChType :: ByteString -> ChString
toChType = ByteString -> ChString
MkChString
instance ToChType ChString Builder          where toChType :: Builder -> ChString
toChType = ByteString -> ChString
MkChString (ByteString -> ChString)
-> (Builder -> ByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
instance ToChType ChString String           where toChType :: String -> ChString
toChType = ByteString -> ChString
MkChString (ByteString -> ChString)
-> (String -> ByteString) -> String -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack
instance ToChType ChString Text             where toChType :: Text -> ChString
toChType = ByteString -> ChString
MkChString (ByteString -> ChString)
-> (Text -> ByteString) -> Text -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
instance ToChType ChString Int              where toChType :: Int -> ChString
toChType = ByteString -> ChString
MkChString (ByteString -> ChString) -> (Int -> ByteString) -> Int -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

instance FromChType ChString StrictByteString where fromChType :: ChString -> ByteString
fromChType (MkChString ByteString
string) = ByteString
string
instance
  ( TypeError
    (     'Text "ChString to Text using FromChType convertion could cause exception"
    ':$$: 'Text "Decode ByteString manually if you are sure it's always can be decoded or replace it with ByteString"
    )
  ) =>
  FromChType ChString Text
  where
  fromChType :: ChString -> Text
fromChType = String -> ChString -> Text
forall a. HasCallStack => String -> a
error String
"Unreachable"




-- | ClickHouse Int8 column type
newtype ChInt8 = MkChInt8 Int8
  deriving newtype (Int -> ChInt8 -> ShowS
[ChInt8] -> ShowS
ChInt8 -> String
(Int -> ChInt8 -> ShowS)
-> (ChInt8 -> String) -> ([ChInt8] -> ShowS) -> Show ChInt8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt8 -> ShowS
showsPrec :: Int -> ChInt8 -> ShowS
$cshow :: ChInt8 -> String
show :: ChInt8 -> String
$cshowList :: [ChInt8] -> ShowS
showList :: [ChInt8] -> ShowS
Show, ChInt8 -> ChInt8 -> Bool
(ChInt8 -> ChInt8 -> Bool)
-> (ChInt8 -> ChInt8 -> Bool) -> Eq ChInt8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt8 -> ChInt8 -> Bool
== :: ChInt8 -> ChInt8 -> Bool
$c/= :: ChInt8 -> ChInt8 -> Bool
/= :: ChInt8 -> ChInt8 -> Bool
Eq, Integer -> ChInt8
ChInt8 -> ChInt8
ChInt8 -> ChInt8 -> ChInt8
(ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8)
-> (Integer -> ChInt8)
-> Num ChInt8
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt8 -> ChInt8 -> ChInt8
+ :: ChInt8 -> ChInt8 -> ChInt8
$c- :: ChInt8 -> ChInt8 -> ChInt8
- :: ChInt8 -> ChInt8 -> ChInt8
$c* :: ChInt8 -> ChInt8 -> ChInt8
* :: ChInt8 -> ChInt8 -> ChInt8
$cnegate :: ChInt8 -> ChInt8
negate :: ChInt8 -> ChInt8
$cabs :: ChInt8 -> ChInt8
abs :: ChInt8 -> ChInt8
$csignum :: ChInt8 -> ChInt8
signum :: ChInt8 -> ChInt8
$cfromInteger :: Integer -> ChInt8
fromInteger :: Integer -> ChInt8
Num, Addr# -> Int# -> ChInt8
ByteArray# -> Int# -> ChInt8
ChInt8 -> Int#
(ChInt8 -> Int#)
-> (ChInt8 -> Int#)
-> (ByteArray# -> Int# -> ChInt8)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt8 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt8 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt8 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt8)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt8 #))
-> (forall s. Addr# -> Int# -> ChInt8 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt8 -> State# s -> State# s)
-> Prim ChInt8
forall s. Addr# -> Int# -> Int# -> ChInt8 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt8 #)
forall s. Addr# -> Int# -> ChInt8 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt8 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt8 #)
forall s.
MutableByteArray# s -> Int# -> ChInt8 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt8 -> Int#
sizeOf# :: ChInt8 -> Int#
$calignment# :: ChInt8 -> Int#
alignment# :: ChInt8 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt8
indexByteArray# :: ByteArray# -> Int# -> ChInt8
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt8 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt8 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt8 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt8 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt8 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt8 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt8
indexOffAddr# :: Addr# -> Int# -> ChInt8
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt8 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt8 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt8 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt8 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt8 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt8 -> State# s -> State# s
Prim, Eq ChInt8
ChInt8
Eq ChInt8 =>
(ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> ChInt8
-> (Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> Bool)
-> (ChInt8 -> Maybe Int)
-> (ChInt8 -> Int)
-> (ChInt8 -> Bool)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int -> ChInt8)
-> (ChInt8 -> Int)
-> Bits ChInt8
Int -> ChInt8
ChInt8 -> Bool
ChInt8 -> Int
ChInt8 -> Maybe Int
ChInt8 -> ChInt8
ChInt8 -> Int -> Bool
ChInt8 -> Int -> ChInt8
ChInt8 -> ChInt8 -> ChInt8
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChInt8 -> ChInt8 -> ChInt8
.&. :: ChInt8 -> ChInt8 -> ChInt8
$c.|. :: ChInt8 -> ChInt8 -> ChInt8
.|. :: ChInt8 -> ChInt8 -> ChInt8
$cxor :: ChInt8 -> ChInt8 -> ChInt8
xor :: ChInt8 -> ChInt8 -> ChInt8
$ccomplement :: ChInt8 -> ChInt8
complement :: ChInt8 -> ChInt8
$cshift :: ChInt8 -> Int -> ChInt8
shift :: ChInt8 -> Int -> ChInt8
$crotate :: ChInt8 -> Int -> ChInt8
rotate :: ChInt8 -> Int -> ChInt8
$czeroBits :: ChInt8
zeroBits :: ChInt8
$cbit :: Int -> ChInt8
bit :: Int -> ChInt8
$csetBit :: ChInt8 -> Int -> ChInt8
setBit :: ChInt8 -> Int -> ChInt8
$cclearBit :: ChInt8 -> Int -> ChInt8
clearBit :: ChInt8 -> Int -> ChInt8
$ccomplementBit :: ChInt8 -> Int -> ChInt8
complementBit :: ChInt8 -> Int -> ChInt8
$ctestBit :: ChInt8 -> Int -> Bool
testBit :: ChInt8 -> Int -> Bool
$cbitSizeMaybe :: ChInt8 -> Maybe Int
bitSizeMaybe :: ChInt8 -> Maybe Int
$cbitSize :: ChInt8 -> Int
bitSize :: ChInt8 -> Int
$cisSigned :: ChInt8 -> Bool
isSigned :: ChInt8 -> Bool
$cshiftL :: ChInt8 -> Int -> ChInt8
shiftL :: ChInt8 -> Int -> ChInt8
$cunsafeShiftL :: ChInt8 -> Int -> ChInt8
unsafeShiftL :: ChInt8 -> Int -> ChInt8
$cshiftR :: ChInt8 -> Int -> ChInt8
shiftR :: ChInt8 -> Int -> ChInt8
$cunsafeShiftR :: ChInt8 -> Int -> ChInt8
unsafeShiftR :: ChInt8 -> Int -> ChInt8
$crotateL :: ChInt8 -> Int -> ChInt8
rotateL :: ChInt8 -> Int -> ChInt8
$crotateR :: ChInt8 -> Int -> ChInt8
rotateR :: ChInt8 -> Int -> ChInt8
$cpopCount :: ChInt8 -> Int
popCount :: ChInt8 -> Int
Bits, Int -> ChInt8
ChInt8 -> Int
ChInt8 -> [ChInt8]
ChInt8 -> ChInt8
ChInt8 -> ChInt8 -> [ChInt8]
ChInt8 -> ChInt8 -> ChInt8 -> [ChInt8]
(ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8)
-> (Int -> ChInt8)
-> (ChInt8 -> Int)
-> (ChInt8 -> [ChInt8])
-> (ChInt8 -> ChInt8 -> [ChInt8])
-> (ChInt8 -> ChInt8 -> [ChInt8])
-> (ChInt8 -> ChInt8 -> ChInt8 -> [ChInt8])
-> Enum ChInt8
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChInt8 -> ChInt8
succ :: ChInt8 -> ChInt8
$cpred :: ChInt8 -> ChInt8
pred :: ChInt8 -> ChInt8
$ctoEnum :: Int -> ChInt8
toEnum :: Int -> ChInt8
$cfromEnum :: ChInt8 -> Int
fromEnum :: ChInt8 -> Int
$cenumFrom :: ChInt8 -> [ChInt8]
enumFrom :: ChInt8 -> [ChInt8]
$cenumFromThen :: ChInt8 -> ChInt8 -> [ChInt8]
enumFromThen :: ChInt8 -> ChInt8 -> [ChInt8]
$cenumFromTo :: ChInt8 -> ChInt8 -> [ChInt8]
enumFromTo :: ChInt8 -> ChInt8 -> [ChInt8]
$cenumFromThenTo :: ChInt8 -> ChInt8 -> ChInt8 -> [ChInt8]
enumFromThenTo :: ChInt8 -> ChInt8 -> ChInt8 -> [ChInt8]
Enum, Eq ChInt8
Eq ChInt8 =>
(ChInt8 -> ChInt8 -> Ordering)
-> (ChInt8 -> ChInt8 -> Bool)
-> (ChInt8 -> ChInt8 -> Bool)
-> (ChInt8 -> ChInt8 -> Bool)
-> (ChInt8 -> ChInt8 -> Bool)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> Ord ChInt8
ChInt8 -> ChInt8 -> Bool
ChInt8 -> ChInt8 -> Ordering
ChInt8 -> ChInt8 -> ChInt8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChInt8 -> ChInt8 -> Ordering
compare :: ChInt8 -> ChInt8 -> Ordering
$c< :: ChInt8 -> ChInt8 -> Bool
< :: ChInt8 -> ChInt8 -> Bool
$c<= :: ChInt8 -> ChInt8 -> Bool
<= :: ChInt8 -> ChInt8 -> Bool
$c> :: ChInt8 -> ChInt8 -> Bool
> :: ChInt8 -> ChInt8 -> Bool
$c>= :: ChInt8 -> ChInt8 -> Bool
>= :: ChInt8 -> ChInt8 -> Bool
$cmax :: ChInt8 -> ChInt8 -> ChInt8
max :: ChInt8 -> ChInt8 -> ChInt8
$cmin :: ChInt8 -> ChInt8 -> ChInt8
min :: ChInt8 -> ChInt8 -> ChInt8
Ord, Num ChInt8
Ord ChInt8
(Num ChInt8, Ord ChInt8) => (ChInt8 -> Rational) -> Real ChInt8
ChInt8 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChInt8 -> Rational
toRational :: ChInt8 -> Rational
Real, Enum ChInt8
Real ChInt8
(Real ChInt8, Enum ChInt8) =>
(ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> (ChInt8, ChInt8))
-> (ChInt8 -> ChInt8 -> (ChInt8, ChInt8))
-> (ChInt8 -> Integer)
-> Integral ChInt8
ChInt8 -> Integer
ChInt8 -> ChInt8 -> (ChInt8, ChInt8)
ChInt8 -> ChInt8 -> ChInt8
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChInt8 -> ChInt8 -> ChInt8
quot :: ChInt8 -> ChInt8 -> ChInt8
$crem :: ChInt8 -> ChInt8 -> ChInt8
rem :: ChInt8 -> ChInt8 -> ChInt8
$cdiv :: ChInt8 -> ChInt8 -> ChInt8
div :: ChInt8 -> ChInt8 -> ChInt8
$cmod :: ChInt8 -> ChInt8 -> ChInt8
mod :: ChInt8 -> ChInt8 -> ChInt8
$cquotRem :: ChInt8 -> ChInt8 -> (ChInt8, ChInt8)
quotRem :: ChInt8 -> ChInt8 -> (ChInt8, ChInt8)
$cdivMod :: ChInt8 -> ChInt8 -> (ChInt8, ChInt8)
divMod :: ChInt8 -> ChInt8 -> (ChInt8, ChInt8)
$ctoInteger :: ChInt8 -> Integer
toInteger :: ChInt8 -> Integer
Integral, ChInt8
ChInt8 -> ChInt8 -> Bounded ChInt8
forall a. a -> a -> Bounded a
$cminBound :: ChInt8
minBound :: ChInt8
$cmaxBound :: ChInt8
maxBound :: ChInt8
Bounded, ChInt8 -> ()
(ChInt8 -> ()) -> NFData ChInt8
forall a. (a -> ()) -> NFData a
$crnf :: ChInt8 -> ()
rnf :: ChInt8 -> ()
NFData)

instance IsChType ChInt8 where
  type ToChTypeName ChInt8 = "Int8"
  defaultValueOfTypeName :: ChInt8
defaultValueOfTypeName = ChInt8
0

instance ToQueryPart ChInt8
  where
  toQueryPart :: ChInt8 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChInt8 -> ByteString) -> ChInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChInt8 -> String) -> ChInt8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt8 -> String
forall a. Show a => a -> String
show

instance ToChType ChInt8 Int8   where toChType :: Int8 -> ChInt8
toChType = Int8 -> ChInt8
MkChInt8

instance FromChType ChInt8 Int8   where fromChType :: ChInt8 -> Int8
fromChType = ChInt8 -> Int8
forall a b. Coercible a b => a -> b
coerce




-- | ClickHouse Int16 column type
newtype ChInt16 = MkChInt16 Int16
  deriving newtype (Int -> ChInt16 -> ShowS
[ChInt16] -> ShowS
ChInt16 -> String
(Int -> ChInt16 -> ShowS)
-> (ChInt16 -> String) -> ([ChInt16] -> ShowS) -> Show ChInt16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt16 -> ShowS
showsPrec :: Int -> ChInt16 -> ShowS
$cshow :: ChInt16 -> String
show :: ChInt16 -> String
$cshowList :: [ChInt16] -> ShowS
showList :: [ChInt16] -> ShowS
Show, ChInt16 -> ChInt16 -> Bool
(ChInt16 -> ChInt16 -> Bool)
-> (ChInt16 -> ChInt16 -> Bool) -> Eq ChInt16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt16 -> ChInt16 -> Bool
== :: ChInt16 -> ChInt16 -> Bool
$c/= :: ChInt16 -> ChInt16 -> Bool
/= :: ChInt16 -> ChInt16 -> Bool
Eq, Integer -> ChInt16
ChInt16 -> ChInt16
ChInt16 -> ChInt16 -> ChInt16
(ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16)
-> (Integer -> ChInt16)
-> Num ChInt16
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt16 -> ChInt16 -> ChInt16
+ :: ChInt16 -> ChInt16 -> ChInt16
$c- :: ChInt16 -> ChInt16 -> ChInt16
- :: ChInt16 -> ChInt16 -> ChInt16
$c* :: ChInt16 -> ChInt16 -> ChInt16
* :: ChInt16 -> ChInt16 -> ChInt16
$cnegate :: ChInt16 -> ChInt16
negate :: ChInt16 -> ChInt16
$cabs :: ChInt16 -> ChInt16
abs :: ChInt16 -> ChInt16
$csignum :: ChInt16 -> ChInt16
signum :: ChInt16 -> ChInt16
$cfromInteger :: Integer -> ChInt16
fromInteger :: Integer -> ChInt16
Num, Addr# -> Int# -> ChInt16
ByteArray# -> Int# -> ChInt16
ChInt16 -> Int#
(ChInt16 -> Int#)
-> (ChInt16 -> Int#)
-> (ByteArray# -> Int# -> ChInt16)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt16 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt16 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt16 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt16)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt16 #))
-> (forall s. Addr# -> Int# -> ChInt16 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt16 -> State# s -> State# s)
-> Prim ChInt16
forall s. Addr# -> Int# -> Int# -> ChInt16 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt16 #)
forall s. Addr# -> Int# -> ChInt16 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt16 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt16 #)
forall s.
MutableByteArray# s -> Int# -> ChInt16 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt16 -> Int#
sizeOf# :: ChInt16 -> Int#
$calignment# :: ChInt16 -> Int#
alignment# :: ChInt16 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt16
indexByteArray# :: ByteArray# -> Int# -> ChInt16
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt16 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt16 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt16 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt16 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt16 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt16 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt16
indexOffAddr# :: Addr# -> Int# -> ChInt16
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt16 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt16 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt16 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt16 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt16 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt16 -> State# s -> State# s
Prim, Eq ChInt16
ChInt16
Eq ChInt16 =>
(ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> ChInt16
-> (Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> Bool)
-> (ChInt16 -> Maybe Int)
-> (ChInt16 -> Int)
-> (ChInt16 -> Bool)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int -> ChInt16)
-> (ChInt16 -> Int)
-> Bits ChInt16
Int -> ChInt16
ChInt16 -> Bool
ChInt16 -> Int
ChInt16 -> Maybe Int
ChInt16 -> ChInt16
ChInt16 -> Int -> Bool
ChInt16 -> Int -> ChInt16
ChInt16 -> ChInt16 -> ChInt16
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChInt16 -> ChInt16 -> ChInt16
.&. :: ChInt16 -> ChInt16 -> ChInt16
$c.|. :: ChInt16 -> ChInt16 -> ChInt16
.|. :: ChInt16 -> ChInt16 -> ChInt16
$cxor :: ChInt16 -> ChInt16 -> ChInt16
xor :: ChInt16 -> ChInt16 -> ChInt16
$ccomplement :: ChInt16 -> ChInt16
complement :: ChInt16 -> ChInt16
$cshift :: ChInt16 -> Int -> ChInt16
shift :: ChInt16 -> Int -> ChInt16
$crotate :: ChInt16 -> Int -> ChInt16
rotate :: ChInt16 -> Int -> ChInt16
$czeroBits :: ChInt16
zeroBits :: ChInt16
$cbit :: Int -> ChInt16
bit :: Int -> ChInt16
$csetBit :: ChInt16 -> Int -> ChInt16
setBit :: ChInt16 -> Int -> ChInt16
$cclearBit :: ChInt16 -> Int -> ChInt16
clearBit :: ChInt16 -> Int -> ChInt16
$ccomplementBit :: ChInt16 -> Int -> ChInt16
complementBit :: ChInt16 -> Int -> ChInt16
$ctestBit :: ChInt16 -> Int -> Bool
testBit :: ChInt16 -> Int -> Bool
$cbitSizeMaybe :: ChInt16 -> Maybe Int
bitSizeMaybe :: ChInt16 -> Maybe Int
$cbitSize :: ChInt16 -> Int
bitSize :: ChInt16 -> Int
$cisSigned :: ChInt16 -> Bool
isSigned :: ChInt16 -> Bool
$cshiftL :: ChInt16 -> Int -> ChInt16
shiftL :: ChInt16 -> Int -> ChInt16
$cunsafeShiftL :: ChInt16 -> Int -> ChInt16
unsafeShiftL :: ChInt16 -> Int -> ChInt16
$cshiftR :: ChInt16 -> Int -> ChInt16
shiftR :: ChInt16 -> Int -> ChInt16
$cunsafeShiftR :: ChInt16 -> Int -> ChInt16
unsafeShiftR :: ChInt16 -> Int -> ChInt16
$crotateL :: ChInt16 -> Int -> ChInt16
rotateL :: ChInt16 -> Int -> ChInt16
$crotateR :: ChInt16 -> Int -> ChInt16
rotateR :: ChInt16 -> Int -> ChInt16
$cpopCount :: ChInt16 -> Int
popCount :: ChInt16 -> Int
Bits, Int -> ChInt16
ChInt16 -> Int
ChInt16 -> [ChInt16]
ChInt16 -> ChInt16
ChInt16 -> ChInt16 -> [ChInt16]
ChInt16 -> ChInt16 -> ChInt16 -> [ChInt16]
(ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16)
-> (Int -> ChInt16)
-> (ChInt16 -> Int)
-> (ChInt16 -> [ChInt16])
-> (ChInt16 -> ChInt16 -> [ChInt16])
-> (ChInt16 -> ChInt16 -> [ChInt16])
-> (ChInt16 -> ChInt16 -> ChInt16 -> [ChInt16])
-> Enum ChInt16
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChInt16 -> ChInt16
succ :: ChInt16 -> ChInt16
$cpred :: ChInt16 -> ChInt16
pred :: ChInt16 -> ChInt16
$ctoEnum :: Int -> ChInt16
toEnum :: Int -> ChInt16
$cfromEnum :: ChInt16 -> Int
fromEnum :: ChInt16 -> Int
$cenumFrom :: ChInt16 -> [ChInt16]
enumFrom :: ChInt16 -> [ChInt16]
$cenumFromThen :: ChInt16 -> ChInt16 -> [ChInt16]
enumFromThen :: ChInt16 -> ChInt16 -> [ChInt16]
$cenumFromTo :: ChInt16 -> ChInt16 -> [ChInt16]
enumFromTo :: ChInt16 -> ChInt16 -> [ChInt16]
$cenumFromThenTo :: ChInt16 -> ChInt16 -> ChInt16 -> [ChInt16]
enumFromThenTo :: ChInt16 -> ChInt16 -> ChInt16 -> [ChInt16]
Enum, Eq ChInt16
Eq ChInt16 =>
(ChInt16 -> ChInt16 -> Ordering)
-> (ChInt16 -> ChInt16 -> Bool)
-> (ChInt16 -> ChInt16 -> Bool)
-> (ChInt16 -> ChInt16 -> Bool)
-> (ChInt16 -> ChInt16 -> Bool)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> Ord ChInt16
ChInt16 -> ChInt16 -> Bool
ChInt16 -> ChInt16 -> Ordering
ChInt16 -> ChInt16 -> ChInt16
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChInt16 -> ChInt16 -> Ordering
compare :: ChInt16 -> ChInt16 -> Ordering
$c< :: ChInt16 -> ChInt16 -> Bool
< :: ChInt16 -> ChInt16 -> Bool
$c<= :: ChInt16 -> ChInt16 -> Bool
<= :: ChInt16 -> ChInt16 -> Bool
$c> :: ChInt16 -> ChInt16 -> Bool
> :: ChInt16 -> ChInt16 -> Bool
$c>= :: ChInt16 -> ChInt16 -> Bool
>= :: ChInt16 -> ChInt16 -> Bool
$cmax :: ChInt16 -> ChInt16 -> ChInt16
max :: ChInt16 -> ChInt16 -> ChInt16
$cmin :: ChInt16 -> ChInt16 -> ChInt16
min :: ChInt16 -> ChInt16 -> ChInt16
Ord, Num ChInt16
Ord ChInt16
(Num ChInt16, Ord ChInt16) => (ChInt16 -> Rational) -> Real ChInt16
ChInt16 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChInt16 -> Rational
toRational :: ChInt16 -> Rational
Real, Enum ChInt16
Real ChInt16
(Real ChInt16, Enum ChInt16) =>
(ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> (ChInt16, ChInt16))
-> (ChInt16 -> ChInt16 -> (ChInt16, ChInt16))
-> (ChInt16 -> Integer)
-> Integral ChInt16
ChInt16 -> Integer
ChInt16 -> ChInt16 -> (ChInt16, ChInt16)
ChInt16 -> ChInt16 -> ChInt16
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChInt16 -> ChInt16 -> ChInt16
quot :: ChInt16 -> ChInt16 -> ChInt16
$crem :: ChInt16 -> ChInt16 -> ChInt16
rem :: ChInt16 -> ChInt16 -> ChInt16
$cdiv :: ChInt16 -> ChInt16 -> ChInt16
div :: ChInt16 -> ChInt16 -> ChInt16
$cmod :: ChInt16 -> ChInt16 -> ChInt16
mod :: ChInt16 -> ChInt16 -> ChInt16
$cquotRem :: ChInt16 -> ChInt16 -> (ChInt16, ChInt16)
quotRem :: ChInt16 -> ChInt16 -> (ChInt16, ChInt16)
$cdivMod :: ChInt16 -> ChInt16 -> (ChInt16, ChInt16)
divMod :: ChInt16 -> ChInt16 -> (ChInt16, ChInt16)
$ctoInteger :: ChInt16 -> Integer
toInteger :: ChInt16 -> Integer
Integral, ChInt16
ChInt16 -> ChInt16 -> Bounded ChInt16
forall a. a -> a -> Bounded a
$cminBound :: ChInt16
minBound :: ChInt16
$cmaxBound :: ChInt16
maxBound :: ChInt16
Bounded, ChInt16 -> ()
(ChInt16 -> ()) -> NFData ChInt16
forall a. (a -> ()) -> NFData a
$crnf :: ChInt16 -> ()
rnf :: ChInt16 -> ()
NFData)

instance IsChType ChInt16 where
  type ToChTypeName ChInt16 = "Int16"
  defaultValueOfTypeName :: ChInt16
defaultValueOfTypeName = ChInt16
0

instance ToQueryPart ChInt16 where toQueryPart :: ChInt16 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChInt16 -> ByteString) -> ChInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChInt16 -> String) -> ChInt16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt16 -> String
forall a. Show a => a -> String
show

instance ToChType ChInt16 Int16   where toChType :: Int16 -> ChInt16
toChType = Int16 -> ChInt16
MkChInt16

instance FromChType ChInt16 Int16   where fromChType :: ChInt16 -> Int16
fromChType (MkChInt16 Int16
int16) = Int16
int16




-- | ClickHouse Int32 column type
newtype ChInt32 = MkChInt32 Int32
  deriving newtype (Int -> ChInt32 -> ShowS
[ChInt32] -> ShowS
ChInt32 -> String
(Int -> ChInt32 -> ShowS)
-> (ChInt32 -> String) -> ([ChInt32] -> ShowS) -> Show ChInt32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt32 -> ShowS
showsPrec :: Int -> ChInt32 -> ShowS
$cshow :: ChInt32 -> String
show :: ChInt32 -> String
$cshowList :: [ChInt32] -> ShowS
showList :: [ChInt32] -> ShowS
Show, ChInt32 -> ChInt32 -> Bool
(ChInt32 -> ChInt32 -> Bool)
-> (ChInt32 -> ChInt32 -> Bool) -> Eq ChInt32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt32 -> ChInt32 -> Bool
== :: ChInt32 -> ChInt32 -> Bool
$c/= :: ChInt32 -> ChInt32 -> Bool
/= :: ChInt32 -> ChInt32 -> Bool
Eq, Integer -> ChInt32
ChInt32 -> ChInt32
ChInt32 -> ChInt32 -> ChInt32
(ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (Integer -> ChInt32)
-> Num ChInt32
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt32 -> ChInt32 -> ChInt32
+ :: ChInt32 -> ChInt32 -> ChInt32
$c- :: ChInt32 -> ChInt32 -> ChInt32
- :: ChInt32 -> ChInt32 -> ChInt32
$c* :: ChInt32 -> ChInt32 -> ChInt32
* :: ChInt32 -> ChInt32 -> ChInt32
$cnegate :: ChInt32 -> ChInt32
negate :: ChInt32 -> ChInt32
$cabs :: ChInt32 -> ChInt32
abs :: ChInt32 -> ChInt32
$csignum :: ChInt32 -> ChInt32
signum :: ChInt32 -> ChInt32
$cfromInteger :: Integer -> ChInt32
fromInteger :: Integer -> ChInt32
Num, Addr# -> Int# -> ChInt32
ByteArray# -> Int# -> ChInt32
ChInt32 -> Int#
(ChInt32 -> Int#)
-> (ChInt32 -> Int#)
-> (ByteArray# -> Int# -> ChInt32)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt32 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt32 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt32 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt32)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt32 #))
-> (forall s. Addr# -> Int# -> ChInt32 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt32 -> State# s -> State# s)
-> Prim ChInt32
forall s. Addr# -> Int# -> Int# -> ChInt32 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt32 #)
forall s. Addr# -> Int# -> ChInt32 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt32 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt32 #)
forall s.
MutableByteArray# s -> Int# -> ChInt32 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt32 -> Int#
sizeOf# :: ChInt32 -> Int#
$calignment# :: ChInt32 -> Int#
alignment# :: ChInt32 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt32
indexByteArray# :: ByteArray# -> Int# -> ChInt32
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt32 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt32 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt32 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt32 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt32 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt32 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt32
indexOffAddr# :: Addr# -> Int# -> ChInt32
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt32 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt32 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt32 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt32 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt32 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt32 -> State# s -> State# s
Prim, Eq ChInt32
ChInt32
Eq ChInt32 =>
(ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> ChInt32
-> (Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> Bool)
-> (ChInt32 -> Maybe Int)
-> (ChInt32 -> Int)
-> (ChInt32 -> Bool)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int -> ChInt32)
-> (ChInt32 -> Int)
-> Bits ChInt32
Int -> ChInt32
ChInt32 -> Bool
ChInt32 -> Int
ChInt32 -> Maybe Int
ChInt32 -> ChInt32
ChInt32 -> Int -> Bool
ChInt32 -> Int -> ChInt32
ChInt32 -> ChInt32 -> ChInt32
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChInt32 -> ChInt32 -> ChInt32
.&. :: ChInt32 -> ChInt32 -> ChInt32
$c.|. :: ChInt32 -> ChInt32 -> ChInt32
.|. :: ChInt32 -> ChInt32 -> ChInt32
$cxor :: ChInt32 -> ChInt32 -> ChInt32
xor :: ChInt32 -> ChInt32 -> ChInt32
$ccomplement :: ChInt32 -> ChInt32
complement :: ChInt32 -> ChInt32
$cshift :: ChInt32 -> Int -> ChInt32
shift :: ChInt32 -> Int -> ChInt32
$crotate :: ChInt32 -> Int -> ChInt32
rotate :: ChInt32 -> Int -> ChInt32
$czeroBits :: ChInt32
zeroBits :: ChInt32
$cbit :: Int -> ChInt32
bit :: Int -> ChInt32
$csetBit :: ChInt32 -> Int -> ChInt32
setBit :: ChInt32 -> Int -> ChInt32
$cclearBit :: ChInt32 -> Int -> ChInt32
clearBit :: ChInt32 -> Int -> ChInt32
$ccomplementBit :: ChInt32 -> Int -> ChInt32
complementBit :: ChInt32 -> Int -> ChInt32
$ctestBit :: ChInt32 -> Int -> Bool
testBit :: ChInt32 -> Int -> Bool
$cbitSizeMaybe :: ChInt32 -> Maybe Int
bitSizeMaybe :: ChInt32 -> Maybe Int
$cbitSize :: ChInt32 -> Int
bitSize :: ChInt32 -> Int
$cisSigned :: ChInt32 -> Bool
isSigned :: ChInt32 -> Bool
$cshiftL :: ChInt32 -> Int -> ChInt32
shiftL :: ChInt32 -> Int -> ChInt32
$cunsafeShiftL :: ChInt32 -> Int -> ChInt32
unsafeShiftL :: ChInt32 -> Int -> ChInt32
$cshiftR :: ChInt32 -> Int -> ChInt32
shiftR :: ChInt32 -> Int -> ChInt32
$cunsafeShiftR :: ChInt32 -> Int -> ChInt32
unsafeShiftR :: ChInt32 -> Int -> ChInt32
$crotateL :: ChInt32 -> Int -> ChInt32
rotateL :: ChInt32 -> Int -> ChInt32
$crotateR :: ChInt32 -> Int -> ChInt32
rotateR :: ChInt32 -> Int -> ChInt32
$cpopCount :: ChInt32 -> Int
popCount :: ChInt32 -> Int
Bits, Int -> ChInt32
ChInt32 -> Int
ChInt32 -> [ChInt32]
ChInt32 -> ChInt32
ChInt32 -> ChInt32 -> [ChInt32]
ChInt32 -> ChInt32 -> ChInt32 -> [ChInt32]
(ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (Int -> ChInt32)
-> (ChInt32 -> Int)
-> (ChInt32 -> [ChInt32])
-> (ChInt32 -> ChInt32 -> [ChInt32])
-> (ChInt32 -> ChInt32 -> [ChInt32])
-> (ChInt32 -> ChInt32 -> ChInt32 -> [ChInt32])
-> Enum ChInt32
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChInt32 -> ChInt32
succ :: ChInt32 -> ChInt32
$cpred :: ChInt32 -> ChInt32
pred :: ChInt32 -> ChInt32
$ctoEnum :: Int -> ChInt32
toEnum :: Int -> ChInt32
$cfromEnum :: ChInt32 -> Int
fromEnum :: ChInt32 -> Int
$cenumFrom :: ChInt32 -> [ChInt32]
enumFrom :: ChInt32 -> [ChInt32]
$cenumFromThen :: ChInt32 -> ChInt32 -> [ChInt32]
enumFromThen :: ChInt32 -> ChInt32 -> [ChInt32]
$cenumFromTo :: ChInt32 -> ChInt32 -> [ChInt32]
enumFromTo :: ChInt32 -> ChInt32 -> [ChInt32]
$cenumFromThenTo :: ChInt32 -> ChInt32 -> ChInt32 -> [ChInt32]
enumFromThenTo :: ChInt32 -> ChInt32 -> ChInt32 -> [ChInt32]
Enum, Eq ChInt32
Eq ChInt32 =>
(ChInt32 -> ChInt32 -> Ordering)
-> (ChInt32 -> ChInt32 -> Bool)
-> (ChInt32 -> ChInt32 -> Bool)
-> (ChInt32 -> ChInt32 -> Bool)
-> (ChInt32 -> ChInt32 -> Bool)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> Ord ChInt32
ChInt32 -> ChInt32 -> Bool
ChInt32 -> ChInt32 -> Ordering
ChInt32 -> ChInt32 -> ChInt32
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChInt32 -> ChInt32 -> Ordering
compare :: ChInt32 -> ChInt32 -> Ordering
$c< :: ChInt32 -> ChInt32 -> Bool
< :: ChInt32 -> ChInt32 -> Bool
$c<= :: ChInt32 -> ChInt32 -> Bool
<= :: ChInt32 -> ChInt32 -> Bool
$c> :: ChInt32 -> ChInt32 -> Bool
> :: ChInt32 -> ChInt32 -> Bool
$c>= :: ChInt32 -> ChInt32 -> Bool
>= :: ChInt32 -> ChInt32 -> Bool
$cmax :: ChInt32 -> ChInt32 -> ChInt32
max :: ChInt32 -> ChInt32 -> ChInt32
$cmin :: ChInt32 -> ChInt32 -> ChInt32
min :: ChInt32 -> ChInt32 -> ChInt32
Ord, Num ChInt32
Ord ChInt32
(Num ChInt32, Ord ChInt32) => (ChInt32 -> Rational) -> Real ChInt32
ChInt32 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChInt32 -> Rational
toRational :: ChInt32 -> Rational
Real, Enum ChInt32
Real ChInt32
(Real ChInt32, Enum ChInt32) =>
(ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> (ChInt32, ChInt32))
-> (ChInt32 -> ChInt32 -> (ChInt32, ChInt32))
-> (ChInt32 -> Integer)
-> Integral ChInt32
ChInt32 -> Integer
ChInt32 -> ChInt32 -> (ChInt32, ChInt32)
ChInt32 -> ChInt32 -> ChInt32
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChInt32 -> ChInt32 -> ChInt32
quot :: ChInt32 -> ChInt32 -> ChInt32
$crem :: ChInt32 -> ChInt32 -> ChInt32
rem :: ChInt32 -> ChInt32 -> ChInt32
$cdiv :: ChInt32 -> ChInt32 -> ChInt32
div :: ChInt32 -> ChInt32 -> ChInt32
$cmod :: ChInt32 -> ChInt32 -> ChInt32
mod :: ChInt32 -> ChInt32 -> ChInt32
$cquotRem :: ChInt32 -> ChInt32 -> (ChInt32, ChInt32)
quotRem :: ChInt32 -> ChInt32 -> (ChInt32, ChInt32)
$cdivMod :: ChInt32 -> ChInt32 -> (ChInt32, ChInt32)
divMod :: ChInt32 -> ChInt32 -> (ChInt32, ChInt32)
$ctoInteger :: ChInt32 -> Integer
toInteger :: ChInt32 -> Integer
Integral, ChInt32
ChInt32 -> ChInt32 -> Bounded ChInt32
forall a. a -> a -> Bounded a
$cminBound :: ChInt32
minBound :: ChInt32
$cmaxBound :: ChInt32
maxBound :: ChInt32
Bounded, ChInt32 -> ()
(ChInt32 -> ()) -> NFData ChInt32
forall a. (a -> ()) -> NFData a
$crnf :: ChInt32 -> ()
rnf :: ChInt32 -> ()
NFData)

instance IsChType ChInt32 where
  type ToChTypeName ChInt32 = "Int32"
  defaultValueOfTypeName :: ChInt32
defaultValueOfTypeName = ChInt32
0

instance ToQueryPart ChInt32 where toQueryPart :: ChInt32 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChInt32 -> ByteString) -> ChInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChInt32 -> String) -> ChInt32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt32 -> String
forall a. Show a => a -> String
show

instance ToChType ChInt32 Int32   where toChType :: Int32 -> ChInt32
toChType = Int32 -> ChInt32
MkChInt32

instance FromChType ChInt32 Int32   where fromChType :: ChInt32 -> Int32
fromChType (MkChInt32 Int32
int32) = Int32
int32




-- | ClickHouse Int64 column type
newtype ChInt64 = MkChInt64 Int64
  deriving newtype (Int -> ChInt64 -> ShowS
[ChInt64] -> ShowS
ChInt64 -> String
(Int -> ChInt64 -> ShowS)
-> (ChInt64 -> String) -> ([ChInt64] -> ShowS) -> Show ChInt64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt64 -> ShowS
showsPrec :: Int -> ChInt64 -> ShowS
$cshow :: ChInt64 -> String
show :: ChInt64 -> String
$cshowList :: [ChInt64] -> ShowS
showList :: [ChInt64] -> ShowS
Show, ChInt64 -> ChInt64 -> Bool
(ChInt64 -> ChInt64 -> Bool)
-> (ChInt64 -> ChInt64 -> Bool) -> Eq ChInt64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt64 -> ChInt64 -> Bool
== :: ChInt64 -> ChInt64 -> Bool
$c/= :: ChInt64 -> ChInt64 -> Bool
/= :: ChInt64 -> ChInt64 -> Bool
Eq, Integer -> ChInt64
ChInt64 -> ChInt64
ChInt64 -> ChInt64 -> ChInt64
(ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (Integer -> ChInt64)
-> Num ChInt64
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt64 -> ChInt64 -> ChInt64
+ :: ChInt64 -> ChInt64 -> ChInt64
$c- :: ChInt64 -> ChInt64 -> ChInt64
- :: ChInt64 -> ChInt64 -> ChInt64
$c* :: ChInt64 -> ChInt64 -> ChInt64
* :: ChInt64 -> ChInt64 -> ChInt64
$cnegate :: ChInt64 -> ChInt64
negate :: ChInt64 -> ChInt64
$cabs :: ChInt64 -> ChInt64
abs :: ChInt64 -> ChInt64
$csignum :: ChInt64 -> ChInt64
signum :: ChInt64 -> ChInt64
$cfromInteger :: Integer -> ChInt64
fromInteger :: Integer -> ChInt64
Num, Addr# -> Int# -> ChInt64
ByteArray# -> Int# -> ChInt64
ChInt64 -> Int#
(ChInt64 -> Int#)
-> (ChInt64 -> Int#)
-> (ByteArray# -> Int# -> ChInt64)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt64 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt64 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt64 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt64)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt64 #))
-> (forall s. Addr# -> Int# -> ChInt64 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt64 -> State# s -> State# s)
-> Prim ChInt64
forall s. Addr# -> Int# -> Int# -> ChInt64 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt64 #)
forall s. Addr# -> Int# -> ChInt64 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt64 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt64 #)
forall s.
MutableByteArray# s -> Int# -> ChInt64 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt64 -> Int#
sizeOf# :: ChInt64 -> Int#
$calignment# :: ChInt64 -> Int#
alignment# :: ChInt64 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt64
indexByteArray# :: ByteArray# -> Int# -> ChInt64
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt64 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt64 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt64 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt64 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt64 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt64 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt64
indexOffAddr# :: Addr# -> Int# -> ChInt64
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt64 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt64 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt64 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt64 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt64 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt64 -> State# s -> State# s
Prim, Eq ChInt64
ChInt64
Eq ChInt64 =>
(ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> ChInt64
-> (Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> Bool)
-> (ChInt64 -> Maybe Int)
-> (ChInt64 -> Int)
-> (ChInt64 -> Bool)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int -> ChInt64)
-> (ChInt64 -> Int)
-> Bits ChInt64
Int -> ChInt64
ChInt64 -> Bool
ChInt64 -> Int
ChInt64 -> Maybe Int
ChInt64 -> ChInt64
ChInt64 -> Int -> Bool
ChInt64 -> Int -> ChInt64
ChInt64 -> ChInt64 -> ChInt64
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChInt64 -> ChInt64 -> ChInt64
.&. :: ChInt64 -> ChInt64 -> ChInt64
$c.|. :: ChInt64 -> ChInt64 -> ChInt64
.|. :: ChInt64 -> ChInt64 -> ChInt64
$cxor :: ChInt64 -> ChInt64 -> ChInt64
xor :: ChInt64 -> ChInt64 -> ChInt64
$ccomplement :: ChInt64 -> ChInt64
complement :: ChInt64 -> ChInt64
$cshift :: ChInt64 -> Int -> ChInt64
shift :: ChInt64 -> Int -> ChInt64
$crotate :: ChInt64 -> Int -> ChInt64
rotate :: ChInt64 -> Int -> ChInt64
$czeroBits :: ChInt64
zeroBits :: ChInt64
$cbit :: Int -> ChInt64
bit :: Int -> ChInt64
$csetBit :: ChInt64 -> Int -> ChInt64
setBit :: ChInt64 -> Int -> ChInt64
$cclearBit :: ChInt64 -> Int -> ChInt64
clearBit :: ChInt64 -> Int -> ChInt64
$ccomplementBit :: ChInt64 -> Int -> ChInt64
complementBit :: ChInt64 -> Int -> ChInt64
$ctestBit :: ChInt64 -> Int -> Bool
testBit :: ChInt64 -> Int -> Bool
$cbitSizeMaybe :: ChInt64 -> Maybe Int
bitSizeMaybe :: ChInt64 -> Maybe Int
$cbitSize :: ChInt64 -> Int
bitSize :: ChInt64 -> Int
$cisSigned :: ChInt64 -> Bool
isSigned :: ChInt64 -> Bool
$cshiftL :: ChInt64 -> Int -> ChInt64
shiftL :: ChInt64 -> Int -> ChInt64
$cunsafeShiftL :: ChInt64 -> Int -> ChInt64
unsafeShiftL :: ChInt64 -> Int -> ChInt64
$cshiftR :: ChInt64 -> Int -> ChInt64
shiftR :: ChInt64 -> Int -> ChInt64
$cunsafeShiftR :: ChInt64 -> Int -> ChInt64
unsafeShiftR :: ChInt64 -> Int -> ChInt64
$crotateL :: ChInt64 -> Int -> ChInt64
rotateL :: ChInt64 -> Int -> ChInt64
$crotateR :: ChInt64 -> Int -> ChInt64
rotateR :: ChInt64 -> Int -> ChInt64
$cpopCount :: ChInt64 -> Int
popCount :: ChInt64 -> Int
Bits, Int -> ChInt64
ChInt64 -> Int
ChInt64 -> [ChInt64]
ChInt64 -> ChInt64
ChInt64 -> ChInt64 -> [ChInt64]
ChInt64 -> ChInt64 -> ChInt64 -> [ChInt64]
(ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (Int -> ChInt64)
-> (ChInt64 -> Int)
-> (ChInt64 -> [ChInt64])
-> (ChInt64 -> ChInt64 -> [ChInt64])
-> (ChInt64 -> ChInt64 -> [ChInt64])
-> (ChInt64 -> ChInt64 -> ChInt64 -> [ChInt64])
-> Enum ChInt64
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChInt64 -> ChInt64
succ :: ChInt64 -> ChInt64
$cpred :: ChInt64 -> ChInt64
pred :: ChInt64 -> ChInt64
$ctoEnum :: Int -> ChInt64
toEnum :: Int -> ChInt64
$cfromEnum :: ChInt64 -> Int
fromEnum :: ChInt64 -> Int
$cenumFrom :: ChInt64 -> [ChInt64]
enumFrom :: ChInt64 -> [ChInt64]
$cenumFromThen :: ChInt64 -> ChInt64 -> [ChInt64]
enumFromThen :: ChInt64 -> ChInt64 -> [ChInt64]
$cenumFromTo :: ChInt64 -> ChInt64 -> [ChInt64]
enumFromTo :: ChInt64 -> ChInt64 -> [ChInt64]
$cenumFromThenTo :: ChInt64 -> ChInt64 -> ChInt64 -> [ChInt64]
enumFromThenTo :: ChInt64 -> ChInt64 -> ChInt64 -> [ChInt64]
Enum, Eq ChInt64
Eq ChInt64 =>
(ChInt64 -> ChInt64 -> Ordering)
-> (ChInt64 -> ChInt64 -> Bool)
-> (ChInt64 -> ChInt64 -> Bool)
-> (ChInt64 -> ChInt64 -> Bool)
-> (ChInt64 -> ChInt64 -> Bool)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> Ord ChInt64
ChInt64 -> ChInt64 -> Bool
ChInt64 -> ChInt64 -> Ordering
ChInt64 -> ChInt64 -> ChInt64
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChInt64 -> ChInt64 -> Ordering
compare :: ChInt64 -> ChInt64 -> Ordering
$c< :: ChInt64 -> ChInt64 -> Bool
< :: ChInt64 -> ChInt64 -> Bool
$c<= :: ChInt64 -> ChInt64 -> Bool
<= :: ChInt64 -> ChInt64 -> Bool
$c> :: ChInt64 -> ChInt64 -> Bool
> :: ChInt64 -> ChInt64 -> Bool
$c>= :: ChInt64 -> ChInt64 -> Bool
>= :: ChInt64 -> ChInt64 -> Bool
$cmax :: ChInt64 -> ChInt64 -> ChInt64
max :: ChInt64 -> ChInt64 -> ChInt64
$cmin :: ChInt64 -> ChInt64 -> ChInt64
min :: ChInt64 -> ChInt64 -> ChInt64
Ord, Num ChInt64
Ord ChInt64
(Num ChInt64, Ord ChInt64) => (ChInt64 -> Rational) -> Real ChInt64
ChInt64 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChInt64 -> Rational
toRational :: ChInt64 -> Rational
Real, Enum ChInt64
Real ChInt64
(Real ChInt64, Enum ChInt64) =>
(ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> (ChInt64, ChInt64))
-> (ChInt64 -> ChInt64 -> (ChInt64, ChInt64))
-> (ChInt64 -> Integer)
-> Integral ChInt64
ChInt64 -> Integer
ChInt64 -> ChInt64 -> (ChInt64, ChInt64)
ChInt64 -> ChInt64 -> ChInt64
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChInt64 -> ChInt64 -> ChInt64
quot :: ChInt64 -> ChInt64 -> ChInt64
$crem :: ChInt64 -> ChInt64 -> ChInt64
rem :: ChInt64 -> ChInt64 -> ChInt64
$cdiv :: ChInt64 -> ChInt64 -> ChInt64
div :: ChInt64 -> ChInt64 -> ChInt64
$cmod :: ChInt64 -> ChInt64 -> ChInt64
mod :: ChInt64 -> ChInt64 -> ChInt64
$cquotRem :: ChInt64 -> ChInt64 -> (ChInt64, ChInt64)
quotRem :: ChInt64 -> ChInt64 -> (ChInt64, ChInt64)
$cdivMod :: ChInt64 -> ChInt64 -> (ChInt64, ChInt64)
divMod :: ChInt64 -> ChInt64 -> (ChInt64, ChInt64)
$ctoInteger :: ChInt64 -> Integer
toInteger :: ChInt64 -> Integer
Integral, ChInt64
ChInt64 -> ChInt64 -> Bounded ChInt64
forall a. a -> a -> Bounded a
$cminBound :: ChInt64
minBound :: ChInt64
$cmaxBound :: ChInt64
maxBound :: ChInt64
Bounded, ChInt64 -> ()
(ChInt64 -> ()) -> NFData ChInt64
forall a. (a -> ()) -> NFData a
$crnf :: ChInt64 -> ()
rnf :: ChInt64 -> ()
NFData)

instance IsChType ChInt64 where
  type ToChTypeName ChInt64 = "Int64"
  defaultValueOfTypeName :: ChInt64
defaultValueOfTypeName = ChInt64
0

instance ToQueryPart ChInt64 where toQueryPart :: ChInt64 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChInt64 -> ByteString) -> ChInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChInt64 -> String) -> ChInt64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt64 -> String
forall a. Show a => a -> String
show

instance ToChType ChInt64 Int64   where toChType :: Int64 -> ChInt64
toChType = Int64 -> ChInt64
MkChInt64 (Int64 -> ChInt64) -> (Int64 -> Int64) -> Int64 -> ChInt64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToChType ChInt64 Int     where toChType :: Int -> ChInt64
toChType = Int64 -> ChInt64
MkChInt64 (Int64 -> ChInt64) -> (Int -> Int64) -> Int -> ChInt64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance FromChType ChInt64 Int64   where fromChType :: ChInt64 -> Int64
fromChType = ChInt64 -> Int64
forall a b. Coercible a b => a -> b
coerce




-- | ClickHouse Int128 column type
newtype ChInt128 = MkChInt128 Int128
  deriving newtype (Int -> ChInt128 -> ShowS
[ChInt128] -> ShowS
ChInt128 -> String
(Int -> ChInt128 -> ShowS)
-> (ChInt128 -> String) -> ([ChInt128] -> ShowS) -> Show ChInt128
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt128 -> ShowS
showsPrec :: Int -> ChInt128 -> ShowS
$cshow :: ChInt128 -> String
show :: ChInt128 -> String
$cshowList :: [ChInt128] -> ShowS
showList :: [ChInt128] -> ShowS
Show, ChInt128 -> ChInt128 -> Bool
(ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> Bool) -> Eq ChInt128
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt128 -> ChInt128 -> Bool
== :: ChInt128 -> ChInt128 -> Bool
$c/= :: ChInt128 -> ChInt128 -> Bool
/= :: ChInt128 -> ChInt128 -> Bool
Eq, Integer -> ChInt128
ChInt128 -> ChInt128
ChInt128 -> ChInt128 -> ChInt128
(ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (Integer -> ChInt128)
-> Num ChInt128
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt128 -> ChInt128 -> ChInt128
+ :: ChInt128 -> ChInt128 -> ChInt128
$c- :: ChInt128 -> ChInt128 -> ChInt128
- :: ChInt128 -> ChInt128 -> ChInt128
$c* :: ChInt128 -> ChInt128 -> ChInt128
* :: ChInt128 -> ChInt128 -> ChInt128
$cnegate :: ChInt128 -> ChInt128
negate :: ChInt128 -> ChInt128
$cabs :: ChInt128 -> ChInt128
abs :: ChInt128 -> ChInt128
$csignum :: ChInt128 -> ChInt128
signum :: ChInt128 -> ChInt128
$cfromInteger :: Integer -> ChInt128
fromInteger :: Integer -> ChInt128
Num, Addr# -> Int# -> ChInt128
ByteArray# -> Int# -> ChInt128
ChInt128 -> Int#
(ChInt128 -> Int#)
-> (ChInt128 -> Int#)
-> (ByteArray# -> Int# -> ChInt128)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChInt128 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt128 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt128 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt128)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChInt128 #))
-> (forall s. Addr# -> Int# -> ChInt128 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt128 -> State# s -> State# s)
-> Prim ChInt128
forall s. Addr# -> Int# -> Int# -> ChInt128 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt128 #)
forall s. Addr# -> Int# -> ChInt128 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt128 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt128 #)
forall s.
MutableByteArray# s -> Int# -> ChInt128 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt128 -> Int#
sizeOf# :: ChInt128 -> Int#
$calignment# :: ChInt128 -> Int#
alignment# :: ChInt128 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt128
indexByteArray# :: ByteArray# -> Int# -> ChInt128
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt128 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt128 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt128 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt128 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt128 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt128 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt128
indexOffAddr# :: Addr# -> Int# -> ChInt128
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt128 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt128 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt128 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt128 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt128 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt128 -> State# s -> State# s
Prim, Eq ChInt128
ChInt128
Eq ChInt128 =>
(ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> ChInt128
-> (Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> Bool)
-> (ChInt128 -> Maybe Int)
-> (ChInt128 -> Int)
-> (ChInt128 -> Bool)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int -> ChInt128)
-> (ChInt128 -> Int)
-> Bits ChInt128
Int -> ChInt128
ChInt128 -> Bool
ChInt128 -> Int
ChInt128 -> Maybe Int
ChInt128 -> ChInt128
ChInt128 -> Int -> Bool
ChInt128 -> Int -> ChInt128
ChInt128 -> ChInt128 -> ChInt128
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChInt128 -> ChInt128 -> ChInt128
.&. :: ChInt128 -> ChInt128 -> ChInt128
$c.|. :: ChInt128 -> ChInt128 -> ChInt128
.|. :: ChInt128 -> ChInt128 -> ChInt128
$cxor :: ChInt128 -> ChInt128 -> ChInt128
xor :: ChInt128 -> ChInt128 -> ChInt128
$ccomplement :: ChInt128 -> ChInt128
complement :: ChInt128 -> ChInt128
$cshift :: ChInt128 -> Int -> ChInt128
shift :: ChInt128 -> Int -> ChInt128
$crotate :: ChInt128 -> Int -> ChInt128
rotate :: ChInt128 -> Int -> ChInt128
$czeroBits :: ChInt128
zeroBits :: ChInt128
$cbit :: Int -> ChInt128
bit :: Int -> ChInt128
$csetBit :: ChInt128 -> Int -> ChInt128
setBit :: ChInt128 -> Int -> ChInt128
$cclearBit :: ChInt128 -> Int -> ChInt128
clearBit :: ChInt128 -> Int -> ChInt128
$ccomplementBit :: ChInt128 -> Int -> ChInt128
complementBit :: ChInt128 -> Int -> ChInt128
$ctestBit :: ChInt128 -> Int -> Bool
testBit :: ChInt128 -> Int -> Bool
$cbitSizeMaybe :: ChInt128 -> Maybe Int
bitSizeMaybe :: ChInt128 -> Maybe Int
$cbitSize :: ChInt128 -> Int
bitSize :: ChInt128 -> Int
$cisSigned :: ChInt128 -> Bool
isSigned :: ChInt128 -> Bool
$cshiftL :: ChInt128 -> Int -> ChInt128
shiftL :: ChInt128 -> Int -> ChInt128
$cunsafeShiftL :: ChInt128 -> Int -> ChInt128
unsafeShiftL :: ChInt128 -> Int -> ChInt128
$cshiftR :: ChInt128 -> Int -> ChInt128
shiftR :: ChInt128 -> Int -> ChInt128
$cunsafeShiftR :: ChInt128 -> Int -> ChInt128
unsafeShiftR :: ChInt128 -> Int -> ChInt128
$crotateL :: ChInt128 -> Int -> ChInt128
rotateL :: ChInt128 -> Int -> ChInt128
$crotateR :: ChInt128 -> Int -> ChInt128
rotateR :: ChInt128 -> Int -> ChInt128
$cpopCount :: ChInt128 -> Int
popCount :: ChInt128 -> Int
Bits, Eq ChInt128
Eq ChInt128 =>
(ChInt128 -> ChInt128 -> Ordering)
-> (ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> Ord ChInt128
ChInt128 -> ChInt128 -> Bool
ChInt128 -> ChInt128 -> Ordering
ChInt128 -> ChInt128 -> ChInt128
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChInt128 -> ChInt128 -> Ordering
compare :: ChInt128 -> ChInt128 -> Ordering
$c< :: ChInt128 -> ChInt128 -> Bool
< :: ChInt128 -> ChInt128 -> Bool
$c<= :: ChInt128 -> ChInt128 -> Bool
<= :: ChInt128 -> ChInt128 -> Bool
$c> :: ChInt128 -> ChInt128 -> Bool
> :: ChInt128 -> ChInt128 -> Bool
$c>= :: ChInt128 -> ChInt128 -> Bool
>= :: ChInt128 -> ChInt128 -> Bool
$cmax :: ChInt128 -> ChInt128 -> ChInt128
max :: ChInt128 -> ChInt128 -> ChInt128
$cmin :: ChInt128 -> ChInt128 -> ChInt128
min :: ChInt128 -> ChInt128 -> ChInt128
Ord, Num ChInt128
Ord ChInt128
(Num ChInt128, Ord ChInt128) =>
(ChInt128 -> Rational) -> Real ChInt128
ChInt128 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChInt128 -> Rational
toRational :: ChInt128 -> Rational
Real, Int -> ChInt128
ChInt128 -> Int
ChInt128 -> [ChInt128]
ChInt128 -> ChInt128
ChInt128 -> ChInt128 -> [ChInt128]
ChInt128 -> ChInt128 -> ChInt128 -> [ChInt128]
(ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (Int -> ChInt128)
-> (ChInt128 -> Int)
-> (ChInt128 -> [ChInt128])
-> (ChInt128 -> ChInt128 -> [ChInt128])
-> (ChInt128 -> ChInt128 -> [ChInt128])
-> (ChInt128 -> ChInt128 -> ChInt128 -> [ChInt128])
-> Enum ChInt128
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChInt128 -> ChInt128
succ :: ChInt128 -> ChInt128
$cpred :: ChInt128 -> ChInt128
pred :: ChInt128 -> ChInt128
$ctoEnum :: Int -> ChInt128
toEnum :: Int -> ChInt128
$cfromEnum :: ChInt128 -> Int
fromEnum :: ChInt128 -> Int
$cenumFrom :: ChInt128 -> [ChInt128]
enumFrom :: ChInt128 -> [ChInt128]
$cenumFromThen :: ChInt128 -> ChInt128 -> [ChInt128]
enumFromThen :: ChInt128 -> ChInt128 -> [ChInt128]
$cenumFromTo :: ChInt128 -> ChInt128 -> [ChInt128]
enumFromTo :: ChInt128 -> ChInt128 -> [ChInt128]
$cenumFromThenTo :: ChInt128 -> ChInt128 -> ChInt128 -> [ChInt128]
enumFromThenTo :: ChInt128 -> ChInt128 -> ChInt128 -> [ChInt128]
Enum, Enum ChInt128
Real ChInt128
(Real ChInt128, Enum ChInt128) =>
(ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> (ChInt128, ChInt128))
-> (ChInt128 -> ChInt128 -> (ChInt128, ChInt128))
-> (ChInt128 -> Integer)
-> Integral ChInt128
ChInt128 -> Integer
ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
ChInt128 -> ChInt128 -> ChInt128
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChInt128 -> ChInt128 -> ChInt128
quot :: ChInt128 -> ChInt128 -> ChInt128
$crem :: ChInt128 -> ChInt128 -> ChInt128
rem :: ChInt128 -> ChInt128 -> ChInt128
$cdiv :: ChInt128 -> ChInt128 -> ChInt128
div :: ChInt128 -> ChInt128 -> ChInt128
$cmod :: ChInt128 -> ChInt128 -> ChInt128
mod :: ChInt128 -> ChInt128 -> ChInt128
$cquotRem :: ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
quotRem :: ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
$cdivMod :: ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
divMod :: ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
$ctoInteger :: ChInt128 -> Integer
toInteger :: ChInt128 -> Integer
Integral, ChInt128
ChInt128 -> ChInt128 -> Bounded ChInt128
forall a. a -> a -> Bounded a
$cminBound :: ChInt128
minBound :: ChInt128
$cmaxBound :: ChInt128
maxBound :: ChInt128
Bounded, ChInt128 -> ()
(ChInt128 -> ()) -> NFData ChInt128
forall a. (a -> ()) -> NFData a
$crnf :: ChInt128 -> ()
rnf :: ChInt128 -> ()
NFData)

instance IsChType ChInt128 where
  type ToChTypeName ChInt128 = "Int128"
  defaultValueOfTypeName :: ChInt128
defaultValueOfTypeName = ChInt128
0

instance ToQueryPart ChInt128 where toQueryPart :: ChInt128 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChInt128 -> ByteString) -> ChInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChInt128 -> String) -> ChInt128 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt128 -> String
forall a. Show a => a -> String
show

instance ToChType ChInt128 Int128   where toChType :: Int128 -> ChInt128
toChType = Int128 -> ChInt128
MkChInt128 (Int128 -> ChInt128) -> (Int128 -> Int128) -> Int128 -> ChInt128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int128 -> Int128
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance FromChType ChInt128 Int128   where fromChType :: ChInt128 -> Int128
fromChType (MkChInt128 Int128
int128) = Int128
int128




-- | ClickHouse UInt8 column type
newtype ChUInt8 = MkChUInt8 Word8
  deriving newtype (Int -> ChUInt8 -> ShowS
[ChUInt8] -> ShowS
ChUInt8 -> String
(Int -> ChUInt8 -> ShowS)
-> (ChUInt8 -> String) -> ([ChUInt8] -> ShowS) -> Show ChUInt8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt8 -> ShowS
showsPrec :: Int -> ChUInt8 -> ShowS
$cshow :: ChUInt8 -> String
show :: ChUInt8 -> String
$cshowList :: [ChUInt8] -> ShowS
showList :: [ChUInt8] -> ShowS
Show, ChUInt8 -> ChUInt8 -> Bool
(ChUInt8 -> ChUInt8 -> Bool)
-> (ChUInt8 -> ChUInt8 -> Bool) -> Eq ChUInt8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt8 -> ChUInt8 -> Bool
== :: ChUInt8 -> ChUInt8 -> Bool
$c/= :: ChUInt8 -> ChUInt8 -> Bool
/= :: ChUInt8 -> ChUInt8 -> Bool
Eq, Integer -> ChUInt8
ChUInt8 -> ChUInt8
ChUInt8 -> ChUInt8 -> ChUInt8
(ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8)
-> (Integer -> ChUInt8)
-> Num ChUInt8
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt8 -> ChUInt8 -> ChUInt8
+ :: ChUInt8 -> ChUInt8 -> ChUInt8
$c- :: ChUInt8 -> ChUInt8 -> ChUInt8
- :: ChUInt8 -> ChUInt8 -> ChUInt8
$c* :: ChUInt8 -> ChUInt8 -> ChUInt8
* :: ChUInt8 -> ChUInt8 -> ChUInt8
$cnegate :: ChUInt8 -> ChUInt8
negate :: ChUInt8 -> ChUInt8
$cabs :: ChUInt8 -> ChUInt8
abs :: ChUInt8 -> ChUInt8
$csignum :: ChUInt8 -> ChUInt8
signum :: ChUInt8 -> ChUInt8
$cfromInteger :: Integer -> ChUInt8
fromInteger :: Integer -> ChUInt8
Num, Addr# -> Int# -> ChUInt8
ByteArray# -> Int# -> ChUInt8
ChUInt8 -> Int#
(ChUInt8 -> Int#)
-> (ChUInt8 -> Int#)
-> (ByteArray# -> Int# -> ChUInt8)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt8 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt8 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt8 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt8)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt8 #))
-> (forall s. Addr# -> Int# -> ChUInt8 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt8 -> State# s -> State# s)
-> Prim ChUInt8
forall s. Addr# -> Int# -> Int# -> ChUInt8 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt8 #)
forall s. Addr# -> Int# -> ChUInt8 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt8 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt8 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt8 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt8 -> Int#
sizeOf# :: ChUInt8 -> Int#
$calignment# :: ChUInt8 -> Int#
alignment# :: ChUInt8 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt8
indexByteArray# :: ByteArray# -> Int# -> ChUInt8
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt8 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt8 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt8 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt8 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt8 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt8 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt8
indexOffAddr# :: Addr# -> Int# -> ChUInt8
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt8 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt8 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt8 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt8 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt8 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt8 -> State# s -> State# s
Prim, Eq ChUInt8
ChUInt8
Eq ChUInt8 =>
(ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> ChUInt8
-> (Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> Bool)
-> (ChUInt8 -> Maybe Int)
-> (ChUInt8 -> Int)
-> (ChUInt8 -> Bool)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int -> ChUInt8)
-> (ChUInt8 -> Int)
-> Bits ChUInt8
Int -> ChUInt8
ChUInt8 -> Bool
ChUInt8 -> Int
ChUInt8 -> Maybe Int
ChUInt8 -> ChUInt8
ChUInt8 -> Int -> Bool
ChUInt8 -> Int -> ChUInt8
ChUInt8 -> ChUInt8 -> ChUInt8
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChUInt8 -> ChUInt8 -> ChUInt8
.&. :: ChUInt8 -> ChUInt8 -> ChUInt8
$c.|. :: ChUInt8 -> ChUInt8 -> ChUInt8
.|. :: ChUInt8 -> ChUInt8 -> ChUInt8
$cxor :: ChUInt8 -> ChUInt8 -> ChUInt8
xor :: ChUInt8 -> ChUInt8 -> ChUInt8
$ccomplement :: ChUInt8 -> ChUInt8
complement :: ChUInt8 -> ChUInt8
$cshift :: ChUInt8 -> Int -> ChUInt8
shift :: ChUInt8 -> Int -> ChUInt8
$crotate :: ChUInt8 -> Int -> ChUInt8
rotate :: ChUInt8 -> Int -> ChUInt8
$czeroBits :: ChUInt8
zeroBits :: ChUInt8
$cbit :: Int -> ChUInt8
bit :: Int -> ChUInt8
$csetBit :: ChUInt8 -> Int -> ChUInt8
setBit :: ChUInt8 -> Int -> ChUInt8
$cclearBit :: ChUInt8 -> Int -> ChUInt8
clearBit :: ChUInt8 -> Int -> ChUInt8
$ccomplementBit :: ChUInt8 -> Int -> ChUInt8
complementBit :: ChUInt8 -> Int -> ChUInt8
$ctestBit :: ChUInt8 -> Int -> Bool
testBit :: ChUInt8 -> Int -> Bool
$cbitSizeMaybe :: ChUInt8 -> Maybe Int
bitSizeMaybe :: ChUInt8 -> Maybe Int
$cbitSize :: ChUInt8 -> Int
bitSize :: ChUInt8 -> Int
$cisSigned :: ChUInt8 -> Bool
isSigned :: ChUInt8 -> Bool
$cshiftL :: ChUInt8 -> Int -> ChUInt8
shiftL :: ChUInt8 -> Int -> ChUInt8
$cunsafeShiftL :: ChUInt8 -> Int -> ChUInt8
unsafeShiftL :: ChUInt8 -> Int -> ChUInt8
$cshiftR :: ChUInt8 -> Int -> ChUInt8
shiftR :: ChUInt8 -> Int -> ChUInt8
$cunsafeShiftR :: ChUInt8 -> Int -> ChUInt8
unsafeShiftR :: ChUInt8 -> Int -> ChUInt8
$crotateL :: ChUInt8 -> Int -> ChUInt8
rotateL :: ChUInt8 -> Int -> ChUInt8
$crotateR :: ChUInt8 -> Int -> ChUInt8
rotateR :: ChUInt8 -> Int -> ChUInt8
$cpopCount :: ChUInt8 -> Int
popCount :: ChUInt8 -> Int
Bits, Int -> ChUInt8
ChUInt8 -> Int
ChUInt8 -> [ChUInt8]
ChUInt8 -> ChUInt8
ChUInt8 -> ChUInt8 -> [ChUInt8]
ChUInt8 -> ChUInt8 -> ChUInt8 -> [ChUInt8]
(ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8)
-> (Int -> ChUInt8)
-> (ChUInt8 -> Int)
-> (ChUInt8 -> [ChUInt8])
-> (ChUInt8 -> ChUInt8 -> [ChUInt8])
-> (ChUInt8 -> ChUInt8 -> [ChUInt8])
-> (ChUInt8 -> ChUInt8 -> ChUInt8 -> [ChUInt8])
-> Enum ChUInt8
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUInt8 -> ChUInt8
succ :: ChUInt8 -> ChUInt8
$cpred :: ChUInt8 -> ChUInt8
pred :: ChUInt8 -> ChUInt8
$ctoEnum :: Int -> ChUInt8
toEnum :: Int -> ChUInt8
$cfromEnum :: ChUInt8 -> Int
fromEnum :: ChUInt8 -> Int
$cenumFrom :: ChUInt8 -> [ChUInt8]
enumFrom :: ChUInt8 -> [ChUInt8]
$cenumFromThen :: ChUInt8 -> ChUInt8 -> [ChUInt8]
enumFromThen :: ChUInt8 -> ChUInt8 -> [ChUInt8]
$cenumFromTo :: ChUInt8 -> ChUInt8 -> [ChUInt8]
enumFromTo :: ChUInt8 -> ChUInt8 -> [ChUInt8]
$cenumFromThenTo :: ChUInt8 -> ChUInt8 -> ChUInt8 -> [ChUInt8]
enumFromThenTo :: ChUInt8 -> ChUInt8 -> ChUInt8 -> [ChUInt8]
Enum, Eq ChUInt8
Eq ChUInt8 =>
(ChUInt8 -> ChUInt8 -> Ordering)
-> (ChUInt8 -> ChUInt8 -> Bool)
-> (ChUInt8 -> ChUInt8 -> Bool)
-> (ChUInt8 -> ChUInt8 -> Bool)
-> (ChUInt8 -> ChUInt8 -> Bool)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> Ord ChUInt8
ChUInt8 -> ChUInt8 -> Bool
ChUInt8 -> ChUInt8 -> Ordering
ChUInt8 -> ChUInt8 -> ChUInt8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChUInt8 -> ChUInt8 -> Ordering
compare :: ChUInt8 -> ChUInt8 -> Ordering
$c< :: ChUInt8 -> ChUInt8 -> Bool
< :: ChUInt8 -> ChUInt8 -> Bool
$c<= :: ChUInt8 -> ChUInt8 -> Bool
<= :: ChUInt8 -> ChUInt8 -> Bool
$c> :: ChUInt8 -> ChUInt8 -> Bool
> :: ChUInt8 -> ChUInt8 -> Bool
$c>= :: ChUInt8 -> ChUInt8 -> Bool
>= :: ChUInt8 -> ChUInt8 -> Bool
$cmax :: ChUInt8 -> ChUInt8 -> ChUInt8
max :: ChUInt8 -> ChUInt8 -> ChUInt8
$cmin :: ChUInt8 -> ChUInt8 -> ChUInt8
min :: ChUInt8 -> ChUInt8 -> ChUInt8
Ord, Num ChUInt8
Ord ChUInt8
(Num ChUInt8, Ord ChUInt8) => (ChUInt8 -> Rational) -> Real ChUInt8
ChUInt8 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChUInt8 -> Rational
toRational :: ChUInt8 -> Rational
Real, Enum ChUInt8
Real ChUInt8
(Real ChUInt8, Enum ChUInt8) =>
(ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> (ChUInt8, ChUInt8))
-> (ChUInt8 -> ChUInt8 -> (ChUInt8, ChUInt8))
-> (ChUInt8 -> Integer)
-> Integral ChUInt8
ChUInt8 -> Integer
ChUInt8 -> ChUInt8 -> (ChUInt8, ChUInt8)
ChUInt8 -> ChUInt8 -> ChUInt8
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChUInt8 -> ChUInt8 -> ChUInt8
quot :: ChUInt8 -> ChUInt8 -> ChUInt8
$crem :: ChUInt8 -> ChUInt8 -> ChUInt8
rem :: ChUInt8 -> ChUInt8 -> ChUInt8
$cdiv :: ChUInt8 -> ChUInt8 -> ChUInt8
div :: ChUInt8 -> ChUInt8 -> ChUInt8
$cmod :: ChUInt8 -> ChUInt8 -> ChUInt8
mod :: ChUInt8 -> ChUInt8 -> ChUInt8
$cquotRem :: ChUInt8 -> ChUInt8 -> (ChUInt8, ChUInt8)
quotRem :: ChUInt8 -> ChUInt8 -> (ChUInt8, ChUInt8)
$cdivMod :: ChUInt8 -> ChUInt8 -> (ChUInt8, ChUInt8)
divMod :: ChUInt8 -> ChUInt8 -> (ChUInt8, ChUInt8)
$ctoInteger :: ChUInt8 -> Integer
toInteger :: ChUInt8 -> Integer
Integral, ChUInt8
ChUInt8 -> ChUInt8 -> Bounded ChUInt8
forall a. a -> a -> Bounded a
$cminBound :: ChUInt8
minBound :: ChUInt8
$cmaxBound :: ChUInt8
maxBound :: ChUInt8
Bounded, ChUInt8 -> ()
(ChUInt8 -> ()) -> NFData ChUInt8
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt8 -> ()
rnf :: ChUInt8 -> ()
NFData)

instance IsChType ChUInt8 where
  type ToChTypeName ChUInt8 = "UInt8"
  defaultValueOfTypeName :: ChUInt8
defaultValueOfTypeName = ChUInt8
0


instance ToQueryPart ChUInt8 where toQueryPart :: ChUInt8 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChUInt8 -> ByteString) -> ChUInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChUInt8 -> String) -> ChUInt8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt8 -> String
forall a. Show a => a -> String
show

instance ToChType ChUInt8 Word8   where toChType :: Word8 -> ChUInt8
toChType = Word8 -> ChUInt8
MkChUInt8

instance FromChType ChUInt8 Word8   where fromChType :: ChUInt8 -> Word8
fromChType (MkChUInt8 Word8
w8) = Word8
w8




-- | ClickHouse UInt16 column type
newtype ChUInt16 = MkChUInt16 Word16
  deriving newtype (Int -> ChUInt16 -> ShowS
[ChUInt16] -> ShowS
ChUInt16 -> String
(Int -> ChUInt16 -> ShowS)
-> (ChUInt16 -> String) -> ([ChUInt16] -> ShowS) -> Show ChUInt16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt16 -> ShowS
showsPrec :: Int -> ChUInt16 -> ShowS
$cshow :: ChUInt16 -> String
show :: ChUInt16 -> String
$cshowList :: [ChUInt16] -> ShowS
showList :: [ChUInt16] -> ShowS
Show, ChUInt16 -> ChUInt16 -> Bool
(ChUInt16 -> ChUInt16 -> Bool)
-> (ChUInt16 -> ChUInt16 -> Bool) -> Eq ChUInt16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt16 -> ChUInt16 -> Bool
== :: ChUInt16 -> ChUInt16 -> Bool
$c/= :: ChUInt16 -> ChUInt16 -> Bool
/= :: ChUInt16 -> ChUInt16 -> Bool
Eq, Integer -> ChUInt16
ChUInt16 -> ChUInt16
ChUInt16 -> ChUInt16 -> ChUInt16
(ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16)
-> (Integer -> ChUInt16)
-> Num ChUInt16
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt16 -> ChUInt16 -> ChUInt16
+ :: ChUInt16 -> ChUInt16 -> ChUInt16
$c- :: ChUInt16 -> ChUInt16 -> ChUInt16
- :: ChUInt16 -> ChUInt16 -> ChUInt16
$c* :: ChUInt16 -> ChUInt16 -> ChUInt16
* :: ChUInt16 -> ChUInt16 -> ChUInt16
$cnegate :: ChUInt16 -> ChUInt16
negate :: ChUInt16 -> ChUInt16
$cabs :: ChUInt16 -> ChUInt16
abs :: ChUInt16 -> ChUInt16
$csignum :: ChUInt16 -> ChUInt16
signum :: ChUInt16 -> ChUInt16
$cfromInteger :: Integer -> ChUInt16
fromInteger :: Integer -> ChUInt16
Num, Addr# -> Int# -> ChUInt16
ByteArray# -> Int# -> ChUInt16
ChUInt16 -> Int#
(ChUInt16 -> Int#)
-> (ChUInt16 -> Int#)
-> (ByteArray# -> Int# -> ChUInt16)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChUInt16 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt16 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt16 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt16)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChUInt16 #))
-> (forall s. Addr# -> Int# -> ChUInt16 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt16 -> State# s -> State# s)
-> Prim ChUInt16
forall s. Addr# -> Int# -> Int# -> ChUInt16 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt16 #)
forall s. Addr# -> Int# -> ChUInt16 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt16 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt16 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt16 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt16 -> Int#
sizeOf# :: ChUInt16 -> Int#
$calignment# :: ChUInt16 -> Int#
alignment# :: ChUInt16 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt16
indexByteArray# :: ByteArray# -> Int# -> ChUInt16
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt16 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt16 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt16 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt16 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt16 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt16 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt16
indexOffAddr# :: Addr# -> Int# -> ChUInt16
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt16 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt16 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt16 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt16 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt16 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt16 -> State# s -> State# s
Prim, Eq ChUInt16
ChUInt16
Eq ChUInt16 =>
(ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> ChUInt16
-> (Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> Bool)
-> (ChUInt16 -> Maybe Int)
-> (ChUInt16 -> Int)
-> (ChUInt16 -> Bool)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int -> ChUInt16)
-> (ChUInt16 -> Int)
-> Bits ChUInt16
Int -> ChUInt16
ChUInt16 -> Bool
ChUInt16 -> Int
ChUInt16 -> Maybe Int
ChUInt16 -> ChUInt16
ChUInt16 -> Int -> Bool
ChUInt16 -> Int -> ChUInt16
ChUInt16 -> ChUInt16 -> ChUInt16
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChUInt16 -> ChUInt16 -> ChUInt16
.&. :: ChUInt16 -> ChUInt16 -> ChUInt16
$c.|. :: ChUInt16 -> ChUInt16 -> ChUInt16
.|. :: ChUInt16 -> ChUInt16 -> ChUInt16
$cxor :: ChUInt16 -> ChUInt16 -> ChUInt16
xor :: ChUInt16 -> ChUInt16 -> ChUInt16
$ccomplement :: ChUInt16 -> ChUInt16
complement :: ChUInt16 -> ChUInt16
$cshift :: ChUInt16 -> Int -> ChUInt16
shift :: ChUInt16 -> Int -> ChUInt16
$crotate :: ChUInt16 -> Int -> ChUInt16
rotate :: ChUInt16 -> Int -> ChUInt16
$czeroBits :: ChUInt16
zeroBits :: ChUInt16
$cbit :: Int -> ChUInt16
bit :: Int -> ChUInt16
$csetBit :: ChUInt16 -> Int -> ChUInt16
setBit :: ChUInt16 -> Int -> ChUInt16
$cclearBit :: ChUInt16 -> Int -> ChUInt16
clearBit :: ChUInt16 -> Int -> ChUInt16
$ccomplementBit :: ChUInt16 -> Int -> ChUInt16
complementBit :: ChUInt16 -> Int -> ChUInt16
$ctestBit :: ChUInt16 -> Int -> Bool
testBit :: ChUInt16 -> Int -> Bool
$cbitSizeMaybe :: ChUInt16 -> Maybe Int
bitSizeMaybe :: ChUInt16 -> Maybe Int
$cbitSize :: ChUInt16 -> Int
bitSize :: ChUInt16 -> Int
$cisSigned :: ChUInt16 -> Bool
isSigned :: ChUInt16 -> Bool
$cshiftL :: ChUInt16 -> Int -> ChUInt16
shiftL :: ChUInt16 -> Int -> ChUInt16
$cunsafeShiftL :: ChUInt16 -> Int -> ChUInt16
unsafeShiftL :: ChUInt16 -> Int -> ChUInt16
$cshiftR :: ChUInt16 -> Int -> ChUInt16
shiftR :: ChUInt16 -> Int -> ChUInt16
$cunsafeShiftR :: ChUInt16 -> Int -> ChUInt16
unsafeShiftR :: ChUInt16 -> Int -> ChUInt16
$crotateL :: ChUInt16 -> Int -> ChUInt16
rotateL :: ChUInt16 -> Int -> ChUInt16
$crotateR :: ChUInt16 -> Int -> ChUInt16
rotateR :: ChUInt16 -> Int -> ChUInt16
$cpopCount :: ChUInt16 -> Int
popCount :: ChUInt16 -> Int
Bits, Int -> ChUInt16
ChUInt16 -> Int
ChUInt16 -> [ChUInt16]
ChUInt16 -> ChUInt16
ChUInt16 -> ChUInt16 -> [ChUInt16]
ChUInt16 -> ChUInt16 -> ChUInt16 -> [ChUInt16]
(ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16)
-> (Int -> ChUInt16)
-> (ChUInt16 -> Int)
-> (ChUInt16 -> [ChUInt16])
-> (ChUInt16 -> ChUInt16 -> [ChUInt16])
-> (ChUInt16 -> ChUInt16 -> [ChUInt16])
-> (ChUInt16 -> ChUInt16 -> ChUInt16 -> [ChUInt16])
-> Enum ChUInt16
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUInt16 -> ChUInt16
succ :: ChUInt16 -> ChUInt16
$cpred :: ChUInt16 -> ChUInt16
pred :: ChUInt16 -> ChUInt16
$ctoEnum :: Int -> ChUInt16
toEnum :: Int -> ChUInt16
$cfromEnum :: ChUInt16 -> Int
fromEnum :: ChUInt16 -> Int
$cenumFrom :: ChUInt16 -> [ChUInt16]
enumFrom :: ChUInt16 -> [ChUInt16]
$cenumFromThen :: ChUInt16 -> ChUInt16 -> [ChUInt16]
enumFromThen :: ChUInt16 -> ChUInt16 -> [ChUInt16]
$cenumFromTo :: ChUInt16 -> ChUInt16 -> [ChUInt16]
enumFromTo :: ChUInt16 -> ChUInt16 -> [ChUInt16]
$cenumFromThenTo :: ChUInt16 -> ChUInt16 -> ChUInt16 -> [ChUInt16]
enumFromThenTo :: ChUInt16 -> ChUInt16 -> ChUInt16 -> [ChUInt16]
Enum, Eq ChUInt16
Eq ChUInt16 =>
(ChUInt16 -> ChUInt16 -> Ordering)
-> (ChUInt16 -> ChUInt16 -> Bool)
-> (ChUInt16 -> ChUInt16 -> Bool)
-> (ChUInt16 -> ChUInt16 -> Bool)
-> (ChUInt16 -> ChUInt16 -> Bool)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> Ord ChUInt16
ChUInt16 -> ChUInt16 -> Bool
ChUInt16 -> ChUInt16 -> Ordering
ChUInt16 -> ChUInt16 -> ChUInt16
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChUInt16 -> ChUInt16 -> Ordering
compare :: ChUInt16 -> ChUInt16 -> Ordering
$c< :: ChUInt16 -> ChUInt16 -> Bool
< :: ChUInt16 -> ChUInt16 -> Bool
$c<= :: ChUInt16 -> ChUInt16 -> Bool
<= :: ChUInt16 -> ChUInt16 -> Bool
$c> :: ChUInt16 -> ChUInt16 -> Bool
> :: ChUInt16 -> ChUInt16 -> Bool
$c>= :: ChUInt16 -> ChUInt16 -> Bool
>= :: ChUInt16 -> ChUInt16 -> Bool
$cmax :: ChUInt16 -> ChUInt16 -> ChUInt16
max :: ChUInt16 -> ChUInt16 -> ChUInt16
$cmin :: ChUInt16 -> ChUInt16 -> ChUInt16
min :: ChUInt16 -> ChUInt16 -> ChUInt16
Ord, Num ChUInt16
Ord ChUInt16
(Num ChUInt16, Ord ChUInt16) =>
(ChUInt16 -> Rational) -> Real ChUInt16
ChUInt16 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChUInt16 -> Rational
toRational :: ChUInt16 -> Rational
Real, Enum ChUInt16
Real ChUInt16
(Real ChUInt16, Enum ChUInt16) =>
(ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> (ChUInt16, ChUInt16))
-> (ChUInt16 -> ChUInt16 -> (ChUInt16, ChUInt16))
-> (ChUInt16 -> Integer)
-> Integral ChUInt16
ChUInt16 -> Integer
ChUInt16 -> ChUInt16 -> (ChUInt16, ChUInt16)
ChUInt16 -> ChUInt16 -> ChUInt16
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChUInt16 -> ChUInt16 -> ChUInt16
quot :: ChUInt16 -> ChUInt16 -> ChUInt16
$crem :: ChUInt16 -> ChUInt16 -> ChUInt16
rem :: ChUInt16 -> ChUInt16 -> ChUInt16
$cdiv :: ChUInt16 -> ChUInt16 -> ChUInt16
div :: ChUInt16 -> ChUInt16 -> ChUInt16
$cmod :: ChUInt16 -> ChUInt16 -> ChUInt16
mod :: ChUInt16 -> ChUInt16 -> ChUInt16
$cquotRem :: ChUInt16 -> ChUInt16 -> (ChUInt16, ChUInt16)
quotRem :: ChUInt16 -> ChUInt16 -> (ChUInt16, ChUInt16)
$cdivMod :: ChUInt16 -> ChUInt16 -> (ChUInt16, ChUInt16)
divMod :: ChUInt16 -> ChUInt16 -> (ChUInt16, ChUInt16)
$ctoInteger :: ChUInt16 -> Integer
toInteger :: ChUInt16 -> Integer
Integral, ChUInt16
ChUInt16 -> ChUInt16 -> Bounded ChUInt16
forall a. a -> a -> Bounded a
$cminBound :: ChUInt16
minBound :: ChUInt16
$cmaxBound :: ChUInt16
maxBound :: ChUInt16
Bounded, ChUInt16 -> ()
(ChUInt16 -> ()) -> NFData ChUInt16
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt16 -> ()
rnf :: ChUInt16 -> ()
NFData)

instance IsChType ChUInt16 where
  type ToChTypeName ChUInt16 = "UInt16"
  defaultValueOfTypeName :: ChUInt16
defaultValueOfTypeName = ChUInt16
0

instance ToQueryPart ChUInt16 where toQueryPart :: ChUInt16 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChUInt16 -> ByteString) -> ChUInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChUInt16 -> String) -> ChUInt16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt16 -> String
forall a. Show a => a -> String
show

instance ToChType ChUInt16 Word16   where toChType :: Word16 -> ChUInt16
toChType = Word16 -> ChUInt16
forall a b. Coercible a b => a -> b
coerce

instance FromChType ChUInt16 Word16   where fromChType :: ChUInt16 -> Word16
fromChType = ChUInt16 -> Word16
forall a b. Coercible a b => a -> b
coerce




-- | ClickHouse UInt32 column type
newtype ChUInt32 = MkChUInt32 Word32
  deriving newtype (Int -> ChUInt32 -> ShowS
[ChUInt32] -> ShowS
ChUInt32 -> String
(Int -> ChUInt32 -> ShowS)
-> (ChUInt32 -> String) -> ([ChUInt32] -> ShowS) -> Show ChUInt32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt32 -> ShowS
showsPrec :: Int -> ChUInt32 -> ShowS
$cshow :: ChUInt32 -> String
show :: ChUInt32 -> String
$cshowList :: [ChUInt32] -> ShowS
showList :: [ChUInt32] -> ShowS
Show, ChUInt32 -> ChUInt32 -> Bool
(ChUInt32 -> ChUInt32 -> Bool)
-> (ChUInt32 -> ChUInt32 -> Bool) -> Eq ChUInt32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt32 -> ChUInt32 -> Bool
== :: ChUInt32 -> ChUInt32 -> Bool
$c/= :: ChUInt32 -> ChUInt32 -> Bool
/= :: ChUInt32 -> ChUInt32 -> Bool
Eq, Integer -> ChUInt32
ChUInt32 -> ChUInt32
ChUInt32 -> ChUInt32 -> ChUInt32
(ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (Integer -> ChUInt32)
-> Num ChUInt32
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt32 -> ChUInt32 -> ChUInt32
+ :: ChUInt32 -> ChUInt32 -> ChUInt32
$c- :: ChUInt32 -> ChUInt32 -> ChUInt32
- :: ChUInt32 -> ChUInt32 -> ChUInt32
$c* :: ChUInt32 -> ChUInt32 -> ChUInt32
* :: ChUInt32 -> ChUInt32 -> ChUInt32
$cnegate :: ChUInt32 -> ChUInt32
negate :: ChUInt32 -> ChUInt32
$cabs :: ChUInt32 -> ChUInt32
abs :: ChUInt32 -> ChUInt32
$csignum :: ChUInt32 -> ChUInt32
signum :: ChUInt32 -> ChUInt32
$cfromInteger :: Integer -> ChUInt32
fromInteger :: Integer -> ChUInt32
Num, Addr# -> Int# -> ChUInt32
ByteArray# -> Int# -> ChUInt32
ChUInt32 -> Int#
(ChUInt32 -> Int#)
-> (ChUInt32 -> Int#)
-> (ByteArray# -> Int# -> ChUInt32)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChUInt32 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt32 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt32 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt32)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChUInt32 #))
-> (forall s. Addr# -> Int# -> ChUInt32 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt32 -> State# s -> State# s)
-> Prim ChUInt32
forall s. Addr# -> Int# -> Int# -> ChUInt32 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt32 #)
forall s. Addr# -> Int# -> ChUInt32 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt32 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt32 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt32 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt32 -> Int#
sizeOf# :: ChUInt32 -> Int#
$calignment# :: ChUInt32 -> Int#
alignment# :: ChUInt32 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt32
indexByteArray# :: ByteArray# -> Int# -> ChUInt32
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt32 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt32 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt32 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt32 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt32 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt32 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt32
indexOffAddr# :: Addr# -> Int# -> ChUInt32
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt32 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt32 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt32 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt32 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt32 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt32 -> State# s -> State# s
Prim, Eq ChUInt32
ChUInt32
Eq ChUInt32 =>
(ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> ChUInt32
-> (Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> Bool)
-> (ChUInt32 -> Maybe Int)
-> (ChUInt32 -> Int)
-> (ChUInt32 -> Bool)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int -> ChUInt32)
-> (ChUInt32 -> Int)
-> Bits ChUInt32
Int -> ChUInt32
ChUInt32 -> Bool
ChUInt32 -> Int
ChUInt32 -> Maybe Int
ChUInt32 -> ChUInt32
ChUInt32 -> Int -> Bool
ChUInt32 -> Int -> ChUInt32
ChUInt32 -> ChUInt32 -> ChUInt32
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChUInt32 -> ChUInt32 -> ChUInt32
.&. :: ChUInt32 -> ChUInt32 -> ChUInt32
$c.|. :: ChUInt32 -> ChUInt32 -> ChUInt32
.|. :: ChUInt32 -> ChUInt32 -> ChUInt32
$cxor :: ChUInt32 -> ChUInt32 -> ChUInt32
xor :: ChUInt32 -> ChUInt32 -> ChUInt32
$ccomplement :: ChUInt32 -> ChUInt32
complement :: ChUInt32 -> ChUInt32
$cshift :: ChUInt32 -> Int -> ChUInt32
shift :: ChUInt32 -> Int -> ChUInt32
$crotate :: ChUInt32 -> Int -> ChUInt32
rotate :: ChUInt32 -> Int -> ChUInt32
$czeroBits :: ChUInt32
zeroBits :: ChUInt32
$cbit :: Int -> ChUInt32
bit :: Int -> ChUInt32
$csetBit :: ChUInt32 -> Int -> ChUInt32
setBit :: ChUInt32 -> Int -> ChUInt32
$cclearBit :: ChUInt32 -> Int -> ChUInt32
clearBit :: ChUInt32 -> Int -> ChUInt32
$ccomplementBit :: ChUInt32 -> Int -> ChUInt32
complementBit :: ChUInt32 -> Int -> ChUInt32
$ctestBit :: ChUInt32 -> Int -> Bool
testBit :: ChUInt32 -> Int -> Bool
$cbitSizeMaybe :: ChUInt32 -> Maybe Int
bitSizeMaybe :: ChUInt32 -> Maybe Int
$cbitSize :: ChUInt32 -> Int
bitSize :: ChUInt32 -> Int
$cisSigned :: ChUInt32 -> Bool
isSigned :: ChUInt32 -> Bool
$cshiftL :: ChUInt32 -> Int -> ChUInt32
shiftL :: ChUInt32 -> Int -> ChUInt32
$cunsafeShiftL :: ChUInt32 -> Int -> ChUInt32
unsafeShiftL :: ChUInt32 -> Int -> ChUInt32
$cshiftR :: ChUInt32 -> Int -> ChUInt32
shiftR :: ChUInt32 -> Int -> ChUInt32
$cunsafeShiftR :: ChUInt32 -> Int -> ChUInt32
unsafeShiftR :: ChUInt32 -> Int -> ChUInt32
$crotateL :: ChUInt32 -> Int -> ChUInt32
rotateL :: ChUInt32 -> Int -> ChUInt32
$crotateR :: ChUInt32 -> Int -> ChUInt32
rotateR :: ChUInt32 -> Int -> ChUInt32
$cpopCount :: ChUInt32 -> Int
popCount :: ChUInt32 -> Int
Bits, Int -> ChUInt32
ChUInt32 -> Int
ChUInt32 -> [ChUInt32]
ChUInt32 -> ChUInt32
ChUInt32 -> ChUInt32 -> [ChUInt32]
ChUInt32 -> ChUInt32 -> ChUInt32 -> [ChUInt32]
(ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (Int -> ChUInt32)
-> (ChUInt32 -> Int)
-> (ChUInt32 -> [ChUInt32])
-> (ChUInt32 -> ChUInt32 -> [ChUInt32])
-> (ChUInt32 -> ChUInt32 -> [ChUInt32])
-> (ChUInt32 -> ChUInt32 -> ChUInt32 -> [ChUInt32])
-> Enum ChUInt32
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUInt32 -> ChUInt32
succ :: ChUInt32 -> ChUInt32
$cpred :: ChUInt32 -> ChUInt32
pred :: ChUInt32 -> ChUInt32
$ctoEnum :: Int -> ChUInt32
toEnum :: Int -> ChUInt32
$cfromEnum :: ChUInt32 -> Int
fromEnum :: ChUInt32 -> Int
$cenumFrom :: ChUInt32 -> [ChUInt32]
enumFrom :: ChUInt32 -> [ChUInt32]
$cenumFromThen :: ChUInt32 -> ChUInt32 -> [ChUInt32]
enumFromThen :: ChUInt32 -> ChUInt32 -> [ChUInt32]
$cenumFromTo :: ChUInt32 -> ChUInt32 -> [ChUInt32]
enumFromTo :: ChUInt32 -> ChUInt32 -> [ChUInt32]
$cenumFromThenTo :: ChUInt32 -> ChUInt32 -> ChUInt32 -> [ChUInt32]
enumFromThenTo :: ChUInt32 -> ChUInt32 -> ChUInt32 -> [ChUInt32]
Enum, Eq ChUInt32
Eq ChUInt32 =>
(ChUInt32 -> ChUInt32 -> Ordering)
-> (ChUInt32 -> ChUInt32 -> Bool)
-> (ChUInt32 -> ChUInt32 -> Bool)
-> (ChUInt32 -> ChUInt32 -> Bool)
-> (ChUInt32 -> ChUInt32 -> Bool)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> Ord ChUInt32
ChUInt32 -> ChUInt32 -> Bool
ChUInt32 -> ChUInt32 -> Ordering
ChUInt32 -> ChUInt32 -> ChUInt32
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChUInt32 -> ChUInt32 -> Ordering
compare :: ChUInt32 -> ChUInt32 -> Ordering
$c< :: ChUInt32 -> ChUInt32 -> Bool
< :: ChUInt32 -> ChUInt32 -> Bool
$c<= :: ChUInt32 -> ChUInt32 -> Bool
<= :: ChUInt32 -> ChUInt32 -> Bool
$c> :: ChUInt32 -> ChUInt32 -> Bool
> :: ChUInt32 -> ChUInt32 -> Bool
$c>= :: ChUInt32 -> ChUInt32 -> Bool
>= :: ChUInt32 -> ChUInt32 -> Bool
$cmax :: ChUInt32 -> ChUInt32 -> ChUInt32
max :: ChUInt32 -> ChUInt32 -> ChUInt32
$cmin :: ChUInt32 -> ChUInt32 -> ChUInt32
min :: ChUInt32 -> ChUInt32 -> ChUInt32
Ord, Num ChUInt32
Ord ChUInt32
(Num ChUInt32, Ord ChUInt32) =>
(ChUInt32 -> Rational) -> Real ChUInt32
ChUInt32 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChUInt32 -> Rational
toRational :: ChUInt32 -> Rational
Real, Enum ChUInt32
Real ChUInt32
(Real ChUInt32, Enum ChUInt32) =>
(ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> (ChUInt32, ChUInt32))
-> (ChUInt32 -> ChUInt32 -> (ChUInt32, ChUInt32))
-> (ChUInt32 -> Integer)
-> Integral ChUInt32
ChUInt32 -> Integer
ChUInt32 -> ChUInt32 -> (ChUInt32, ChUInt32)
ChUInt32 -> ChUInt32 -> ChUInt32
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChUInt32 -> ChUInt32 -> ChUInt32
quot :: ChUInt32 -> ChUInt32 -> ChUInt32
$crem :: ChUInt32 -> ChUInt32 -> ChUInt32
rem :: ChUInt32 -> ChUInt32 -> ChUInt32
$cdiv :: ChUInt32 -> ChUInt32 -> ChUInt32
div :: ChUInt32 -> ChUInt32 -> ChUInt32
$cmod :: ChUInt32 -> ChUInt32 -> ChUInt32
mod :: ChUInt32 -> ChUInt32 -> ChUInt32
$cquotRem :: ChUInt32 -> ChUInt32 -> (ChUInt32, ChUInt32)
quotRem :: ChUInt32 -> ChUInt32 -> (ChUInt32, ChUInt32)
$cdivMod :: ChUInt32 -> ChUInt32 -> (ChUInt32, ChUInt32)
divMod :: ChUInt32 -> ChUInt32 -> (ChUInt32, ChUInt32)
$ctoInteger :: ChUInt32 -> Integer
toInteger :: ChUInt32 -> Integer
Integral, ChUInt32
ChUInt32 -> ChUInt32 -> Bounded ChUInt32
forall a. a -> a -> Bounded a
$cminBound :: ChUInt32
minBound :: ChUInt32
$cmaxBound :: ChUInt32
maxBound :: ChUInt32
Bounded, ChUInt32 -> ()
(ChUInt32 -> ()) -> NFData ChUInt32
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt32 -> ()
rnf :: ChUInt32 -> ()
NFData)

instance IsChType ChUInt32 where
  type ToChTypeName ChUInt32 = "UInt32"
  defaultValueOfTypeName :: ChUInt32
defaultValueOfTypeName = ChUInt32
0

instance ToQueryPart ChUInt32 where toQueryPart :: ChUInt32 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChUInt32 -> ByteString) -> ChUInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChUInt32 -> String) -> ChUInt32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt32 -> String
forall a. Show a => a -> String
show

instance ToChType ChUInt32 Word32   where toChType :: Word32 -> ChUInt32
toChType = Word32 -> ChUInt32
MkChUInt32

instance FromChType ChUInt32 Word32   where fromChType :: ChUInt32 -> Word32
fromChType (MkChUInt32 Word32
word32) = Word32
word32




-- | ClickHouse UInt64 column type
newtype ChUInt64 = MkChUInt64 Word64
  deriving newtype (Int -> ChUInt64 -> ShowS
[ChUInt64] -> ShowS
ChUInt64 -> String
(Int -> ChUInt64 -> ShowS)
-> (ChUInt64 -> String) -> ([ChUInt64] -> ShowS) -> Show ChUInt64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt64 -> ShowS
showsPrec :: Int -> ChUInt64 -> ShowS
$cshow :: ChUInt64 -> String
show :: ChUInt64 -> String
$cshowList :: [ChUInt64] -> ShowS
showList :: [ChUInt64] -> ShowS
Show, ChUInt64 -> ChUInt64 -> Bool
(ChUInt64 -> ChUInt64 -> Bool)
-> (ChUInt64 -> ChUInt64 -> Bool) -> Eq ChUInt64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt64 -> ChUInt64 -> Bool
== :: ChUInt64 -> ChUInt64 -> Bool
$c/= :: ChUInt64 -> ChUInt64 -> Bool
/= :: ChUInt64 -> ChUInt64 -> Bool
Eq, Integer -> ChUInt64
ChUInt64 -> ChUInt64
ChUInt64 -> ChUInt64 -> ChUInt64
(ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (Integer -> ChUInt64)
-> Num ChUInt64
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt64 -> ChUInt64 -> ChUInt64
+ :: ChUInt64 -> ChUInt64 -> ChUInt64
$c- :: ChUInt64 -> ChUInt64 -> ChUInt64
- :: ChUInt64 -> ChUInt64 -> ChUInt64
$c* :: ChUInt64 -> ChUInt64 -> ChUInt64
* :: ChUInt64 -> ChUInt64 -> ChUInt64
$cnegate :: ChUInt64 -> ChUInt64
negate :: ChUInt64 -> ChUInt64
$cabs :: ChUInt64 -> ChUInt64
abs :: ChUInt64 -> ChUInt64
$csignum :: ChUInt64 -> ChUInt64
signum :: ChUInt64 -> ChUInt64
$cfromInteger :: Integer -> ChUInt64
fromInteger :: Integer -> ChUInt64
Num, Addr# -> Int# -> ChUInt64
ByteArray# -> Int# -> ChUInt64
ChUInt64 -> Int#
(ChUInt64 -> Int#)
-> (ChUInt64 -> Int#)
-> (ByteArray# -> Int# -> ChUInt64)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChUInt64 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt64 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt64 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt64)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChUInt64 #))
-> (forall s. Addr# -> Int# -> ChUInt64 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt64 -> State# s -> State# s)
-> Prim ChUInt64
forall s. Addr# -> Int# -> Int# -> ChUInt64 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt64 #)
forall s. Addr# -> Int# -> ChUInt64 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt64 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt64 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt64 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt64 -> Int#
sizeOf# :: ChUInt64 -> Int#
$calignment# :: ChUInt64 -> Int#
alignment# :: ChUInt64 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt64
indexByteArray# :: ByteArray# -> Int# -> ChUInt64
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt64 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt64 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt64 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt64 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt64 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt64 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt64
indexOffAddr# :: Addr# -> Int# -> ChUInt64
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt64 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt64 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt64 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt64 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt64 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt64 -> State# s -> State# s
Prim, Eq ChUInt64
ChUInt64
Eq ChUInt64 =>
(ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> ChUInt64
-> (Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> Bool)
-> (ChUInt64 -> Maybe Int)
-> (ChUInt64 -> Int)
-> (ChUInt64 -> Bool)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int -> ChUInt64)
-> (ChUInt64 -> Int)
-> Bits ChUInt64
Int -> ChUInt64
ChUInt64 -> Bool
ChUInt64 -> Int
ChUInt64 -> Maybe Int
ChUInt64 -> ChUInt64
ChUInt64 -> Int -> Bool
ChUInt64 -> Int -> ChUInt64
ChUInt64 -> ChUInt64 -> ChUInt64
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChUInt64 -> ChUInt64 -> ChUInt64
.&. :: ChUInt64 -> ChUInt64 -> ChUInt64
$c.|. :: ChUInt64 -> ChUInt64 -> ChUInt64
.|. :: ChUInt64 -> ChUInt64 -> ChUInt64
$cxor :: ChUInt64 -> ChUInt64 -> ChUInt64
xor :: ChUInt64 -> ChUInt64 -> ChUInt64
$ccomplement :: ChUInt64 -> ChUInt64
complement :: ChUInt64 -> ChUInt64
$cshift :: ChUInt64 -> Int -> ChUInt64
shift :: ChUInt64 -> Int -> ChUInt64
$crotate :: ChUInt64 -> Int -> ChUInt64
rotate :: ChUInt64 -> Int -> ChUInt64
$czeroBits :: ChUInt64
zeroBits :: ChUInt64
$cbit :: Int -> ChUInt64
bit :: Int -> ChUInt64
$csetBit :: ChUInt64 -> Int -> ChUInt64
setBit :: ChUInt64 -> Int -> ChUInt64
$cclearBit :: ChUInt64 -> Int -> ChUInt64
clearBit :: ChUInt64 -> Int -> ChUInt64
$ccomplementBit :: ChUInt64 -> Int -> ChUInt64
complementBit :: ChUInt64 -> Int -> ChUInt64
$ctestBit :: ChUInt64 -> Int -> Bool
testBit :: ChUInt64 -> Int -> Bool
$cbitSizeMaybe :: ChUInt64 -> Maybe Int
bitSizeMaybe :: ChUInt64 -> Maybe Int
$cbitSize :: ChUInt64 -> Int
bitSize :: ChUInt64 -> Int
$cisSigned :: ChUInt64 -> Bool
isSigned :: ChUInt64 -> Bool
$cshiftL :: ChUInt64 -> Int -> ChUInt64
shiftL :: ChUInt64 -> Int -> ChUInt64
$cunsafeShiftL :: ChUInt64 -> Int -> ChUInt64
unsafeShiftL :: ChUInt64 -> Int -> ChUInt64
$cshiftR :: ChUInt64 -> Int -> ChUInt64
shiftR :: ChUInt64 -> Int -> ChUInt64
$cunsafeShiftR :: ChUInt64 -> Int -> ChUInt64
unsafeShiftR :: ChUInt64 -> Int -> ChUInt64
$crotateL :: ChUInt64 -> Int -> ChUInt64
rotateL :: ChUInt64 -> Int -> ChUInt64
$crotateR :: ChUInt64 -> Int -> ChUInt64
rotateR :: ChUInt64 -> Int -> ChUInt64
$cpopCount :: ChUInt64 -> Int
popCount :: ChUInt64 -> Int
Bits, Int -> ChUInt64
ChUInt64 -> Int
ChUInt64 -> [ChUInt64]
ChUInt64 -> ChUInt64
ChUInt64 -> ChUInt64 -> [ChUInt64]
ChUInt64 -> ChUInt64 -> ChUInt64 -> [ChUInt64]
(ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (Int -> ChUInt64)
-> (ChUInt64 -> Int)
-> (ChUInt64 -> [ChUInt64])
-> (ChUInt64 -> ChUInt64 -> [ChUInt64])
-> (ChUInt64 -> ChUInt64 -> [ChUInt64])
-> (ChUInt64 -> ChUInt64 -> ChUInt64 -> [ChUInt64])
-> Enum ChUInt64
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUInt64 -> ChUInt64
succ :: ChUInt64 -> ChUInt64
$cpred :: ChUInt64 -> ChUInt64
pred :: ChUInt64 -> ChUInt64
$ctoEnum :: Int -> ChUInt64
toEnum :: Int -> ChUInt64
$cfromEnum :: ChUInt64 -> Int
fromEnum :: ChUInt64 -> Int
$cenumFrom :: ChUInt64 -> [ChUInt64]
enumFrom :: ChUInt64 -> [ChUInt64]
$cenumFromThen :: ChUInt64 -> ChUInt64 -> [ChUInt64]
enumFromThen :: ChUInt64 -> ChUInt64 -> [ChUInt64]
$cenumFromTo :: ChUInt64 -> ChUInt64 -> [ChUInt64]
enumFromTo :: ChUInt64 -> ChUInt64 -> [ChUInt64]
$cenumFromThenTo :: ChUInt64 -> ChUInt64 -> ChUInt64 -> [ChUInt64]
enumFromThenTo :: ChUInt64 -> ChUInt64 -> ChUInt64 -> [ChUInt64]
Enum, Eq ChUInt64
Eq ChUInt64 =>
(ChUInt64 -> ChUInt64 -> Ordering)
-> (ChUInt64 -> ChUInt64 -> Bool)
-> (ChUInt64 -> ChUInt64 -> Bool)
-> (ChUInt64 -> ChUInt64 -> Bool)
-> (ChUInt64 -> ChUInt64 -> Bool)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> Ord ChUInt64
ChUInt64 -> ChUInt64 -> Bool
ChUInt64 -> ChUInt64 -> Ordering
ChUInt64 -> ChUInt64 -> ChUInt64
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChUInt64 -> ChUInt64 -> Ordering
compare :: ChUInt64 -> ChUInt64 -> Ordering
$c< :: ChUInt64 -> ChUInt64 -> Bool
< :: ChUInt64 -> ChUInt64 -> Bool
$c<= :: ChUInt64 -> ChUInt64 -> Bool
<= :: ChUInt64 -> ChUInt64 -> Bool
$c> :: ChUInt64 -> ChUInt64 -> Bool
> :: ChUInt64 -> ChUInt64 -> Bool
$c>= :: ChUInt64 -> ChUInt64 -> Bool
>= :: ChUInt64 -> ChUInt64 -> Bool
$cmax :: ChUInt64 -> ChUInt64 -> ChUInt64
max :: ChUInt64 -> ChUInt64 -> ChUInt64
$cmin :: ChUInt64 -> ChUInt64 -> ChUInt64
min :: ChUInt64 -> ChUInt64 -> ChUInt64
Ord, Num ChUInt64
Ord ChUInt64
(Num ChUInt64, Ord ChUInt64) =>
(ChUInt64 -> Rational) -> Real ChUInt64
ChUInt64 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChUInt64 -> Rational
toRational :: ChUInt64 -> Rational
Real, Enum ChUInt64
Real ChUInt64
(Real ChUInt64, Enum ChUInt64) =>
(ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> (ChUInt64, ChUInt64))
-> (ChUInt64 -> ChUInt64 -> (ChUInt64, ChUInt64))
-> (ChUInt64 -> Integer)
-> Integral ChUInt64
ChUInt64 -> Integer
ChUInt64 -> ChUInt64 -> (ChUInt64, ChUInt64)
ChUInt64 -> ChUInt64 -> ChUInt64
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChUInt64 -> ChUInt64 -> ChUInt64
quot :: ChUInt64 -> ChUInt64 -> ChUInt64
$crem :: ChUInt64 -> ChUInt64 -> ChUInt64
rem :: ChUInt64 -> ChUInt64 -> ChUInt64
$cdiv :: ChUInt64 -> ChUInt64 -> ChUInt64
div :: ChUInt64 -> ChUInt64 -> ChUInt64
$cmod :: ChUInt64 -> ChUInt64 -> ChUInt64
mod :: ChUInt64 -> ChUInt64 -> ChUInt64
$cquotRem :: ChUInt64 -> ChUInt64 -> (ChUInt64, ChUInt64)
quotRem :: ChUInt64 -> ChUInt64 -> (ChUInt64, ChUInt64)
$cdivMod :: ChUInt64 -> ChUInt64 -> (ChUInt64, ChUInt64)
divMod :: ChUInt64 -> ChUInt64 -> (ChUInt64, ChUInt64)
$ctoInteger :: ChUInt64 -> Integer
toInteger :: ChUInt64 -> Integer
Integral, ChUInt64
ChUInt64 -> ChUInt64 -> Bounded ChUInt64
forall a. a -> a -> Bounded a
$cminBound :: ChUInt64
minBound :: ChUInt64
$cmaxBound :: ChUInt64
maxBound :: ChUInt64
Bounded, ChUInt64 -> ()
(ChUInt64 -> ()) -> NFData ChUInt64
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt64 -> ()
rnf :: ChUInt64 -> ()
NFData)

instance IsChType ChUInt64 where
  type ToChTypeName ChUInt64 = "UInt64"
  defaultValueOfTypeName :: ChUInt64
defaultValueOfTypeName = ChUInt64
0

instance ToQueryPart ChUInt64 where toQueryPart :: ChUInt64 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChUInt64 -> ByteString) -> ChUInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChUInt64 -> String) -> ChUInt64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt64 -> String
forall a. Show a => a -> String
show

instance ToChType ChUInt64 Word64   where toChType :: Word64 -> ChUInt64
toChType = Word64 -> ChUInt64
MkChUInt64

instance FromChType ChUInt64 Word64   where fromChType :: ChUInt64 -> Word64
fromChType (MkChUInt64 Word64
w64) = Word64
w64




-- | ClickHouse UInt128 column type
newtype ChUInt128 = MkChUInt128 Word128
  deriving newtype (Int -> ChUInt128 -> ShowS
[ChUInt128] -> ShowS
ChUInt128 -> String
(Int -> ChUInt128 -> ShowS)
-> (ChUInt128 -> String)
-> ([ChUInt128] -> ShowS)
-> Show ChUInt128
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt128 -> ShowS
showsPrec :: Int -> ChUInt128 -> ShowS
$cshow :: ChUInt128 -> String
show :: ChUInt128 -> String
$cshowList :: [ChUInt128] -> ShowS
showList :: [ChUInt128] -> ShowS
Show, ChUInt128 -> ChUInt128 -> Bool
(ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> Bool) -> Eq ChUInt128
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt128 -> ChUInt128 -> Bool
== :: ChUInt128 -> ChUInt128 -> Bool
$c/= :: ChUInt128 -> ChUInt128 -> Bool
/= :: ChUInt128 -> ChUInt128 -> Bool
Eq, Integer -> ChUInt128
ChUInt128 -> ChUInt128
ChUInt128 -> ChUInt128 -> ChUInt128
(ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (Integer -> ChUInt128)
-> Num ChUInt128
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt128 -> ChUInt128 -> ChUInt128
+ :: ChUInt128 -> ChUInt128 -> ChUInt128
$c- :: ChUInt128 -> ChUInt128 -> ChUInt128
- :: ChUInt128 -> ChUInt128 -> ChUInt128
$c* :: ChUInt128 -> ChUInt128 -> ChUInt128
* :: ChUInt128 -> ChUInt128 -> ChUInt128
$cnegate :: ChUInt128 -> ChUInt128
negate :: ChUInt128 -> ChUInt128
$cabs :: ChUInt128 -> ChUInt128
abs :: ChUInt128 -> ChUInt128
$csignum :: ChUInt128 -> ChUInt128
signum :: ChUInt128 -> ChUInt128
$cfromInteger :: Integer -> ChUInt128
fromInteger :: Integer -> ChUInt128
Num, Addr# -> Int# -> ChUInt128
ByteArray# -> Int# -> ChUInt128
ChUInt128 -> Int#
(ChUInt128 -> Int#)
-> (ChUInt128 -> Int#)
-> (ByteArray# -> Int# -> ChUInt128)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChUInt128 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt128 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt128 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt128)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChUInt128 #))
-> (forall s. Addr# -> Int# -> ChUInt128 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt128 -> State# s -> State# s)
-> Prim ChUInt128
forall s.
Addr# -> Int# -> Int# -> ChUInt128 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt128 #)
forall s. Addr# -> Int# -> ChUInt128 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt128 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChUInt128 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt128 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt128 -> Int#
sizeOf# :: ChUInt128 -> Int#
$calignment# :: ChUInt128 -> Int#
alignment# :: ChUInt128 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt128
indexByteArray# :: ByteArray# -> Int# -> ChUInt128
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChUInt128 #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChUInt128 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt128 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt128 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt128 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt128 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt128
indexOffAddr# :: Addr# -> Int# -> ChUInt128
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt128 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt128 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt128 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt128 -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> ChUInt128 -> State# s -> State# s
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> ChUInt128 -> State# s -> State# s
Prim, Eq ChUInt128
ChUInt128
Eq ChUInt128 =>
(ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> ChUInt128
-> (Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> Bool)
-> (ChUInt128 -> Maybe Int)
-> (ChUInt128 -> Int)
-> (ChUInt128 -> Bool)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int -> ChUInt128)
-> (ChUInt128 -> Int)
-> Bits ChUInt128
Int -> ChUInt128
ChUInt128 -> Bool
ChUInt128 -> Int
ChUInt128 -> Maybe Int
ChUInt128 -> ChUInt128
ChUInt128 -> Int -> Bool
ChUInt128 -> Int -> ChUInt128
ChUInt128 -> ChUInt128 -> ChUInt128
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChUInt128 -> ChUInt128 -> ChUInt128
.&. :: ChUInt128 -> ChUInt128 -> ChUInt128
$c.|. :: ChUInt128 -> ChUInt128 -> ChUInt128
.|. :: ChUInt128 -> ChUInt128 -> ChUInt128
$cxor :: ChUInt128 -> ChUInt128 -> ChUInt128
xor :: ChUInt128 -> ChUInt128 -> ChUInt128
$ccomplement :: ChUInt128 -> ChUInt128
complement :: ChUInt128 -> ChUInt128
$cshift :: ChUInt128 -> Int -> ChUInt128
shift :: ChUInt128 -> Int -> ChUInt128
$crotate :: ChUInt128 -> Int -> ChUInt128
rotate :: ChUInt128 -> Int -> ChUInt128
$czeroBits :: ChUInt128
zeroBits :: ChUInt128
$cbit :: Int -> ChUInt128
bit :: Int -> ChUInt128
$csetBit :: ChUInt128 -> Int -> ChUInt128
setBit :: ChUInt128 -> Int -> ChUInt128
$cclearBit :: ChUInt128 -> Int -> ChUInt128
clearBit :: ChUInt128 -> Int -> ChUInt128
$ccomplementBit :: ChUInt128 -> Int -> ChUInt128
complementBit :: ChUInt128 -> Int -> ChUInt128
$ctestBit :: ChUInt128 -> Int -> Bool
testBit :: ChUInt128 -> Int -> Bool
$cbitSizeMaybe :: ChUInt128 -> Maybe Int
bitSizeMaybe :: ChUInt128 -> Maybe Int
$cbitSize :: ChUInt128 -> Int
bitSize :: ChUInt128 -> Int
$cisSigned :: ChUInt128 -> Bool
isSigned :: ChUInt128 -> Bool
$cshiftL :: ChUInt128 -> Int -> ChUInt128
shiftL :: ChUInt128 -> Int -> ChUInt128
$cunsafeShiftL :: ChUInt128 -> Int -> ChUInt128
unsafeShiftL :: ChUInt128 -> Int -> ChUInt128
$cshiftR :: ChUInt128 -> Int -> ChUInt128
shiftR :: ChUInt128 -> Int -> ChUInt128
$cunsafeShiftR :: ChUInt128 -> Int -> ChUInt128
unsafeShiftR :: ChUInt128 -> Int -> ChUInt128
$crotateL :: ChUInt128 -> Int -> ChUInt128
rotateL :: ChUInt128 -> Int -> ChUInt128
$crotateR :: ChUInt128 -> Int -> ChUInt128
rotateR :: ChUInt128 -> Int -> ChUInt128
$cpopCount :: ChUInt128 -> Int
popCount :: ChUInt128 -> Int
Bits, Int -> ChUInt128
ChUInt128 -> Int
ChUInt128 -> [ChUInt128]
ChUInt128 -> ChUInt128
ChUInt128 -> ChUInt128 -> [ChUInt128]
ChUInt128 -> ChUInt128 -> ChUInt128 -> [ChUInt128]
(ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (Int -> ChUInt128)
-> (ChUInt128 -> Int)
-> (ChUInt128 -> [ChUInt128])
-> (ChUInt128 -> ChUInt128 -> [ChUInt128])
-> (ChUInt128 -> ChUInt128 -> [ChUInt128])
-> (ChUInt128 -> ChUInt128 -> ChUInt128 -> [ChUInt128])
-> Enum ChUInt128
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUInt128 -> ChUInt128
succ :: ChUInt128 -> ChUInt128
$cpred :: ChUInt128 -> ChUInt128
pred :: ChUInt128 -> ChUInt128
$ctoEnum :: Int -> ChUInt128
toEnum :: Int -> ChUInt128
$cfromEnum :: ChUInt128 -> Int
fromEnum :: ChUInt128 -> Int
$cenumFrom :: ChUInt128 -> [ChUInt128]
enumFrom :: ChUInt128 -> [ChUInt128]
$cenumFromThen :: ChUInt128 -> ChUInt128 -> [ChUInt128]
enumFromThen :: ChUInt128 -> ChUInt128 -> [ChUInt128]
$cenumFromTo :: ChUInt128 -> ChUInt128 -> [ChUInt128]
enumFromTo :: ChUInt128 -> ChUInt128 -> [ChUInt128]
$cenumFromThenTo :: ChUInt128 -> ChUInt128 -> ChUInt128 -> [ChUInt128]
enumFromThenTo :: ChUInt128 -> ChUInt128 -> ChUInt128 -> [ChUInt128]
Enum, Eq ChUInt128
Eq ChUInt128 =>
(ChUInt128 -> ChUInt128 -> Ordering)
-> (ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> Ord ChUInt128
ChUInt128 -> ChUInt128 -> Bool
ChUInt128 -> ChUInt128 -> Ordering
ChUInt128 -> ChUInt128 -> ChUInt128
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChUInt128 -> ChUInt128 -> Ordering
compare :: ChUInt128 -> ChUInt128 -> Ordering
$c< :: ChUInt128 -> ChUInt128 -> Bool
< :: ChUInt128 -> ChUInt128 -> Bool
$c<= :: ChUInt128 -> ChUInt128 -> Bool
<= :: ChUInt128 -> ChUInt128 -> Bool
$c> :: ChUInt128 -> ChUInt128 -> Bool
> :: ChUInt128 -> ChUInt128 -> Bool
$c>= :: ChUInt128 -> ChUInt128 -> Bool
>= :: ChUInt128 -> ChUInt128 -> Bool
$cmax :: ChUInt128 -> ChUInt128 -> ChUInt128
max :: ChUInt128 -> ChUInt128 -> ChUInt128
$cmin :: ChUInt128 -> ChUInt128 -> ChUInt128
min :: ChUInt128 -> ChUInt128 -> ChUInt128
Ord, Num ChUInt128
Ord ChUInt128
(Num ChUInt128, Ord ChUInt128) =>
(ChUInt128 -> Rational) -> Real ChUInt128
ChUInt128 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChUInt128 -> Rational
toRational :: ChUInt128 -> Rational
Real, Enum ChUInt128
Real ChUInt128
(Real ChUInt128, Enum ChUInt128) =>
(ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128))
-> (ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128))
-> (ChUInt128 -> Integer)
-> Integral ChUInt128
ChUInt128 -> Integer
ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
ChUInt128 -> ChUInt128 -> ChUInt128
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChUInt128 -> ChUInt128 -> ChUInt128
quot :: ChUInt128 -> ChUInt128 -> ChUInt128
$crem :: ChUInt128 -> ChUInt128 -> ChUInt128
rem :: ChUInt128 -> ChUInt128 -> ChUInt128
$cdiv :: ChUInt128 -> ChUInt128 -> ChUInt128
div :: ChUInt128 -> ChUInt128 -> ChUInt128
$cmod :: ChUInt128 -> ChUInt128 -> ChUInt128
mod :: ChUInt128 -> ChUInt128 -> ChUInt128
$cquotRem :: ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
quotRem :: ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
$cdivMod :: ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
divMod :: ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
$ctoInteger :: ChUInt128 -> Integer
toInteger :: ChUInt128 -> Integer
Integral, ChUInt128
ChUInt128 -> ChUInt128 -> Bounded ChUInt128
forall a. a -> a -> Bounded a
$cminBound :: ChUInt128
minBound :: ChUInt128
$cmaxBound :: ChUInt128
maxBound :: ChUInt128
Bounded, ChUInt128 -> ()
(ChUInt128 -> ()) -> NFData ChUInt128
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt128 -> ()
rnf :: ChUInt128 -> ()
NFData)

instance IsChType ChUInt128 where
  type ToChTypeName ChUInt128 = "UInt128"
  defaultValueOfTypeName :: ChUInt128
defaultValueOfTypeName = ChUInt128
0

instance ToQueryPart ChUInt128 where toQueryPart :: ChUInt128 -> Builder
toQueryPart = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChUInt128 -> ByteString) -> ChUInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (ChUInt128 -> String) -> ChUInt128 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt128 -> String
forall a. Show a => a -> String
show

instance ToChType ChUInt128 Word128   where toChType :: Word128 -> ChUInt128
toChType = Word128 -> ChUInt128
MkChUInt128
instance ToChType ChUInt128 Word64    where toChType :: Word64 -> ChUInt128
toChType = Word128 -> ChUInt128
MkChUInt128 (Word128 -> ChUInt128)
-> (Word64 -> Word128) -> Word64 -> ChUInt128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word128
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance FromChType ChUInt128 Word128   where fromChType :: ChUInt128 -> Word128
fromChType (MkChUInt128 Word128
w128) = Word128
w128




-- | ClickHouse DateTime column type
newtype ChDateTime = MkChDateTime Word32
  deriving newtype (Int -> ChDateTime -> ShowS
[ChDateTime] -> ShowS
ChDateTime -> String
(Int -> ChDateTime -> ShowS)
-> (ChDateTime -> String)
-> ([ChDateTime] -> ShowS)
-> Show ChDateTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChDateTime -> ShowS
showsPrec :: Int -> ChDateTime -> ShowS
$cshow :: ChDateTime -> String
show :: ChDateTime -> String
$cshowList :: [ChDateTime] -> ShowS
showList :: [ChDateTime] -> ShowS
Show, ChDateTime -> ChDateTime -> Bool
(ChDateTime -> ChDateTime -> Bool)
-> (ChDateTime -> ChDateTime -> Bool) -> Eq ChDateTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChDateTime -> ChDateTime -> Bool
== :: ChDateTime -> ChDateTime -> Bool
$c/= :: ChDateTime -> ChDateTime -> Bool
/= :: ChDateTime -> ChDateTime -> Bool
Eq, Addr# -> Int# -> ChDateTime
ByteArray# -> Int# -> ChDateTime
ChDateTime -> Int#
(ChDateTime -> Int#)
-> (ChDateTime -> Int#)
-> (ByteArray# -> Int# -> ChDateTime)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChDateTime #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChDateTime -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChDateTime -> State# s -> State# s)
-> (Addr# -> Int# -> ChDateTime)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChDateTime #))
-> (forall s. Addr# -> Int# -> ChDateTime -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChDateTime -> State# s -> State# s)
-> Prim ChDateTime
forall s.
Addr# -> Int# -> Int# -> ChDateTime -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChDateTime #)
forall s. Addr# -> Int# -> ChDateTime -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChDateTime -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChDateTime #)
forall s.
MutableByteArray# s -> Int# -> ChDateTime -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChDateTime -> Int#
sizeOf# :: ChDateTime -> Int#
$calignment# :: ChDateTime -> Int#
alignment# :: ChDateTime -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChDateTime
indexByteArray# :: ByteArray# -> Int# -> ChDateTime
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChDateTime #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChDateTime #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChDateTime -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChDateTime -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChDateTime -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChDateTime -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChDateTime
indexOffAddr# :: Addr# -> Int# -> ChDateTime
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChDateTime #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChDateTime #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChDateTime -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChDateTime -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> ChDateTime -> State# s -> State# s
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> ChDateTime -> State# s -> State# s
Prim, Integer -> ChDateTime
ChDateTime -> ChDateTime
ChDateTime -> ChDateTime -> ChDateTime
(ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime)
-> (Integer -> ChDateTime)
-> Num ChDateTime
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChDateTime -> ChDateTime -> ChDateTime
+ :: ChDateTime -> ChDateTime -> ChDateTime
$c- :: ChDateTime -> ChDateTime -> ChDateTime
- :: ChDateTime -> ChDateTime -> ChDateTime
$c* :: ChDateTime -> ChDateTime -> ChDateTime
* :: ChDateTime -> ChDateTime -> ChDateTime
$cnegate :: ChDateTime -> ChDateTime
negate :: ChDateTime -> ChDateTime
$cabs :: ChDateTime -> ChDateTime
abs :: ChDateTime -> ChDateTime
$csignum :: ChDateTime -> ChDateTime
signum :: ChDateTime -> ChDateTime
$cfromInteger :: Integer -> ChDateTime
fromInteger :: Integer -> ChDateTime
Num, Eq ChDateTime
ChDateTime
Eq ChDateTime =>
(ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> ChDateTime
-> (Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> Bool)
-> (ChDateTime -> Maybe Int)
-> (ChDateTime -> Int)
-> (ChDateTime -> Bool)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int -> ChDateTime)
-> (ChDateTime -> Int)
-> Bits ChDateTime
Int -> ChDateTime
ChDateTime -> Bool
ChDateTime -> Int
ChDateTime -> Maybe Int
ChDateTime -> ChDateTime
ChDateTime -> Int -> Bool
ChDateTime -> Int -> ChDateTime
ChDateTime -> ChDateTime -> ChDateTime
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChDateTime -> ChDateTime -> ChDateTime
.&. :: ChDateTime -> ChDateTime -> ChDateTime
$c.|. :: ChDateTime -> ChDateTime -> ChDateTime
.|. :: ChDateTime -> ChDateTime -> ChDateTime
$cxor :: ChDateTime -> ChDateTime -> ChDateTime
xor :: ChDateTime -> ChDateTime -> ChDateTime
$ccomplement :: ChDateTime -> ChDateTime
complement :: ChDateTime -> ChDateTime
$cshift :: ChDateTime -> Int -> ChDateTime
shift :: ChDateTime -> Int -> ChDateTime
$crotate :: ChDateTime -> Int -> ChDateTime
rotate :: ChDateTime -> Int -> ChDateTime
$czeroBits :: ChDateTime
zeroBits :: ChDateTime
$cbit :: Int -> ChDateTime
bit :: Int -> ChDateTime
$csetBit :: ChDateTime -> Int -> ChDateTime
setBit :: ChDateTime -> Int -> ChDateTime
$cclearBit :: ChDateTime -> Int -> ChDateTime
clearBit :: ChDateTime -> Int -> ChDateTime
$ccomplementBit :: ChDateTime -> Int -> ChDateTime
complementBit :: ChDateTime -> Int -> ChDateTime
$ctestBit :: ChDateTime -> Int -> Bool
testBit :: ChDateTime -> Int -> Bool
$cbitSizeMaybe :: ChDateTime -> Maybe Int
bitSizeMaybe :: ChDateTime -> Maybe Int
$cbitSize :: ChDateTime -> Int
bitSize :: ChDateTime -> Int
$cisSigned :: ChDateTime -> Bool
isSigned :: ChDateTime -> Bool
$cshiftL :: ChDateTime -> Int -> ChDateTime
shiftL :: ChDateTime -> Int -> ChDateTime
$cunsafeShiftL :: ChDateTime -> Int -> ChDateTime
unsafeShiftL :: ChDateTime -> Int -> ChDateTime
$cshiftR :: ChDateTime -> Int -> ChDateTime
shiftR :: ChDateTime -> Int -> ChDateTime
$cunsafeShiftR :: ChDateTime -> Int -> ChDateTime
unsafeShiftR :: ChDateTime -> Int -> ChDateTime
$crotateL :: ChDateTime -> Int -> ChDateTime
rotateL :: ChDateTime -> Int -> ChDateTime
$crotateR :: ChDateTime -> Int -> ChDateTime
rotateR :: ChDateTime -> Int -> ChDateTime
$cpopCount :: ChDateTime -> Int
popCount :: ChDateTime -> Int
Bits, Int -> ChDateTime
ChDateTime -> Int
ChDateTime -> [ChDateTime]
ChDateTime -> ChDateTime
ChDateTime -> ChDateTime -> [ChDateTime]
ChDateTime -> ChDateTime -> ChDateTime -> [ChDateTime]
(ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime)
-> (Int -> ChDateTime)
-> (ChDateTime -> Int)
-> (ChDateTime -> [ChDateTime])
-> (ChDateTime -> ChDateTime -> [ChDateTime])
-> (ChDateTime -> ChDateTime -> [ChDateTime])
-> (ChDateTime -> ChDateTime -> ChDateTime -> [ChDateTime])
-> Enum ChDateTime
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChDateTime -> ChDateTime
succ :: ChDateTime -> ChDateTime
$cpred :: ChDateTime -> ChDateTime
pred :: ChDateTime -> ChDateTime
$ctoEnum :: Int -> ChDateTime
toEnum :: Int -> ChDateTime
$cfromEnum :: ChDateTime -> Int
fromEnum :: ChDateTime -> Int
$cenumFrom :: ChDateTime -> [ChDateTime]
enumFrom :: ChDateTime -> [ChDateTime]
$cenumFromThen :: ChDateTime -> ChDateTime -> [ChDateTime]
enumFromThen :: ChDateTime -> ChDateTime -> [ChDateTime]
$cenumFromTo :: ChDateTime -> ChDateTime -> [ChDateTime]
enumFromTo :: ChDateTime -> ChDateTime -> [ChDateTime]
$cenumFromThenTo :: ChDateTime -> ChDateTime -> ChDateTime -> [ChDateTime]
enumFromThenTo :: ChDateTime -> ChDateTime -> ChDateTime -> [ChDateTime]
Enum, Eq ChDateTime
Eq ChDateTime =>
(ChDateTime -> ChDateTime -> Ordering)
-> (ChDateTime -> ChDateTime -> Bool)
-> (ChDateTime -> ChDateTime -> Bool)
-> (ChDateTime -> ChDateTime -> Bool)
-> (ChDateTime -> ChDateTime -> Bool)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> Ord ChDateTime
ChDateTime -> ChDateTime -> Bool
ChDateTime -> ChDateTime -> Ordering
ChDateTime -> ChDateTime -> ChDateTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChDateTime -> ChDateTime -> Ordering
compare :: ChDateTime -> ChDateTime -> Ordering
$c< :: ChDateTime -> ChDateTime -> Bool
< :: ChDateTime -> ChDateTime -> Bool
$c<= :: ChDateTime -> ChDateTime -> Bool
<= :: ChDateTime -> ChDateTime -> Bool
$c> :: ChDateTime -> ChDateTime -> Bool
> :: ChDateTime -> ChDateTime -> Bool
$c>= :: ChDateTime -> ChDateTime -> Bool
>= :: ChDateTime -> ChDateTime -> Bool
$cmax :: ChDateTime -> ChDateTime -> ChDateTime
max :: ChDateTime -> ChDateTime -> ChDateTime
$cmin :: ChDateTime -> ChDateTime -> ChDateTime
min :: ChDateTime -> ChDateTime -> ChDateTime
Ord, Num ChDateTime
Ord ChDateTime
(Num ChDateTime, Ord ChDateTime) =>
(ChDateTime -> Rational) -> Real ChDateTime
ChDateTime -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChDateTime -> Rational
toRational :: ChDateTime -> Rational
Real, Enum ChDateTime
Real ChDateTime
(Real ChDateTime, Enum ChDateTime) =>
(ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> ChDateTime)
-> (ChDateTime -> ChDateTime -> (ChDateTime, ChDateTime))
-> (ChDateTime -> ChDateTime -> (ChDateTime, ChDateTime))
-> (ChDateTime -> Integer)
-> Integral ChDateTime
ChDateTime -> Integer
ChDateTime -> ChDateTime -> (ChDateTime, ChDateTime)
ChDateTime -> ChDateTime -> ChDateTime
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChDateTime -> ChDateTime -> ChDateTime
quot :: ChDateTime -> ChDateTime -> ChDateTime
$crem :: ChDateTime -> ChDateTime -> ChDateTime
rem :: ChDateTime -> ChDateTime -> ChDateTime
$cdiv :: ChDateTime -> ChDateTime -> ChDateTime
div :: ChDateTime -> ChDateTime -> ChDateTime
$cmod :: ChDateTime -> ChDateTime -> ChDateTime
mod :: ChDateTime -> ChDateTime -> ChDateTime
$cquotRem :: ChDateTime -> ChDateTime -> (ChDateTime, ChDateTime)
quotRem :: ChDateTime -> ChDateTime -> (ChDateTime, ChDateTime)
$cdivMod :: ChDateTime -> ChDateTime -> (ChDateTime, ChDateTime)
divMod :: ChDateTime -> ChDateTime -> (ChDateTime, ChDateTime)
$ctoInteger :: ChDateTime -> Integer
toInteger :: ChDateTime -> Integer
Integral, ChDateTime
ChDateTime -> ChDateTime -> Bounded ChDateTime
forall a. a -> a -> Bounded a
$cminBound :: ChDateTime
minBound :: ChDateTime
$cmaxBound :: ChDateTime
maxBound :: ChDateTime
Bounded, ChDateTime -> ()
(ChDateTime -> ()) -> NFData ChDateTime
forall a. (a -> ()) -> NFData a
$crnf :: ChDateTime -> ()
rnf :: ChDateTime -> ()
NFData)

instance IsChType ChDateTime
  where
  type ToChTypeName ChDateTime = "DateTime"
  defaultValueOfTypeName :: ChDateTime
defaultValueOfTypeName = Word32 -> ChDateTime
MkChDateTime Word32
0

instance ToQueryPart ChDateTime
  where
  toQueryPart :: ChDateTime -> Builder
toQueryPart ChDateTime
chDateTime = let time :: ByteString
time = String -> ByteString
BS8.pack (String -> ByteString)
-> (ChDateTime -> String) -> ChDateTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show (Word32 -> String)
-> (ChDateTime -> Word32) -> ChDateTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @ChDateTime @Word32 (ChDateTime -> ByteString) -> ChDateTime -> ByteString
forall a b. (a -> b) -> a -> b
$ ChDateTime
chDateTime
    in ByteString -> Builder
BS.byteString (Int -> Char -> ByteString
BS8.replicate (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS8.length ByteString
time) Char
'0' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
time)

instance ToChType ChDateTime Word32     where toChType :: Word32 -> ChDateTime
toChType = Word32 -> ChDateTime
MkChDateTime
instance ToChType ChDateTime UTCTime    where toChType :: UTCTime -> ChDateTime
toChType = Word32 -> ChDateTime
MkChDateTime (Word32 -> ChDateTime)
-> (UTCTime -> Word32) -> UTCTime -> ChDateTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Word32
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Word32)
-> (UTCTime -> POSIXTime) -> UTCTime -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
instance ToChType ChDateTime ZonedTime  where toChType :: ZonedTime -> ChDateTime
toChType = Word32 -> ChDateTime
MkChDateTime (Word32 -> ChDateTime)
-> (ZonedTime -> Word32) -> ZonedTime -> ChDateTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Word32
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Word32)
-> (ZonedTime -> POSIXTime) -> ZonedTime -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime)
-> (ZonedTime -> UTCTime) -> ZonedTime -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
zonedTimeToUTC

instance FromChType ChDateTime Word32     where fromChType :: ChDateTime -> Word32
fromChType = ChDateTime -> Word32
forall a b. Coercible a b => a -> b
coerce
instance FromChType ChDateTime UTCTime    where fromChType :: ChDateTime -> UTCTime
fromChType (MkChDateTime Word32
w32) = POSIXTime -> UTCTime
posixSecondsToUTCTime (Word32 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32)




newtype ChDate = MkChDate Word16
  deriving newtype (Int -> ChDate -> ShowS
[ChDate] -> ShowS
ChDate -> String
(Int -> ChDate -> ShowS)
-> (ChDate -> String) -> ([ChDate] -> ShowS) -> Show ChDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChDate -> ShowS
showsPrec :: Int -> ChDate -> ShowS
$cshow :: ChDate -> String
show :: ChDate -> String
$cshowList :: [ChDate] -> ShowS
showList :: [ChDate] -> ShowS
Show, ChDate -> ChDate -> Bool
(ChDate -> ChDate -> Bool)
-> (ChDate -> ChDate -> Bool) -> Eq ChDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChDate -> ChDate -> Bool
== :: ChDate -> ChDate -> Bool
$c/= :: ChDate -> ChDate -> Bool
/= :: ChDate -> ChDate -> Bool
Eq, Addr# -> Int# -> ChDate
ByteArray# -> Int# -> ChDate
ChDate -> Int#
(ChDate -> Int#)
-> (ChDate -> Int#)
-> (ByteArray# -> Int# -> ChDate)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChDate #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChDate -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChDate -> State# s -> State# s)
-> (Addr# -> Int# -> ChDate)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChDate #))
-> (forall s. Addr# -> Int# -> ChDate -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChDate -> State# s -> State# s)
-> Prim ChDate
forall s. Addr# -> Int# -> Int# -> ChDate -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChDate #)
forall s. Addr# -> Int# -> ChDate -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChDate -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChDate #)
forall s.
MutableByteArray# s -> Int# -> ChDate -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChDate -> Int#
sizeOf# :: ChDate -> Int#
$calignment# :: ChDate -> Int#
alignment# :: ChDate -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChDate
indexByteArray# :: ByteArray# -> Int# -> ChDate
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChDate #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChDate #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChDate -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChDate -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChDate -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChDate -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChDate
indexOffAddr# :: Addr# -> Int# -> ChDate
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChDate #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChDate #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChDate -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChDate -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChDate -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChDate -> State# s -> State# s
Prim, Eq ChDate
ChDate
Eq ChDate =>
(ChDate -> ChDate -> ChDate)
-> (ChDate -> ChDate -> ChDate)
-> (ChDate -> ChDate -> ChDate)
-> (ChDate -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> ChDate
-> (Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> Bool)
-> (ChDate -> Maybe Int)
-> (ChDate -> Int)
-> (ChDate -> Bool)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int -> ChDate)
-> (ChDate -> Int)
-> Bits ChDate
Int -> ChDate
ChDate -> Bool
ChDate -> Int
ChDate -> Maybe Int
ChDate -> ChDate
ChDate -> Int -> Bool
ChDate -> Int -> ChDate
ChDate -> ChDate -> ChDate
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: ChDate -> ChDate -> ChDate
.&. :: ChDate -> ChDate -> ChDate
$c.|. :: ChDate -> ChDate -> ChDate
.|. :: ChDate -> ChDate -> ChDate
$cxor :: ChDate -> ChDate -> ChDate
xor :: ChDate -> ChDate -> ChDate
$ccomplement :: ChDate -> ChDate
complement :: ChDate -> ChDate
$cshift :: ChDate -> Int -> ChDate
shift :: ChDate -> Int -> ChDate
$crotate :: ChDate -> Int -> ChDate
rotate :: ChDate -> Int -> ChDate
$czeroBits :: ChDate
zeroBits :: ChDate
$cbit :: Int -> ChDate
bit :: Int -> ChDate
$csetBit :: ChDate -> Int -> ChDate
setBit :: ChDate -> Int -> ChDate
$cclearBit :: ChDate -> Int -> ChDate
clearBit :: ChDate -> Int -> ChDate
$ccomplementBit :: ChDate -> Int -> ChDate
complementBit :: ChDate -> Int -> ChDate
$ctestBit :: ChDate -> Int -> Bool
testBit :: ChDate -> Int -> Bool
$cbitSizeMaybe :: ChDate -> Maybe Int
bitSizeMaybe :: ChDate -> Maybe Int
$cbitSize :: ChDate -> Int
bitSize :: ChDate -> Int
$cisSigned :: ChDate -> Bool
isSigned :: ChDate -> Bool
$cshiftL :: ChDate -> Int -> ChDate
shiftL :: ChDate -> Int -> ChDate
$cunsafeShiftL :: ChDate -> Int -> ChDate
unsafeShiftL :: ChDate -> Int -> ChDate
$cshiftR :: ChDate -> Int -> ChDate
shiftR :: ChDate -> Int -> ChDate
$cunsafeShiftR :: ChDate -> Int -> ChDate
unsafeShiftR :: ChDate -> Int -> ChDate
$crotateL :: ChDate -> Int -> ChDate
rotateL :: ChDate -> Int -> ChDate
$crotateR :: ChDate -> Int -> ChDate
rotateR :: ChDate -> Int -> ChDate
$cpopCount :: ChDate -> Int
popCount :: ChDate -> Int
Bits, ChDate
ChDate -> ChDate -> Bounded ChDate
forall a. a -> a -> Bounded a
$cminBound :: ChDate
minBound :: ChDate
$cmaxBound :: ChDate
maxBound :: ChDate
Bounded, Int -> ChDate
ChDate -> Int
ChDate -> [ChDate]
ChDate -> ChDate
ChDate -> ChDate -> [ChDate]
ChDate -> ChDate -> ChDate -> [ChDate]
(ChDate -> ChDate)
-> (ChDate -> ChDate)
-> (Int -> ChDate)
-> (ChDate -> Int)
-> (ChDate -> [ChDate])
-> (ChDate -> ChDate -> [ChDate])
-> (ChDate -> ChDate -> [ChDate])
-> (ChDate -> ChDate -> ChDate -> [ChDate])
-> Enum ChDate
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChDate -> ChDate
succ :: ChDate -> ChDate
$cpred :: ChDate -> ChDate
pred :: ChDate -> ChDate
$ctoEnum :: Int -> ChDate
toEnum :: Int -> ChDate
$cfromEnum :: ChDate -> Int
fromEnum :: ChDate -> Int
$cenumFrom :: ChDate -> [ChDate]
enumFrom :: ChDate -> [ChDate]
$cenumFromThen :: ChDate -> ChDate -> [ChDate]
enumFromThen :: ChDate -> ChDate -> [ChDate]
$cenumFromTo :: ChDate -> ChDate -> [ChDate]
enumFromTo :: ChDate -> ChDate -> [ChDate]
$cenumFromThenTo :: ChDate -> ChDate -> ChDate -> [ChDate]
enumFromThenTo :: ChDate -> ChDate -> ChDate -> [ChDate]
Enum, ChDate -> ()
(ChDate -> ()) -> NFData ChDate
forall a. (a -> ()) -> NFData a
$crnf :: ChDate -> ()
rnf :: ChDate -> ()
NFData)

instance IsChType ChDate where
  type ToChTypeName ChDate = "Date"
  defaultValueOfTypeName :: ChDate
defaultValueOfTypeName = Word16 -> ChDate
MkChDate Word16
0

instance ToChType ChDate Word16 where toChType :: Word16 -> ChDate
toChType = Word16 -> ChDate
MkChDate

instance FromChType ChDate Word16 where fromChType :: ChDate -> Word16
fromChType = ChDate -> Word16
forall a b. Coercible a b => a -> b
coerce




newtype ChArray a = MkChArray [a]
  deriving newtype (Int -> ChArray a -> ShowS
[ChArray a] -> ShowS
ChArray a -> String
(Int -> ChArray a -> ShowS)
-> (ChArray a -> String)
-> ([ChArray a] -> ShowS)
-> Show (ChArray a)
forall a. Show a => Int -> ChArray a -> ShowS
forall a. Show a => [ChArray a] -> ShowS
forall a. Show a => ChArray a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ChArray a -> ShowS
showsPrec :: Int -> ChArray a -> ShowS
$cshow :: forall a. Show a => ChArray a -> String
show :: ChArray a -> String
$cshowList :: forall a. Show a => [ChArray a] -> ShowS
showList :: [ChArray a] -> ShowS
Show, ChArray a -> ChArray a -> Bool
(ChArray a -> ChArray a -> Bool)
-> (ChArray a -> ChArray a -> Bool) -> Eq (ChArray a)
forall a. Eq a => ChArray a -> ChArray a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ChArray a -> ChArray a -> Bool
== :: ChArray a -> ChArray a -> Bool
$c/= :: forall a. Eq a => ChArray a -> ChArray a -> Bool
/= :: ChArray a -> ChArray a -> Bool
Eq, ChArray a -> ()
(ChArray a -> ()) -> NFData (ChArray a)
forall a. NFData a => ChArray a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => ChArray a -> ()
rnf :: ChArray a -> ()
NFData)

instance
  ( IsChType chType
  , KnownSymbol (AppendSymbol (AppendSymbol "Array(" (ToChTypeName chType)) ")")
  ) =>
  IsChType (ChArray chType)
  where
  type ToChTypeName (ChArray chType) = "Array(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")"
  defaultValueOfTypeName :: ChArray chType
defaultValueOfTypeName = [chType] -> ChArray chType
forall a. [a] -> ChArray a
MkChArray []




instance
  ( ToQueryPart chType
  , IsChType (ChArray chType)
  ) =>
  ToQueryPart (ChArray chType)
  where
  toQueryPart :: ChArray chType -> Builder
toQueryPart
    = (\Builder
x -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]")
    (Builder -> Builder)
-> (ChArray chType -> Builder) -> ChArray chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
-> ((Builder, [Builder]) -> Builder)
-> Maybe (Builder, [Builder])
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" ((Builder -> [Builder] -> Builder)
-> (Builder, [Builder]) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Builder
a Builder
b -> Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)))
    (Maybe (Builder, [Builder]) -> Builder)
-> ([chType] -> Maybe (Builder, [Builder])) -> [chType] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Maybe (Builder, [Builder])
forall a. [a] -> Maybe (a, [a])
uncons
    ([Builder] -> Maybe (Builder, [Builder]))
-> ([chType] -> [Builder])
-> [chType]
-> Maybe (Builder, [Builder])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (chType -> Builder) -> [chType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (forall chType. ToQueryPart chType => chType -> Builder
toQueryPart @chType))
    ([chType] -> Builder)
-> (ChArray chType -> [chType]) -> ChArray chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChArray chType -> [chType]
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance
  ( IsChType chType
  , IsChType (ChArray chType)
  ) =>
  FromChType (ChArray chType) [chType] where fromChType :: ChArray chType -> [chType]
fromChType (MkChArray [chType]
values) = [chType]
values

instance
  ( ToChType chType inputType
  , IsChType (ChArray chType)
  ) =>
  ToChType (ChArray chType) [inputType] where toChType :: [inputType] -> ChArray chType
toChType = [chType] -> ChArray chType
forall a. [a] -> ChArray a
MkChArray ([chType] -> ChArray chType)
-> ([inputType] -> [chType]) -> [inputType] -> ChArray chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (inputType -> chType) -> [inputType] -> [chType]
forall a b. (a -> b) -> [a] -> [b]
map inputType -> chType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType




{- |
  Unsigned variable-length quantity encoding
  
  Part of protocol implementation
-}
newtype UVarInt = MkUVarInt Word64
  deriving newtype (Int -> UVarInt -> ShowS
[UVarInt] -> ShowS
UVarInt -> String
(Int -> UVarInt -> ShowS)
-> (UVarInt -> String) -> ([UVarInt] -> ShowS) -> Show UVarInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UVarInt -> ShowS
showsPrec :: Int -> UVarInt -> ShowS
$cshow :: UVarInt -> String
show :: UVarInt -> String
$cshowList :: [UVarInt] -> ShowS
showList :: [UVarInt] -> ShowS
Show, UVarInt -> UVarInt -> Bool
(UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> Bool) -> Eq UVarInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UVarInt -> UVarInt -> Bool
== :: UVarInt -> UVarInt -> Bool
$c/= :: UVarInt -> UVarInt -> Bool
/= :: UVarInt -> UVarInt -> Bool
Eq, Integer -> UVarInt
UVarInt -> UVarInt
UVarInt -> UVarInt -> UVarInt
(UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (Integer -> UVarInt)
-> Num UVarInt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: UVarInt -> UVarInt -> UVarInt
+ :: UVarInt -> UVarInt -> UVarInt
$c- :: UVarInt -> UVarInt -> UVarInt
- :: UVarInt -> UVarInt -> UVarInt
$c* :: UVarInt -> UVarInt -> UVarInt
* :: UVarInt -> UVarInt -> UVarInt
$cnegate :: UVarInt -> UVarInt
negate :: UVarInt -> UVarInt
$cabs :: UVarInt -> UVarInt
abs :: UVarInt -> UVarInt
$csignum :: UVarInt -> UVarInt
signum :: UVarInt -> UVarInt
$cfromInteger :: Integer -> UVarInt
fromInteger :: Integer -> UVarInt
Num, Addr# -> Int# -> UVarInt
ByteArray# -> Int# -> UVarInt
UVarInt -> Int#
(UVarInt -> Int#)
-> (UVarInt -> Int#)
-> (ByteArray# -> Int# -> UVarInt)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, UVarInt #))
-> (forall s.
    MutableByteArray# s -> Int# -> UVarInt -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> UVarInt -> State# s -> State# s)
-> (Addr# -> Int# -> UVarInt)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, UVarInt #))
-> (forall s. Addr# -> Int# -> UVarInt -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> UVarInt -> State# s -> State# s)
-> Prim UVarInt
forall s. Addr# -> Int# -> Int# -> UVarInt -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, UVarInt #)
forall s. Addr# -> Int# -> UVarInt -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> UVarInt -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, UVarInt #)
forall s.
MutableByteArray# s -> Int# -> UVarInt -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: UVarInt -> Int#
sizeOf# :: UVarInt -> Int#
$calignment# :: UVarInt -> Int#
alignment# :: UVarInt -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> UVarInt
indexByteArray# :: ByteArray# -> Int# -> UVarInt
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, UVarInt #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, UVarInt #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> UVarInt -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> UVarInt -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> UVarInt -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> UVarInt -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> UVarInt
indexOffAddr# :: Addr# -> Int# -> UVarInt
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, UVarInt #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, UVarInt #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> UVarInt -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> UVarInt -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> UVarInt -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> UVarInt -> State# s -> State# s
Prim, Eq UVarInt
UVarInt
Eq UVarInt =>
(UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> UVarInt
-> (Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> Bool)
-> (UVarInt -> Maybe Int)
-> (UVarInt -> Int)
-> (UVarInt -> Bool)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int)
-> Bits UVarInt
Int -> UVarInt
UVarInt -> Bool
UVarInt -> Int
UVarInt -> Maybe Int
UVarInt -> UVarInt
UVarInt -> Int -> Bool
UVarInt -> Int -> UVarInt
UVarInt -> UVarInt -> UVarInt
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: UVarInt -> UVarInt -> UVarInt
.&. :: UVarInt -> UVarInt -> UVarInt
$c.|. :: UVarInt -> UVarInt -> UVarInt
.|. :: UVarInt -> UVarInt -> UVarInt
$cxor :: UVarInt -> UVarInt -> UVarInt
xor :: UVarInt -> UVarInt -> UVarInt
$ccomplement :: UVarInt -> UVarInt
complement :: UVarInt -> UVarInt
$cshift :: UVarInt -> Int -> UVarInt
shift :: UVarInt -> Int -> UVarInt
$crotate :: UVarInt -> Int -> UVarInt
rotate :: UVarInt -> Int -> UVarInt
$czeroBits :: UVarInt
zeroBits :: UVarInt
$cbit :: Int -> UVarInt
bit :: Int -> UVarInt
$csetBit :: UVarInt -> Int -> UVarInt
setBit :: UVarInt -> Int -> UVarInt
$cclearBit :: UVarInt -> Int -> UVarInt
clearBit :: UVarInt -> Int -> UVarInt
$ccomplementBit :: UVarInt -> Int -> UVarInt
complementBit :: UVarInt -> Int -> UVarInt
$ctestBit :: UVarInt -> Int -> Bool
testBit :: UVarInt -> Int -> Bool
$cbitSizeMaybe :: UVarInt -> Maybe Int
bitSizeMaybe :: UVarInt -> Maybe Int
$cbitSize :: UVarInt -> Int
bitSize :: UVarInt -> Int
$cisSigned :: UVarInt -> Bool
isSigned :: UVarInt -> Bool
$cshiftL :: UVarInt -> Int -> UVarInt
shiftL :: UVarInt -> Int -> UVarInt
$cunsafeShiftL :: UVarInt -> Int -> UVarInt
unsafeShiftL :: UVarInt -> Int -> UVarInt
$cshiftR :: UVarInt -> Int -> UVarInt
shiftR :: UVarInt -> Int -> UVarInt
$cunsafeShiftR :: UVarInt -> Int -> UVarInt
unsafeShiftR :: UVarInt -> Int -> UVarInt
$crotateL :: UVarInt -> Int -> UVarInt
rotateL :: UVarInt -> Int -> UVarInt
$crotateR :: UVarInt -> Int -> UVarInt
rotateR :: UVarInt -> Int -> UVarInt
$cpopCount :: UVarInt -> Int
popCount :: UVarInt -> Int
Bits, Int -> UVarInt
UVarInt -> Int
UVarInt -> [UVarInt]
UVarInt -> UVarInt
UVarInt -> UVarInt -> [UVarInt]
UVarInt -> UVarInt -> UVarInt -> [UVarInt]
(UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (Int -> UVarInt)
-> (UVarInt -> Int)
-> (UVarInt -> [UVarInt])
-> (UVarInt -> UVarInt -> [UVarInt])
-> (UVarInt -> UVarInt -> [UVarInt])
-> (UVarInt -> UVarInt -> UVarInt -> [UVarInt])
-> Enum UVarInt
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UVarInt -> UVarInt
succ :: UVarInt -> UVarInt
$cpred :: UVarInt -> UVarInt
pred :: UVarInt -> UVarInt
$ctoEnum :: Int -> UVarInt
toEnum :: Int -> UVarInt
$cfromEnum :: UVarInt -> Int
fromEnum :: UVarInt -> Int
$cenumFrom :: UVarInt -> [UVarInt]
enumFrom :: UVarInt -> [UVarInt]
$cenumFromThen :: UVarInt -> UVarInt -> [UVarInt]
enumFromThen :: UVarInt -> UVarInt -> [UVarInt]
$cenumFromTo :: UVarInt -> UVarInt -> [UVarInt]
enumFromTo :: UVarInt -> UVarInt -> [UVarInt]
$cenumFromThenTo :: UVarInt -> UVarInt -> UVarInt -> [UVarInt]
enumFromThenTo :: UVarInt -> UVarInt -> UVarInt -> [UVarInt]
Enum, Eq UVarInt
Eq UVarInt =>
(UVarInt -> UVarInt -> Ordering)
-> (UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> Ord UVarInt
UVarInt -> UVarInt -> Bool
UVarInt -> UVarInt -> Ordering
UVarInt -> UVarInt -> UVarInt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UVarInt -> UVarInt -> Ordering
compare :: UVarInt -> UVarInt -> Ordering
$c< :: UVarInt -> UVarInt -> Bool
< :: UVarInt -> UVarInt -> Bool
$c<= :: UVarInt -> UVarInt -> Bool
<= :: UVarInt -> UVarInt -> Bool
$c> :: UVarInt -> UVarInt -> Bool
> :: UVarInt -> UVarInt -> Bool
$c>= :: UVarInt -> UVarInt -> Bool
>= :: UVarInt -> UVarInt -> Bool
$cmax :: UVarInt -> UVarInt -> UVarInt
max :: UVarInt -> UVarInt -> UVarInt
$cmin :: UVarInt -> UVarInt -> UVarInt
min :: UVarInt -> UVarInt -> UVarInt
Ord, Num UVarInt
Ord UVarInt
(Num UVarInt, Ord UVarInt) => (UVarInt -> Rational) -> Real UVarInt
UVarInt -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: UVarInt -> Rational
toRational :: UVarInt -> Rational
Real, Enum UVarInt
Real UVarInt
(Real UVarInt, Enum UVarInt) =>
(UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> (UVarInt, UVarInt))
-> (UVarInt -> UVarInt -> (UVarInt, UVarInt))
-> (UVarInt -> Integer)
-> Integral UVarInt
UVarInt -> Integer
UVarInt -> UVarInt -> (UVarInt, UVarInt)
UVarInt -> UVarInt -> UVarInt
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: UVarInt -> UVarInt -> UVarInt
quot :: UVarInt -> UVarInt -> UVarInt
$crem :: UVarInt -> UVarInt -> UVarInt
rem :: UVarInt -> UVarInt -> UVarInt
$cdiv :: UVarInt -> UVarInt -> UVarInt
div :: UVarInt -> UVarInt -> UVarInt
$cmod :: UVarInt -> UVarInt -> UVarInt
mod :: UVarInt -> UVarInt -> UVarInt
$cquotRem :: UVarInt -> UVarInt -> (UVarInt, UVarInt)
quotRem :: UVarInt -> UVarInt -> (UVarInt, UVarInt)
$cdivMod :: UVarInt -> UVarInt -> (UVarInt, UVarInt)
divMod :: UVarInt -> UVarInt -> (UVarInt, UVarInt)
$ctoInteger :: UVarInt -> Integer
toInteger :: UVarInt -> Integer
Integral, UVarInt
UVarInt -> UVarInt -> Bounded UVarInt
forall a. a -> a -> Bounded a
$cminBound :: UVarInt
minBound :: UVarInt
$cmaxBound :: UVarInt
maxBound :: UVarInt
Bounded, UVarInt -> ()
(UVarInt -> ()) -> NFData UVarInt
forall a. (a -> ()) -> NFData a
$crnf :: UVarInt -> ()
rnf :: UVarInt -> ()
NFData)








-- * Versioning

client_version_major, client_version_minor :: UVarInt
client_version_patch :: UVarInt  `SinceRevision` DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_major :: UVarInt
client_version_major = case Version -> [Int]
versionBranch Version
version of (Int
x:[Int]
_) -> Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x; [Int]
_ -> UVarInt
0
client_version_minor :: UVarInt
client_version_minor = case Version -> [Int]
versionBranch Version
version of (Int
_:Int
x:[Int]
_) -> Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x; [Int]
_ -> UVarInt
0
client_version_patch :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_patch = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision (UVarInt
 -> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH)
-> UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
forall a b. (a -> b) -> a -> b
$ case Version -> [Int]
versionBranch Version
version of (Int
_:Int
_:Int
x:[Int]
_) -> Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x; [Int]
_ -> UVarInt
0

client_name :: ChString
client_name :: ChString
client_name = String -> ChString
forall a. IsString a => String -> a
fromString (String -> ChString) -> String -> ChString
forall a b. (a -> b) -> a -> b
$
  String
"ClickHaskell-"
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
client_version_major String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
client_version_minor String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
-> String
forall a. Show a => a -> String
show SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_patch

newtype ProtocolRevision = MkProtocolRevision Word64
  deriving newtype (Int -> ProtocolRevision -> ShowS
[ProtocolRevision] -> ShowS
ProtocolRevision -> String
(Int -> ProtocolRevision -> ShowS)
-> (ProtocolRevision -> String)
-> ([ProtocolRevision] -> ShowS)
-> Show ProtocolRevision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolRevision -> ShowS
showsPrec :: Int -> ProtocolRevision -> ShowS
$cshow :: ProtocolRevision -> String
show :: ProtocolRevision -> String
$cshowList :: [ProtocolRevision] -> ShowS
showList :: [ProtocolRevision] -> ShowS
Show, ProtocolRevision -> ProtocolRevision -> Bool
(ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> Eq ProtocolRevision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolRevision -> ProtocolRevision -> Bool
== :: ProtocolRevision -> ProtocolRevision -> Bool
$c/= :: ProtocolRevision -> ProtocolRevision -> Bool
/= :: ProtocolRevision -> ProtocolRevision -> Bool
Eq, Integer -> ProtocolRevision
ProtocolRevision -> ProtocolRevision
ProtocolRevision -> ProtocolRevision -> ProtocolRevision
(ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision)
-> (Integer -> ProtocolRevision)
-> Num ProtocolRevision
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
+ :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
$c- :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
- :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
$c* :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
* :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
$cnegate :: ProtocolRevision -> ProtocolRevision
negate :: ProtocolRevision -> ProtocolRevision
$cabs :: ProtocolRevision -> ProtocolRevision
abs :: ProtocolRevision -> ProtocolRevision
$csignum :: ProtocolRevision -> ProtocolRevision
signum :: ProtocolRevision -> ProtocolRevision
$cfromInteger :: Integer -> ProtocolRevision
fromInteger :: Integer -> ProtocolRevision
Num, Eq ProtocolRevision
Eq ProtocolRevision =>
(ProtocolRevision -> ProtocolRevision -> Ordering)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> Ord ProtocolRevision
ProtocolRevision -> ProtocolRevision -> Bool
ProtocolRevision -> ProtocolRevision -> Ordering
ProtocolRevision -> ProtocolRevision -> ProtocolRevision
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProtocolRevision -> ProtocolRevision -> Ordering
compare :: ProtocolRevision -> ProtocolRevision -> Ordering
$c< :: ProtocolRevision -> ProtocolRevision -> Bool
< :: ProtocolRevision -> ProtocolRevision -> Bool
$c<= :: ProtocolRevision -> ProtocolRevision -> Bool
<= :: ProtocolRevision -> ProtocolRevision -> Bool
$c> :: ProtocolRevision -> ProtocolRevision -> Bool
> :: ProtocolRevision -> ProtocolRevision -> Bool
$c>= :: ProtocolRevision -> ProtocolRevision -> Bool
>= :: ProtocolRevision -> ProtocolRevision -> Bool
$cmax :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
max :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
$cmin :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
min :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
Ord)

instance Deserializable ProtocolRevision where deserialize :: ProtocolRevision -> Get ProtocolRevision
deserialize = Get UVarInt -> Get ProtocolRevision
forall a b. Coercible a b => a -> b
coerce (Get UVarInt -> Get ProtocolRevision)
-> (ProtocolRevision -> Get UVarInt)
-> ProtocolRevision
-> Get ProtocolRevision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt
instance Serializable ProtocolRevision where serialize :: ProtocolRevision -> ProtocolRevision -> Builder
serialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (UVarInt -> Builder)
-> (ProtocolRevision -> UVarInt) -> ProtocolRevision -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolRevision -> UVarInt
forall a b. Coercible a b => a -> b
coerce

{-# INLINE [0] afterRevision #-}
afterRevision
  :: forall revision monoid
  .  (KnownNat revision, Monoid monoid)
  => ProtocolRevision -> monoid -> monoid
afterRevision :: forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision ProtocolRevision
chosenRevision monoid
monoid =
  if ProtocolRevision
chosenRevision ProtocolRevision -> ProtocolRevision -> Bool
forall a. Ord a => a -> a -> Bool
>= (Integer -> ProtocolRevision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ProtocolRevision)
-> (Proxy revision -> Integer)
-> Proxy revision
-> ProtocolRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy revision -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal) (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @revision)
  then monoid
monoid
  else monoid
forall a. Monoid a => a
mempty

{-# INLINE [0] mostRecentRevision #-}
mostRecentRevision :: ProtocolRevision
mostRecentRevision :: ProtocolRevision
mostRecentRevision = (Integer -> ProtocolRevision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ProtocolRevision)
-> (Proxy DBMS_TCP_PROTOCOL_VERSION -> Integer)
-> Proxy DBMS_TCP_PROTOCOL_VERSION
-> ProtocolRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy DBMS_TCP_PROTOCOL_VERSION -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal) (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @DBMS_TCP_PROTOCOL_VERSION)

data SinceRevision a (revisionNumber :: Nat) = MkSinceRevision a | NotPresented
instance Show a => Show (SinceRevision a revisionNumber) where
  show :: SinceRevision a revisionNumber -> String
show (MkSinceRevision a
a) = a -> String
forall a. Show a => a -> String
show a
a
  show SinceRevision a revisionNumber
NotPresented = String
""

instance
  ( KnownNat revision
  , Deserializable chType
  )
  =>
  Deserializable (SinceRevision chType revision)
  where
  deserialize :: ProtocolRevision -> Get (SinceRevision chType revision)
deserialize ProtocolRevision
rev =
    if ProtocolRevision
rev ProtocolRevision -> ProtocolRevision -> Bool
forall a. Ord a => a -> a -> Bool
>= (Integer -> ProtocolRevision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ProtocolRevision)
-> (Proxy revision -> Integer)
-> Proxy revision
-> ProtocolRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy revision -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal) (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @revision)
    then chType -> SinceRevision chType revision
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision (chType -> SinceRevision chType revision)
-> Get chType -> Get (SinceRevision chType revision)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev
    else SinceRevision chType revision
-> Get (SinceRevision chType revision)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SinceRevision chType revision
forall a (revisionNumber :: Nat). SinceRevision a revisionNumber
NotPresented

instance
  ( KnownNat revision
  , Serializable chType
  )
  =>
  Serializable (SinceRevision chType revision)
  where
  serialize :: ProtocolRevision -> SinceRevision chType revision -> Builder
serialize ProtocolRevision
rev (MkSinceRevision chType
val) = forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @revision ProtocolRevision
rev (ProtocolRevision -> chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev chType
val)
  serialize ProtocolRevision
rev SinceRevision chType revision
NotPresented          = forall (revision :: Nat) monoid.
(KnownNat revision, Monoid monoid) =>
ProtocolRevision -> monoid -> monoid
afterRevision @revision ProtocolRevision
rev (String -> Builder
forall a. HasCallStack => String -> a
error String
"Unexpected error")


{-
  Slightly modified C++ sources:
  https://github.com/ClickHouse/ClickHouse/blob/eb4a74d7412a1fcf52727cd8b00b365d6b9ed86c/src/Core/ProtocolDefines.h#L6
-}
type DBMS_TCP_PROTOCOL_VERSION = 54448;

type DBMS_MIN_REVISION_WITH_CLIENT_INFO = 54032;
type DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE = 54058;
type DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO = 54060;
type DBMS_MIN_REVISION_WITH_TABLES_STATUS = 54226;
type DBMS_MIN_REVISION_WITH_TIME_ZONE_PARAMETER_IN_DATETIME_DATA_TYPE = 54337;
type DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME = 54372;
type DBMS_MIN_REVISION_WITH_VERSION_PATCH = 54401;
type DBMS_MIN_REVISION_WITH_SERVER_LOGS = 54406;
type DBMS_MIN_REVISION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 54448;
type DBMS_MIN_MAJOR_VERSION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 21;
type DBMS_MIN_MINOR_VERSION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 4;
type DBMS_MIN_REVISION_WITH_COLUMN_DEFAULTS_METADATA = 54410;
type DBMS_MIN_REVISION_WITH_LOW_CARDINALITY_TYPE = 54405;
type DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO = 54420;
type DBMS_MIN_REVISION_WITH_SETTINGS_SERIALIZED_AS_STRINGS = 54429;
type DBMS_MIN_REVISION_WITH_SCALARS = 54429;
type DBMS_MIN_REVISION_WITH_OPENTELEMETRY = 54442;
type DBMS_MIN_REVISION_WITH_AGGREGATE_FUNCTIONS_VERSIONING = 54452;
type DBMS_CLUSTER_PROCESSING_PROTOCOL_VERSION = 1;
type DBMS_MIN_SUPPORTED_PARALLEL_REPLICAS_PROTOCOL_VERSION = 3;
type DBMS_PARALLEL_REPLICAS_MIN_VERSION_WITH_MARK_SEGMENT_SIZE_FIELD = 4;
type DBMS_PARALLEL_REPLICAS_PROTOCOL_VERSION = 4;
type DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS = 54453;
type DBMS_MERGE_TREE_PART_INFO_VERSION = 1;
type DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET = 54441;
type DBMS_MIN_REVISION_WITH_X_FORWARDED_FOR_IN_CLIENT_INFO = 54443;
type DBMS_MIN_REVISION_WITH_REFERER_IN_CLIENT_INFO = 54447;
type DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH = 54448;
type DBMS_MIN_PROTOCOL_VERSION_WITH_INCREMENTAL_PROFILE_EVENTS = 54451;
type DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION = 54454;
type DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME = 54449;
type DBMS_MIN_PROTOCOL_VERSION_WITH_PROFILE_EVENTS_IN_INSERT = 54456;
type DBMS_MIN_PROTOCOL_VERSION_WITH_VIEW_IF_PERMITTED = 54457;
type DBMS_MIN_PROTOCOL_VERSION_WITH_ADDENDUM = 54458;
type DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY = 54458;
type DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS = 54459;
type DBMS_MIN_PROTOCOL_VERSION_WITH_SERVER_QUERY_TIME_IN_PROGRESS = 54460;
type DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES = 54461;
type DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2 = 54462;
type DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS = 54463;
type DBMS_MIN_PROTOCOL_VERSION_WITH_TIMEZONE_UPDATES = 54464;
type DBMS_MIN_REVISION_WITH_SPARSE_SERIALIZATION = 54465;
type DBMS_MIN_REVISION_WITH_SSH_AUTHENTICATION = 54466;
type DBMS_MIN_REVISION_WITH_TABLE_READ_ONLY_CHECK = 54467;
type DBMS_MIN_REVISION_WITH_SYSTEM_KEYWORDS_TABLE = 54468;
type DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION = 54469;
type DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS = 54470;
type DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL = 54471;