{-# LANGUAGE BangPatterns #-}
module ClickHaskell.Primitive where

-- GHC included
import Control.Applicative (liftA2)
import Control.DeepSeq (NFData)
import Data.Binary.Get
import Data.Bits (Bits (setBit, unsafeShiftL, unsafeShiftR, (.&.), (.|.)))
import Data.Bool (bool)
import Data.ByteString as BS (ByteString, length)
import Data.ByteString.Builder
import Data.ByteString.Char8 as BS8 (pack, unpack, concatMap, singleton, replicate, length)
import Data.ByteString.Lazy (toStrict)
import Data.Coerce (coerce)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.List (uncons)
import Data.String (IsString (..))
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX
import Data.Type.Bool (Not)
import Data.Type.Equality (type (==))
import Data.Typeable (Proxy (..))
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Generics (C1, D1, Generic (..), K1 (K1), M1 (M1), Meta (MetaSel), Rec0, S1, type (:*:) (..))
import GHC.TypeLits (ErrorMessage (..), KnownNat, KnownSymbol, Nat, Symbol, TypeError, natVal, symbolVal)
import Prelude hiding (liftA2)

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

-- * User types

-- ** Abstractions

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

  {-# INLINE deserialize #-}
  default deserialize :: (Generic chType, GSerial (Rep chType)) => ProtocolRevision -> Get chType
  deserialize :: ProtocolRevision -> Get chType
  deserialize ProtocolRevision
rev = Rep chType (ZonkAny 1) -> chType
forall a x. Generic a => Rep a x -> a
forall x. Rep chType x -> chType
to (Rep chType (ZonkAny 1) -> chType)
-> Get (Rep chType (ZonkAny 1)) -> Get chType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (Rep chType (ZonkAny 1))
forall p. ProtocolRevision -> Get (Rep chType p)
forall (f :: * -> *) p. GSerial f => ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev

{-# INLINE replicateGet #-}
replicateGet :: Serializable chType => ProtocolRevision -> UVarInt -> Get [chType]
replicateGet :: forall chType.
Serializable chType =>
ProtocolRevision -> UVarInt -> Get [chType]
replicateGet ProtocolRevision
rev UVarInt
cnt0 = UVarInt -> Get [chType]
loopGet UVarInt
cnt0
  where
  loopGet :: UVarInt -> Get [chType]
loopGet UVarInt
cnt
    | UVarInt
cnt UVarInt -> UVarInt -> Bool
forall a. Eq a => a -> a -> Bool
== UVarInt
0  = [chType] -> Get [chType]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    | Bool
otherwise = (chType -> [chType] -> [chType])
-> Get chType -> Get [chType] -> Get [chType]
forall a b c. (a -> b -> c) -> Get a -> Get b -> Get c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (ProtocolRevision -> Get chType
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev) (UVarInt -> Get [chType]
loopGet (UVarInt
cnt UVarInt -> UVarInt -> UVarInt
forall a. Num a => a -> a -> a
- UVarInt
1))

instance Serializable prim => Serializable [prim] where
  serialize :: ProtocolRevision -> [prim] -> Builder
serialize ProtocolRevision
rev [prim]
list
    =  forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> Int -> UVarInt
forall a b. (a -> b) -> a -> b
$ [prim] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [prim]
list)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (prim -> Builder) -> [prim] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @prim ProtocolRevision
rev) [prim]
list
  deserialize :: ProtocolRevision -> Get [prim]
deserialize ProtocolRevision
rev = do
    len <- forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    replicateGet @prim rev len
  {-# INLINE deserialize #-}

class ToQueryPart chType where
  toQueryPart :: chType -> Builder

class IsChType chType
  where
  -- | Shows database original type name
  --
  -- @
  -- chTypeName \@ChString = \"String\"
  -- chTypeName \@(Nullable UInt32) = \"Nullable(UInt32)\"
  -- @
  chTypeName :: String

  defaultValueOfTypeName :: chType

class ToChType chType userType    where
  toChType   :: userType -> chType
  fromChType :: chType -> userType

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


-- ** Int8

instance IsChType Int8 where
  chTypeName :: String
chTypeName = String
"Int8"
  defaultValueOfTypeName :: Int8
defaultValueOfTypeName = Int8
0

instance Serializable Int8 where
  serialize :: ProtocolRevision -> Int8 -> Builder
serialize ProtocolRevision
_ = Int8 -> Builder
int8
  deserialize :: ProtocolRevision -> Get Int8
deserialize ProtocolRevision
_ = Get Int8
getInt8
  {-# INLINE deserialize #-}

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


-- ** Int16

instance IsChType Int16 where
  chTypeName :: String
chTypeName = String
"Int16"
  defaultValueOfTypeName :: Int16
defaultValueOfTypeName = Int16
0

instance Serializable Int16 where
  serialize :: ProtocolRevision -> Int16 -> Builder
serialize ProtocolRevision
_ = Int16 -> Builder
int16LE
  deserialize :: ProtocolRevision -> Get Int16
deserialize ProtocolRevision
_ = Get Int16
getInt16le
  {-# INLINE deserialize #-}

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


-- ** Int32

instance IsChType Int32 where
  chTypeName :: String
chTypeName = String
"Int32"
  defaultValueOfTypeName :: Int32
defaultValueOfTypeName = Int32
0

instance Serializable Int32 where
  serialize :: ProtocolRevision -> Int32 -> Builder
serialize ProtocolRevision
_ = Int32 -> Builder
int32LE
  deserialize :: ProtocolRevision -> Get Int32
deserialize ProtocolRevision
_ = Get Int32
getInt32le
  {-# INLINE deserialize #-}

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


-- ** Int64

instance IsChType Int64 where
  chTypeName :: String
chTypeName = String
"Int64"
  defaultValueOfTypeName :: Int64
defaultValueOfTypeName = Int64
0

instance Serializable Int64 where
  serialize :: ProtocolRevision -> Int64 -> Builder
serialize ProtocolRevision
_ = Int64 -> Builder
int64LE
  deserialize :: ProtocolRevision -> Get Int64
deserialize ProtocolRevision
_ = Get Int64
getInt64le
  {-# INLINE deserialize #-}

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


-- ** Int128

instance IsChType Int128 where
  chTypeName :: String
chTypeName = String
"Int128"
  defaultValueOfTypeName :: Int128
defaultValueOfTypeName = Int128
0

instance Serializable Int128 where
  serialize :: ProtocolRevision -> Int128 -> Builder
serialize ProtocolRevision
_ = (\(Int128 Word64
hi Word64
lo) -> Word64 -> Builder
word64LE Word64
lo Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64LE Word64
hi)
  deserialize :: ProtocolRevision -> Get Int128
deserialize ProtocolRevision
_ = do
    low <- Get Word64
getWord64le
    high <- getWord64le
    pure $ Int128 high low
  {-# INLINE deserialize #-}

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


-- ** UInt8

{- | ClickHouse UInt8 column type -}
type UInt8 = Word8
instance IsChType UInt8 where
  chTypeName :: String
chTypeName = String
"UInt8"
  defaultValueOfTypeName :: UInt8
defaultValueOfTypeName = UInt8
0

instance Serializable UInt8 where
  serialize :: ProtocolRevision -> UInt8 -> Builder
serialize ProtocolRevision
_ = UInt8 -> Builder
word8
  deserialize :: ProtocolRevision -> Get UInt8
deserialize ProtocolRevision
_ = Get UInt8
getWord8
  {-# INLINE deserialize #-}

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


-- ** UInt16

{- | ClickHouse UInt16 column type -}
type UInt16 = Word16
instance IsChType UInt16 where
  chTypeName :: String
chTypeName = String
"UInt16"
  defaultValueOfTypeName :: UInt16
defaultValueOfTypeName = UInt16
0

instance Serializable UInt16 where
  serialize :: ProtocolRevision -> UInt16 -> Builder
serialize ProtocolRevision
_ = UInt16 -> Builder
word16LE
  deserialize :: ProtocolRevision -> Get UInt16
deserialize ProtocolRevision
_ = Get UInt16
getWord16le
  {-# INLINE deserialize #-}

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


-- ** UInt32

{- | ClickHouse UInt32 column type -}
type UInt32 = Word32
instance IsChType UInt32 where
  chTypeName :: String
chTypeName = String
"UInt32"
  defaultValueOfTypeName :: UInt32
defaultValueOfTypeName = UInt32
0

instance Serializable UInt32 where
  serialize :: ProtocolRevision -> UInt32 -> Builder
serialize ProtocolRevision
_ = UInt32 -> Builder
word32LE
  deserialize :: ProtocolRevision -> Get UInt32
deserialize ProtocolRevision
_ = Get UInt32
getWord32le
  {-# INLINE deserialize #-}

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


-- ** UInt64

{- | ClickHouse UInt64 column type -}
type UInt64 = Word64
instance IsChType UInt64 where
  chTypeName :: String
chTypeName = String
"UInt64"
  defaultValueOfTypeName :: Word64
defaultValueOfTypeName = Word64
0

instance Serializable UInt64 where
  serialize :: ProtocolRevision -> Word64 -> Builder
serialize ProtocolRevision
_ = Word64 -> Builder
word64LE
  deserialize :: ProtocolRevision -> Get Word64
deserialize ProtocolRevision
_ = Get Word64
getWord64le
  {-# INLINE deserialize #-}

instance ToQueryPart UInt64 where
  toQueryPart :: Word64 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Word64 -> StrictByteString) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (Word64 -> String) -> Word64 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show


-- ** UInt128

{- | ClickHouse UInt128 column type -}
type UInt128 = Word128
instance IsChType UInt128 where
  chTypeName :: String
chTypeName = String
"UInt128"
  defaultValueOfTypeName :: UInt128
defaultValueOfTypeName = UInt128
0

instance Serializable UInt128 where
  serialize :: ProtocolRevision -> UInt128 -> Builder
serialize ProtocolRevision
_ = (\(Word128 Word64
hi Word64
lo) -> Word64 -> Builder
word64LE Word64
lo Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64LE Word64
hi)
  deserialize :: ProtocolRevision -> Get UInt128
deserialize ProtocolRevision
_ = do
    low <- Get Word64
getWord64le
    high <- getWord64le
    pure $ Word128 high low
  {-# INLINE deserialize #-}

instance ToQueryPart UInt128 where
  toQueryPart :: UInt128 -> Builder
toQueryPart UInt128
w128 = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt128 -> StrictByteString) -> UInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (UInt128 -> String) -> UInt128 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt128 -> String
forall a. Show a => a -> String
show) UInt128
w128 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"


-- ** Int256

{- | ClickHouse UInt128 column type -}
type UInt256 = Word256
instance IsChType UInt256 where
  chTypeName :: String
chTypeName = String
"UInt256"
  defaultValueOfTypeName :: UInt256
defaultValueOfTypeName = UInt256
0

instance Serializable UInt256 where
  serialize :: ProtocolRevision -> UInt256 -> Builder
serialize ProtocolRevision
_ = (\(Word256 Word64
high Word64
mid1 Word64
mid0 Word64
low) -> Word64 -> Builder
word64LE Word64
low Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64LE Word64
mid0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64LE Word64
mid1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64LE Word64
high)
  deserialize :: ProtocolRevision -> Get UInt256
deserialize ProtocolRevision
_ = do
    low <- Get Word64
getWord64le
    mid0 <- getWord64le
    mid1 <- getWord64le
    high <- getWord64le
    pure $ Word256 high mid1 mid0 low
  {-# INLINE deserialize #-}

instance ToQueryPart UInt256 where
  toQueryPart :: UInt256 -> Builder
toQueryPart UInt256
w256 = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt256 -> StrictByteString) -> UInt256 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (UInt256 -> String) -> UInt256 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt256 -> String
forall a. Show a => a -> String
show) UInt256
w256 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"


-- ** Date

{- | ClickHouse Date column type -}
newtype Date = MkDate Word16
  deriving newtype (Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Date -> ShowS
showsPrec :: Int -> Date -> ShowS
$cshow :: Date -> String
show :: Date -> String
$cshowList :: [Date] -> ShowS
showList :: [Date] -> ShowS
Show, Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
/= :: Date -> Date -> Bool
Eq, Eq Date
Date
Eq Date =>
(Date -> Date -> Date)
-> (Date -> Date -> Date)
-> (Date -> Date -> Date)
-> (Date -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int -> Date)
-> Date
-> (Int -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int -> Bool)
-> (Date -> Maybe Int)
-> (Date -> Int)
-> (Date -> Bool)
-> (Date -> Int -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int -> Date)
-> (Date -> Int)
-> Bits Date
Int -> Date
Date -> Bool
Date -> Int
Date -> Maybe Int
Date -> Date
Date -> Int -> Bool
Date -> Int -> Date
Date -> Date -> Date
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.&. :: Date -> Date -> Date
.&. :: Date -> Date -> Date
$c.|. :: Date -> Date -> Date
.|. :: Date -> Date -> Date
$cxor :: Date -> Date -> Date
xor :: Date -> Date -> Date
$ccomplement :: Date -> Date
complement :: Date -> Date
$cshift :: Date -> Int -> Date
shift :: Date -> Int -> Date
$crotate :: Date -> Int -> Date
rotate :: Date -> Int -> Date
$czeroBits :: Date
zeroBits :: Date
$cbit :: Int -> Date
bit :: Int -> Date
$csetBit :: Date -> Int -> Date
setBit :: Date -> Int -> Date
$cclearBit :: Date -> Int -> Date
clearBit :: Date -> Int -> Date
$ccomplementBit :: Date -> Int -> Date
complementBit :: Date -> Int -> Date
$ctestBit :: Date -> Int -> Bool
testBit :: Date -> Int -> Bool
$cbitSizeMaybe :: Date -> Maybe Int
bitSizeMaybe :: Date -> Maybe Int
$cbitSize :: Date -> Int
bitSize :: Date -> Int
$cisSigned :: Date -> Bool
isSigned :: Date -> Bool
$cshiftL :: Date -> Int -> Date
shiftL :: Date -> Int -> Date
$cunsafeShiftL :: Date -> Int -> Date
unsafeShiftL :: Date -> Int -> Date
$cshiftR :: Date -> Int -> Date
shiftR :: Date -> Int -> Date
$cunsafeShiftR :: Date -> Int -> Date
unsafeShiftR :: Date -> Int -> Date
$crotateL :: Date -> Int -> Date
rotateL :: Date -> Int -> Date
$crotateR :: Date -> Int -> Date
rotateR :: Date -> Int -> Date
$cpopCount :: Date -> Int
popCount :: Date -> Int
Bits, Date
Date -> Date -> Bounded Date
forall a. a -> a -> Bounded a
$cminBound :: Date
minBound :: Date
$cmaxBound :: Date
maxBound :: Date
Bounded, Int -> Date
Date -> Int
Date -> [Date]
Date -> Date
Date -> Date -> [Date]
Date -> Date -> Date -> [Date]
(Date -> Date)
-> (Date -> Date)
-> (Int -> Date)
-> (Date -> Int)
-> (Date -> [Date])
-> (Date -> Date -> [Date])
-> (Date -> Date -> [Date])
-> (Date -> Date -> Date -> [Date])
-> Enum Date
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 :: Date -> Date
succ :: Date -> Date
$cpred :: Date -> Date
pred :: Date -> Date
$ctoEnum :: Int -> Date
toEnum :: Int -> Date
$cfromEnum :: Date -> Int
fromEnum :: Date -> Int
$cenumFrom :: Date -> [Date]
enumFrom :: Date -> [Date]
$cenumFromThen :: Date -> Date -> [Date]
enumFromThen :: Date -> Date -> [Date]
$cenumFromTo :: Date -> Date -> [Date]
enumFromTo :: Date -> Date -> [Date]
$cenumFromThenTo :: Date -> Date -> Date -> [Date]
enumFromThenTo :: Date -> Date -> Date -> [Date]
Enum, Date -> ()
(Date -> ()) -> NFData Date
forall a. (a -> ()) -> NFData a
$crnf :: Date -> ()
rnf :: Date -> ()
NFData, Integer -> Date
Date -> Date
Date -> Date -> Date
(Date -> Date -> Date)
-> (Date -> Date -> Date)
-> (Date -> Date -> Date)
-> (Date -> Date)
-> (Date -> Date)
-> (Date -> Date)
-> (Integer -> Date)
-> Num Date
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Date -> Date -> Date
+ :: Date -> Date -> Date
$c- :: Date -> Date -> Date
- :: Date -> Date -> Date
$c* :: Date -> Date -> Date
* :: Date -> Date -> Date
$cnegate :: Date -> Date
negate :: Date -> Date
$cabs :: Date -> Date
abs :: Date -> Date
$csignum :: Date -> Date
signum :: Date -> Date
$cfromInteger :: Integer -> Date
fromInteger :: Integer -> Date
Num)

instance IsChType Date where
  chTypeName :: String
chTypeName = String
"Date"
  defaultValueOfTypeName :: Date
defaultValueOfTypeName = Date
0

instance Serializable Date where
  serialize :: ProtocolRevision -> Date -> Builder
serialize ProtocolRevision
_ (MkDate UInt16
w16) = UInt16 -> Builder
word16LE UInt16
w16
  deserialize :: ProtocolRevision -> Get Date
deserialize ProtocolRevision
_ = UInt16 -> Date
MkDate (UInt16 -> Date) -> Get UInt16 -> Get Date
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get UInt16
getWord16le
  {-# INLINE deserialize #-}

instance ToChType Date Word16 where
  toChType :: UInt16 -> Date
toChType = UInt16 -> Date
MkDate
  fromChType :: Date -> UInt16
fromChType (MkDate UInt16
w16) = UInt16
w16


-- ** ChString

{- | ClickHouse String column type -}
newtype ChString = MkChString BS.ByteString
  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
  chTypeName :: String
chTypeName = String
"String"
  defaultValueOfTypeName :: ChString
defaultValueOfTypeName = ChString
""

instance Serializable ChString where
  serialize :: ProtocolRevision -> ChString -> Builder
serialize ProtocolRevision
rev (MkChString StrictByteString
str) = (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (UVarInt -> Builder)
-> (StrictByteString -> UVarInt) -> StrictByteString -> 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)
-> (StrictByteString -> Int) -> StrictByteString -> UVarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Int
BS.length) StrictByteString
str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
byteString StrictByteString
str
  deserialize :: ProtocolRevision -> Get ChString
deserialize ProtocolRevision
rev = do
    len <- forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    MkChString <$> (getByteString . fromIntegral) len
  {-# INLINE deserialize #-}

instance ToChType ChString BS.ByteString where
  toChType :: StrictByteString -> ChString
toChType = StrictByteString -> ChString
MkChString
  fromChType :: ChString -> StrictByteString
fromChType (MkChString StrictByteString
string) = StrictByteString
string

instance ToChType ChString Builder where
  toChType :: Builder -> ChString
toChType = StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> StrictByteString
toStrict (LazyByteString -> StrictByteString)
-> (Builder -> LazyByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString
  fromChType :: ChString -> Builder
fromChType (MkChString StrictByteString
string) = StrictByteString -> Builder
byteString StrictByteString
string

instance ToChType ChString String where
  toChType :: String -> ChString
toChType = StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (String -> StrictByteString) -> String -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack
  fromChType :: ChString -> String
fromChType (MkChString StrictByteString
bs)= StrictByteString -> String
BS8.unpack StrictByteString
bs

instance ToQueryPart ChString where
  toQueryPart :: ChString -> Builder
toQueryPart (MkChString StrictByteString
string) =  Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
escapeQuery StrictByteString
string Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"
    where
    escapeQuery :: BS.ByteString -> Builder
    escapeQuery :: StrictByteString -> Builder
escapeQuery = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (StrictByteString -> StrictByteString)
-> StrictByteString
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> StrictByteString) -> StrictByteString -> StrictByteString
BS8.concatMap (\Char
sym ->
      case Char
sym of
        Char
'\'' -> StrictByteString
"\\\'"
        Char
'\\' -> StrictByteString
"\\\\"
        Char
_ -> Char -> StrictByteString
BS8.singleton Char
sym
      )



-- ** UUID

{- | ClickHouse UUID column type -}
newtype UUID = MkUUID Word128
  deriving newtype ((forall x. UUID -> Rep UUID x)
-> (forall x. Rep UUID x -> UUID) -> Generic UUID
forall x. Rep UUID x -> UUID
forall x. UUID -> Rep UUID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UUID -> Rep UUID x
from :: forall x. UUID -> Rep UUID x
$cto :: forall x. Rep UUID x -> UUID
to :: forall x. Rep UUID x -> UUID
Generic, Int -> UUID -> ShowS
[UUID] -> ShowS
UUID -> String
(Int -> UUID -> ShowS)
-> (UUID -> String) -> ([UUID] -> ShowS) -> Show UUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UUID -> ShowS
showsPrec :: Int -> UUID -> ShowS
$cshow :: UUID -> String
show :: UUID -> String
$cshowList :: [UUID] -> ShowS
showList :: [UUID] -> ShowS
Show, UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
/= :: UUID -> UUID -> Bool
Eq, UUID -> ()
(UUID -> ()) -> NFData UUID
forall a. (a -> ()) -> NFData a
$crnf :: UUID -> ()
rnf :: UUID -> ()
NFData, UUID
UUID -> UUID -> Bounded UUID
forall a. a -> a -> Bounded a
$cminBound :: UUID
minBound :: UUID
$cmaxBound :: UUID
maxBound :: UUID
Bounded, Int -> UUID
UUID -> Int
UUID -> [UUID]
UUID -> UUID
UUID -> UUID -> [UUID]
UUID -> UUID -> UUID -> [UUID]
(UUID -> UUID)
-> (UUID -> UUID)
-> (Int -> UUID)
-> (UUID -> Int)
-> (UUID -> [UUID])
-> (UUID -> UUID -> [UUID])
-> (UUID -> UUID -> [UUID])
-> (UUID -> UUID -> UUID -> [UUID])
-> Enum UUID
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 :: UUID -> UUID
succ :: UUID -> UUID
$cpred :: UUID -> UUID
pred :: UUID -> UUID
$ctoEnum :: Int -> UUID
toEnum :: Int -> UUID
$cfromEnum :: UUID -> Int
fromEnum :: UUID -> Int
$cenumFrom :: UUID -> [UUID]
enumFrom :: UUID -> [UUID]
$cenumFromThen :: UUID -> UUID -> [UUID]
enumFromThen :: UUID -> UUID -> [UUID]
$cenumFromTo :: UUID -> UUID -> [UUID]
enumFromTo :: UUID -> UUID -> [UUID]
$cenumFromThenTo :: UUID -> UUID -> UUID -> [UUID]
enumFromThenTo :: UUID -> UUID -> UUID -> [UUID]
Enum, Integer -> UUID
UUID -> UUID
UUID -> UUID -> UUID
(UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID)
-> (UUID -> UUID)
-> (UUID -> UUID)
-> (Integer -> UUID)
-> Num UUID
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: UUID -> UUID -> UUID
+ :: UUID -> UUID -> UUID
$c- :: UUID -> UUID -> UUID
- :: UUID -> UUID -> UUID
$c* :: UUID -> UUID -> UUID
* :: UUID -> UUID -> UUID
$cnegate :: UUID -> UUID
negate :: UUID -> UUID
$cabs :: UUID -> UUID
abs :: UUID -> UUID
$csignum :: UUID -> UUID
signum :: UUID -> UUID
$cfromInteger :: Integer -> UUID
fromInteger :: Integer -> UUID
Num)
instance IsChType UUID where
  chTypeName :: String
chTypeName = String
"UUID"
  defaultValueOfTypeName :: UUID
defaultValueOfTypeName = UUID
0

instance Serializable UUID where
  serialize :: ProtocolRevision -> UUID -> Builder
serialize ProtocolRevision
_ = (\(MkUUID (Word128 Word64
hi Word64
lo)) -> Word64 -> Builder
word64LE Word64
lo Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64LE Word64
hi)
  deserialize :: ProtocolRevision -> Get UUID
deserialize ProtocolRevision
_ = do
    low <- Get Word64
getWord64le
    high <- getWord64le
    pure $ MkUUID (Word128 high low)
  {-# INLINE deserialize #-}

instance ToChType UUID (Word64, Word64) where
  toChType :: (Word64, Word64) -> UUID
toChType = UInt128 -> UUID
MkUUID (UInt128 -> UUID)
-> ((Word64, Word64) -> UInt128) -> (Word64, Word64) -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> UInt128) -> (Word64, Word64) -> UInt128
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> Word64 -> UInt128) -> Word64 -> Word64 -> UInt128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> UInt128
Word128)
  fromChType :: UUID -> (Word64, Word64)
fromChType (MkUUID (Word128 Word64
w64hi Word64
w64lo)) = (Word64
w64hi, Word64
w64lo)

instance ToQueryPart UUID where
  toQueryPart :: UUID -> Builder
toQueryPart (MkUUID (Word128 Word64
hi Word64
lo)) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [Builder
"'", Int -> Word64 -> Builder
p Int
3 Word64
hi, Int -> Word64 -> Builder
p Int
2 Word64
hi, Builder
"-", Int -> Word64 -> Builder
p Int
1 Word64
hi, Builder
"-", Int -> Word64 -> Builder
p Int
0 Word64
hi, Builder
"-", Int -> Word64 -> Builder
p Int
3 Word64
lo, Builder
"-", Int -> Word64 -> Builder
p Int
2 Word64
lo, Int -> Word64 -> Builder
p Int
1 Word64
lo, Int -> Word64 -> Builder
p Int
0 Word64
lo, Builder
"'"]
    where
    p :: Int -> Word64 -> Builder
    p :: Int -> Word64 -> Builder
p Int
shiftN Word64
word = UInt16 -> Builder
word16HexFixed (UInt16 -> Builder) -> UInt16 -> Builder
forall a b. (a -> b) -> a -> b
$ Word64 -> UInt16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
word Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
shiftNInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
16))


-- ** Nullable

{- | ClickHouse Nullable(T) column type
 (type synonym for Maybe)
 -}
type Nullable = Maybe
instance IsChType chType => IsChType (Nullable chType)
  where
  chTypeName :: String
chTypeName = String
"Nullable(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall chType. IsChType chType => String
chTypeName @chType String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  defaultValueOfTypeName :: Nullable chType
defaultValueOfTypeName = Nullable chType
forall a. Maybe a
Nothing

instance
  ToChType inputType chType
  =>
  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 userType.
ToChType chType userType =>
userType -> chType
toChType @inputType @chType)
  fromChType :: Nullable inputType -> Nullable chType
fromChType = (inputType -> chType) -> Nullable inputType -> Nullable chType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall chType userType.
ToChType chType userType =>
chType -> userType
fromChType @inputType)

instance ToQueryPart 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


-- ** Enum8

newtype Enum8 (enums :: Symbol) = MkEnum8 Int8
  deriving newtype (ProtocolRevision -> Get (Enum8 enums)
ProtocolRevision -> Enum8 enums -> Builder
(ProtocolRevision -> Enum8 enums -> Builder)
-> (ProtocolRevision -> Get (Enum8 enums))
-> Serializable (Enum8 enums)
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
forall (enums :: Symbol). ProtocolRevision -> Get (Enum8 enums)
forall (enums :: Symbol).
ProtocolRevision -> Enum8 enums -> Builder
$cserialize :: forall (enums :: Symbol).
ProtocolRevision -> Enum8 enums -> Builder
serialize :: ProtocolRevision -> Enum8 enums -> Builder
$cdeserialize :: forall (enums :: Symbol). ProtocolRevision -> Get (Enum8 enums)
deserialize :: ProtocolRevision -> Get (Enum8 enums)
Serializable, Int -> Enum8 enums -> ShowS
[Enum8 enums] -> ShowS
Enum8 enums -> String
(Int -> Enum8 enums -> ShowS)
-> (Enum8 enums -> String)
-> ([Enum8 enums] -> ShowS)
-> Show (Enum8 enums)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (enums :: Symbol). Int -> Enum8 enums -> ShowS
forall (enums :: Symbol). [Enum8 enums] -> ShowS
forall (enums :: Symbol). Enum8 enums -> String
$cshowsPrec :: forall (enums :: Symbol). Int -> Enum8 enums -> ShowS
showsPrec :: Int -> Enum8 enums -> ShowS
$cshow :: forall (enums :: Symbol). Enum8 enums -> String
show :: Enum8 enums -> String
$cshowList :: forall (enums :: Symbol). [Enum8 enums] -> ShowS
showList :: [Enum8 enums] -> ShowS
Show, Enum8 enums -> Enum8 enums -> Bool
(Enum8 enums -> Enum8 enums -> Bool)
-> (Enum8 enums -> Enum8 enums -> Bool) -> Eq (Enum8 enums)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Bool
$c== :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Bool
== :: Enum8 enums -> Enum8 enums -> Bool
$c/= :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Bool
/= :: Enum8 enums -> Enum8 enums -> Bool
Eq, Integer -> Enum8 enums
Enum8 enums -> Enum8 enums
Enum8 enums -> Enum8 enums -> Enum8 enums
(Enum8 enums -> Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums)
-> (Integer -> Enum8 enums)
-> Num (Enum8 enums)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (enums :: Symbol). Integer -> Enum8 enums
forall (enums :: Symbol). Enum8 enums -> Enum8 enums
forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Enum8 enums
$c+ :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Enum8 enums
+ :: Enum8 enums -> Enum8 enums -> Enum8 enums
$c- :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Enum8 enums
- :: Enum8 enums -> Enum8 enums -> Enum8 enums
$c* :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Enum8 enums
* :: Enum8 enums -> Enum8 enums -> Enum8 enums
$cnegate :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums
negate :: Enum8 enums -> Enum8 enums
$cabs :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums
abs :: Enum8 enums -> Enum8 enums
$csignum :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums
signum :: Enum8 enums -> Enum8 enums
$cfromInteger :: forall (enums :: Symbol). Integer -> Enum8 enums
fromInteger :: Integer -> Enum8 enums
Num, Eq (Enum8 enums)
Enum8 enums
Eq (Enum8 enums) =>
(Enum8 enums -> Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> Enum8 enums
-> (Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Bool)
-> (Enum8 enums -> Maybe Int)
-> (Enum8 enums -> Int)
-> (Enum8 enums -> Bool)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int -> Enum8 enums)
-> (Enum8 enums -> Int)
-> Bits (Enum8 enums)
Int -> Enum8 enums
Enum8 enums -> Bool
Enum8 enums -> Int
Enum8 enums -> Maybe Int
Enum8 enums -> Enum8 enums
Enum8 enums -> Int -> Bool
Enum8 enums -> Int -> Enum8 enums
Enum8 enums -> Enum8 enums -> Enum8 enums
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
forall (enums :: Symbol). Eq (Enum8 enums)
forall (enums :: Symbol). Enum8 enums
forall (enums :: Symbol). Int -> Enum8 enums
forall (enums :: Symbol). Enum8 enums -> Bool
forall (enums :: Symbol). Enum8 enums -> Int
forall (enums :: Symbol). Enum8 enums -> Maybe Int
forall (enums :: Symbol). Enum8 enums -> Enum8 enums
forall (enums :: Symbol). Enum8 enums -> Int -> Bool
forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Enum8 enums
$c.&. :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Enum8 enums
.&. :: Enum8 enums -> Enum8 enums -> Enum8 enums
$c.|. :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Enum8 enums
.|. :: Enum8 enums -> Enum8 enums -> Enum8 enums
$cxor :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums -> Enum8 enums
xor :: Enum8 enums -> Enum8 enums -> Enum8 enums
$ccomplement :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums
complement :: Enum8 enums -> Enum8 enums
$cshift :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
shift :: Enum8 enums -> Int -> Enum8 enums
$crotate :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
rotate :: Enum8 enums -> Int -> Enum8 enums
$czeroBits :: forall (enums :: Symbol). Enum8 enums
zeroBits :: Enum8 enums
$cbit :: forall (enums :: Symbol). Int -> Enum8 enums
bit :: Int -> Enum8 enums
$csetBit :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
setBit :: Enum8 enums -> Int -> Enum8 enums
$cclearBit :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
clearBit :: Enum8 enums -> Int -> Enum8 enums
$ccomplementBit :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
complementBit :: Enum8 enums -> Int -> Enum8 enums
$ctestBit :: forall (enums :: Symbol). Enum8 enums -> Int -> Bool
testBit :: Enum8 enums -> Int -> Bool
$cbitSizeMaybe :: forall (enums :: Symbol). Enum8 enums -> Maybe Int
bitSizeMaybe :: Enum8 enums -> Maybe Int
$cbitSize :: forall (enums :: Symbol). Enum8 enums -> Int
bitSize :: Enum8 enums -> Int
$cisSigned :: forall (enums :: Symbol). Enum8 enums -> Bool
isSigned :: Enum8 enums -> Bool
$cshiftL :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
shiftL :: Enum8 enums -> Int -> Enum8 enums
$cunsafeShiftL :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
unsafeShiftL :: Enum8 enums -> Int -> Enum8 enums
$cshiftR :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
shiftR :: Enum8 enums -> Int -> Enum8 enums
$cunsafeShiftR :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
unsafeShiftR :: Enum8 enums -> Int -> Enum8 enums
$crotateL :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
rotateL :: Enum8 enums -> Int -> Enum8 enums
$crotateR :: forall (enums :: Symbol). Enum8 enums -> Int -> Enum8 enums
rotateR :: Enum8 enums -> Int -> Enum8 enums
$cpopCount :: forall (enums :: Symbol). Enum8 enums -> Int
popCount :: Enum8 enums -> Int
Bits, Enum8 enums
Enum8 enums -> Enum8 enums -> Bounded (Enum8 enums)
forall a. a -> a -> Bounded a
forall (enums :: Symbol). Enum8 enums
$cminBound :: forall (enums :: Symbol). Enum8 enums
minBound :: Enum8 enums
$cmaxBound :: forall (enums :: Symbol). Enum8 enums
maxBound :: Enum8 enums
Bounded, Int -> Enum8 enums
Enum8 enums -> Int
Enum8 enums -> [Enum8 enums]
Enum8 enums -> Enum8 enums
Enum8 enums -> Enum8 enums -> [Enum8 enums]
Enum8 enums -> Enum8 enums -> Enum8 enums -> [Enum8 enums]
(Enum8 enums -> Enum8 enums)
-> (Enum8 enums -> Enum8 enums)
-> (Int -> Enum8 enums)
-> (Enum8 enums -> Int)
-> (Enum8 enums -> [Enum8 enums])
-> (Enum8 enums -> Enum8 enums -> [Enum8 enums])
-> (Enum8 enums -> Enum8 enums -> [Enum8 enums])
-> (Enum8 enums -> Enum8 enums -> Enum8 enums -> [Enum8 enums])
-> Enum (Enum8 enums)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (enums :: Symbol). Int -> Enum8 enums
forall (enums :: Symbol). Enum8 enums -> Int
forall (enums :: Symbol). Enum8 enums -> [Enum8 enums]
forall (enums :: Symbol). Enum8 enums -> Enum8 enums
forall (enums :: Symbol).
Enum8 enums -> Enum8 enums -> [Enum8 enums]
forall (enums :: Symbol).
Enum8 enums -> Enum8 enums -> Enum8 enums -> [Enum8 enums]
$csucc :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums
succ :: Enum8 enums -> Enum8 enums
$cpred :: forall (enums :: Symbol). Enum8 enums -> Enum8 enums
pred :: Enum8 enums -> Enum8 enums
$ctoEnum :: forall (enums :: Symbol). Int -> Enum8 enums
toEnum :: Int -> Enum8 enums
$cfromEnum :: forall (enums :: Symbol). Enum8 enums -> Int
fromEnum :: Enum8 enums -> Int
$cenumFrom :: forall (enums :: Symbol). Enum8 enums -> [Enum8 enums]
enumFrom :: Enum8 enums -> [Enum8 enums]
$cenumFromThen :: forall (enums :: Symbol).
Enum8 enums -> Enum8 enums -> [Enum8 enums]
enumFromThen :: Enum8 enums -> Enum8 enums -> [Enum8 enums]
$cenumFromTo :: forall (enums :: Symbol).
Enum8 enums -> Enum8 enums -> [Enum8 enums]
enumFromTo :: Enum8 enums -> Enum8 enums -> [Enum8 enums]
$cenumFromThenTo :: forall (enums :: Symbol).
Enum8 enums -> Enum8 enums -> Enum8 enums -> [Enum8 enums]
enumFromThenTo :: Enum8 enums -> Enum8 enums -> Enum8 enums -> [Enum8 enums]
Enum)

instance KnownSymbol enums => IsChType (Enum8 enums) where
  chTypeName :: String
chTypeName = String
"Enum8(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @enums Proxy enums
forall {k} (t :: k). Proxy t
Proxy String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  defaultValueOfTypeName :: Enum8 enums
defaultValueOfTypeName = Enum8 enums
0

instance ToChType (Enum8 enums) Int8 where
  toChType :: Int8 -> Enum8 enums
toChType = Int8 -> Enum8 enums
forall (enums :: Symbol). Int8 -> Enum8 enums
MkEnum8
  fromChType :: Enum8 enums -> Int8
fromChType (MkEnum8 Int8
i8)= Int8
i8

instance ToQueryPart (Enum8 enums) where
  toQueryPart :: Enum8 enums -> Builder
toQueryPart = Int8 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart (Int8 -> Builder)
-> (Enum8 enums -> Int8) -> Enum8 enums -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType userType.
ToChType chType userType =>
chType -> userType
fromChType @_ @Int8


-- ** Enum16

newtype Enum16 (enums :: Symbol) = MkEnum16 Int16
  deriving newtype (ProtocolRevision -> Get (Enum16 enums)
ProtocolRevision -> Enum16 enums -> Builder
(ProtocolRevision -> Enum16 enums -> Builder)
-> (ProtocolRevision -> Get (Enum16 enums))
-> Serializable (Enum16 enums)
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
forall (enums :: Symbol). ProtocolRevision -> Get (Enum16 enums)
forall (enums :: Symbol).
ProtocolRevision -> Enum16 enums -> Builder
$cserialize :: forall (enums :: Symbol).
ProtocolRevision -> Enum16 enums -> Builder
serialize :: ProtocolRevision -> Enum16 enums -> Builder
$cdeserialize :: forall (enums :: Symbol). ProtocolRevision -> Get (Enum16 enums)
deserialize :: ProtocolRevision -> Get (Enum16 enums)
Serializable, Int -> Enum16 enums -> ShowS
[Enum16 enums] -> ShowS
Enum16 enums -> String
(Int -> Enum16 enums -> ShowS)
-> (Enum16 enums -> String)
-> ([Enum16 enums] -> ShowS)
-> Show (Enum16 enums)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (enums :: Symbol). Int -> Enum16 enums -> ShowS
forall (enums :: Symbol). [Enum16 enums] -> ShowS
forall (enums :: Symbol). Enum16 enums -> String
$cshowsPrec :: forall (enums :: Symbol). Int -> Enum16 enums -> ShowS
showsPrec :: Int -> Enum16 enums -> ShowS
$cshow :: forall (enums :: Symbol). Enum16 enums -> String
show :: Enum16 enums -> String
$cshowList :: forall (enums :: Symbol). [Enum16 enums] -> ShowS
showList :: [Enum16 enums] -> ShowS
Show, Enum16 enums -> Enum16 enums -> Bool
(Enum16 enums -> Enum16 enums -> Bool)
-> (Enum16 enums -> Enum16 enums -> Bool) -> Eq (Enum16 enums)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (enums :: Symbol). Enum16 enums -> Enum16 enums -> Bool
$c== :: forall (enums :: Symbol). Enum16 enums -> Enum16 enums -> Bool
== :: Enum16 enums -> Enum16 enums -> Bool
$c/= :: forall (enums :: Symbol). Enum16 enums -> Enum16 enums -> Bool
/= :: Enum16 enums -> Enum16 enums -> Bool
Eq, Integer -> Enum16 enums
Enum16 enums -> Enum16 enums
Enum16 enums -> Enum16 enums -> Enum16 enums
(Enum16 enums -> Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums)
-> (Integer -> Enum16 enums)
-> Num (Enum16 enums)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (enums :: Symbol). Integer -> Enum16 enums
forall (enums :: Symbol). Enum16 enums -> Enum16 enums
forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums
$c+ :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums
+ :: Enum16 enums -> Enum16 enums -> Enum16 enums
$c- :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums
- :: Enum16 enums -> Enum16 enums -> Enum16 enums
$c* :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums
* :: Enum16 enums -> Enum16 enums -> Enum16 enums
$cnegate :: forall (enums :: Symbol). Enum16 enums -> Enum16 enums
negate :: Enum16 enums -> Enum16 enums
$cabs :: forall (enums :: Symbol). Enum16 enums -> Enum16 enums
abs :: Enum16 enums -> Enum16 enums
$csignum :: forall (enums :: Symbol). Enum16 enums -> Enum16 enums
signum :: Enum16 enums -> Enum16 enums
$cfromInteger :: forall (enums :: Symbol). Integer -> Enum16 enums
fromInteger :: Integer -> Enum16 enums
Num, Eq (Enum16 enums)
Enum16 enums
Eq (Enum16 enums) =>
(Enum16 enums -> Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> Enum16 enums
-> (Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Bool)
-> (Enum16 enums -> Maybe Int)
-> (Enum16 enums -> Int)
-> (Enum16 enums -> Bool)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int -> Enum16 enums)
-> (Enum16 enums -> Int)
-> Bits (Enum16 enums)
Int -> Enum16 enums
Enum16 enums -> Bool
Enum16 enums -> Int
Enum16 enums -> Maybe Int
Enum16 enums -> Enum16 enums
Enum16 enums -> Int -> Bool
Enum16 enums -> Int -> Enum16 enums
Enum16 enums -> Enum16 enums -> Enum16 enums
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
forall (enums :: Symbol). Eq (Enum16 enums)
forall (enums :: Symbol). Enum16 enums
forall (enums :: Symbol). Int -> Enum16 enums
forall (enums :: Symbol). Enum16 enums -> Bool
forall (enums :: Symbol). Enum16 enums -> Int
forall (enums :: Symbol). Enum16 enums -> Maybe Int
forall (enums :: Symbol). Enum16 enums -> Enum16 enums
forall (enums :: Symbol). Enum16 enums -> Int -> Bool
forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums
$c.&. :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums
.&. :: Enum16 enums -> Enum16 enums -> Enum16 enums
$c.|. :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums
.|. :: Enum16 enums -> Enum16 enums -> Enum16 enums
$cxor :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums
xor :: Enum16 enums -> Enum16 enums -> Enum16 enums
$ccomplement :: forall (enums :: Symbol). Enum16 enums -> Enum16 enums
complement :: Enum16 enums -> Enum16 enums
$cshift :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
shift :: Enum16 enums -> Int -> Enum16 enums
$crotate :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
rotate :: Enum16 enums -> Int -> Enum16 enums
$czeroBits :: forall (enums :: Symbol). Enum16 enums
zeroBits :: Enum16 enums
$cbit :: forall (enums :: Symbol). Int -> Enum16 enums
bit :: Int -> Enum16 enums
$csetBit :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
setBit :: Enum16 enums -> Int -> Enum16 enums
$cclearBit :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
clearBit :: Enum16 enums -> Int -> Enum16 enums
$ccomplementBit :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
complementBit :: Enum16 enums -> Int -> Enum16 enums
$ctestBit :: forall (enums :: Symbol). Enum16 enums -> Int -> Bool
testBit :: Enum16 enums -> Int -> Bool
$cbitSizeMaybe :: forall (enums :: Symbol). Enum16 enums -> Maybe Int
bitSizeMaybe :: Enum16 enums -> Maybe Int
$cbitSize :: forall (enums :: Symbol). Enum16 enums -> Int
bitSize :: Enum16 enums -> Int
$cisSigned :: forall (enums :: Symbol). Enum16 enums -> Bool
isSigned :: Enum16 enums -> Bool
$cshiftL :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
shiftL :: Enum16 enums -> Int -> Enum16 enums
$cunsafeShiftL :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
unsafeShiftL :: Enum16 enums -> Int -> Enum16 enums
$cshiftR :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
shiftR :: Enum16 enums -> Int -> Enum16 enums
$cunsafeShiftR :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
unsafeShiftR :: Enum16 enums -> Int -> Enum16 enums
$crotateL :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
rotateL :: Enum16 enums -> Int -> Enum16 enums
$crotateR :: forall (enums :: Symbol). Enum16 enums -> Int -> Enum16 enums
rotateR :: Enum16 enums -> Int -> Enum16 enums
$cpopCount :: forall (enums :: Symbol). Enum16 enums -> Int
popCount :: Enum16 enums -> Int
Bits, Enum16 enums
Enum16 enums -> Enum16 enums -> Bounded (Enum16 enums)
forall a. a -> a -> Bounded a
forall (enums :: Symbol). Enum16 enums
$cminBound :: forall (enums :: Symbol). Enum16 enums
minBound :: Enum16 enums
$cmaxBound :: forall (enums :: Symbol). Enum16 enums
maxBound :: Enum16 enums
Bounded, Int -> Enum16 enums
Enum16 enums -> Int
Enum16 enums -> [Enum16 enums]
Enum16 enums -> Enum16 enums
Enum16 enums -> Enum16 enums -> [Enum16 enums]
Enum16 enums -> Enum16 enums -> Enum16 enums -> [Enum16 enums]
(Enum16 enums -> Enum16 enums)
-> (Enum16 enums -> Enum16 enums)
-> (Int -> Enum16 enums)
-> (Enum16 enums -> Int)
-> (Enum16 enums -> [Enum16 enums])
-> (Enum16 enums -> Enum16 enums -> [Enum16 enums])
-> (Enum16 enums -> Enum16 enums -> [Enum16 enums])
-> (Enum16 enums -> Enum16 enums -> Enum16 enums -> [Enum16 enums])
-> Enum (Enum16 enums)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (enums :: Symbol). Int -> Enum16 enums
forall (enums :: Symbol). Enum16 enums -> Int
forall (enums :: Symbol). Enum16 enums -> [Enum16 enums]
forall (enums :: Symbol). Enum16 enums -> Enum16 enums
forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> [Enum16 enums]
forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums -> [Enum16 enums]
$csucc :: forall (enums :: Symbol). Enum16 enums -> Enum16 enums
succ :: Enum16 enums -> Enum16 enums
$cpred :: forall (enums :: Symbol). Enum16 enums -> Enum16 enums
pred :: Enum16 enums -> Enum16 enums
$ctoEnum :: forall (enums :: Symbol). Int -> Enum16 enums
toEnum :: Int -> Enum16 enums
$cfromEnum :: forall (enums :: Symbol). Enum16 enums -> Int
fromEnum :: Enum16 enums -> Int
$cenumFrom :: forall (enums :: Symbol). Enum16 enums -> [Enum16 enums]
enumFrom :: Enum16 enums -> [Enum16 enums]
$cenumFromThen :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> [Enum16 enums]
enumFromThen :: Enum16 enums -> Enum16 enums -> [Enum16 enums]
$cenumFromTo :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> [Enum16 enums]
enumFromTo :: Enum16 enums -> Enum16 enums -> [Enum16 enums]
$cenumFromThenTo :: forall (enums :: Symbol).
Enum16 enums -> Enum16 enums -> Enum16 enums -> [Enum16 enums]
enumFromThenTo :: Enum16 enums -> Enum16 enums -> Enum16 enums -> [Enum16 enums]
Enum)

instance KnownSymbol enums => IsChType (Enum16 enums) where
  chTypeName :: String
chTypeName = String
"Enum16(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @enums Proxy enums
forall {k} (t :: k). Proxy t
Proxy String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  defaultValueOfTypeName :: Enum16 enums
defaultValueOfTypeName = Enum16 enums
0

instance ToChType (Enum16 enums) Int16 where
  toChType :: Int16 -> Enum16 enums
toChType = Int16 -> Enum16 enums
forall (enums :: Symbol). Int16 -> Enum16 enums
MkEnum16
  fromChType :: Enum16 enums -> Int16
fromChType (MkEnum16 Int16
i16) = Int16
i16

instance ToQueryPart (Enum16 enums) where
  toQueryPart :: Enum16 enums -> Builder
toQueryPart = Int16 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart (Int16 -> Builder)
-> (Enum16 enums -> Int16) -> Enum16 enums -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType userType.
ToChType chType userType =>
chType -> userType
fromChType @_ @Int16


-- ** Bool

instance IsChType Bool where
  chTypeName :: String
chTypeName = String
"Bool"
  defaultValueOfTypeName :: Bool
defaultValueOfTypeName = Bool
False

instance Serializable Bool where
  serialize :: ProtocolRevision -> Bool -> Builder
serialize ProtocolRevision
_ = Int8 -> Builder
int8 (Int8 -> Builder) -> (Bool -> Int8) -> Bool -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int8 -> Bool -> Int8
forall a. a -> a -> Bool -> a
bool Int8
0 Int8
1
  deserialize :: ProtocolRevision -> Get Bool
deserialize ProtocolRevision
_ = (\Int8
int -> case Int8
int of Int8
0->Bool
False; Int8
_->Bool
True) (Int8 -> Bool) -> Get Int8 -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
  {-# INLINE deserialize #-}

instance ToQueryPart Bool where
  toQueryPart :: Bool -> Builder
toQueryPart = Builder -> Builder -> Bool -> Builder
forall a. a -> a -> Bool -> a
bool Builder
"false" Builder
"true"


-- ** DateTime

{- |
ClickHouse DateTime column type (parametrized with timezone)

>>> chTypeName @(DateTime "")
"DateTime"
>>> chTypeName @(DateTime "UTC")
"DateTime('UTC')"

__Note:__ 'DateTime' stores whole seconds only, so converting from 'UTCTime' \
will drop any sub-second precision.

>>> let myUtcTime = posixSecondsToUTCTime 0.042_042
>>> toChType @(DateTime "") @UTCTime myUtcTime
0
-}
newtype DateTime (tz :: Symbol) = MkDateTime Word32
  deriving newtype (Int -> DateTime tz -> ShowS
[DateTime tz] -> ShowS
DateTime tz -> String
(Int -> DateTime tz -> ShowS)
-> (DateTime tz -> String)
-> ([DateTime tz] -> ShowS)
-> Show (DateTime tz)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (tz :: Symbol). Int -> DateTime tz -> ShowS
forall (tz :: Symbol). [DateTime tz] -> ShowS
forall (tz :: Symbol). DateTime tz -> String
$cshowsPrec :: forall (tz :: Symbol). Int -> DateTime tz -> ShowS
showsPrec :: Int -> DateTime tz -> ShowS
$cshow :: forall (tz :: Symbol). DateTime tz -> String
show :: DateTime tz -> String
$cshowList :: forall (tz :: Symbol). [DateTime tz] -> ShowS
showList :: [DateTime tz] -> ShowS
Show, DateTime tz -> DateTime tz -> Bool
(DateTime tz -> DateTime tz -> Bool)
-> (DateTime tz -> DateTime tz -> Bool) -> Eq (DateTime tz)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (tz :: Symbol). DateTime tz -> DateTime tz -> Bool
$c== :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> Bool
== :: DateTime tz -> DateTime tz -> Bool
$c/= :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> Bool
/= :: DateTime tz -> DateTime tz -> Bool
Eq, Integer -> DateTime tz
DateTime tz -> DateTime tz
DateTime tz -> DateTime tz -> DateTime tz
(DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz)
-> (Integer -> DateTime tz)
-> Num (DateTime tz)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (tz :: Symbol). Integer -> DateTime tz
forall (tz :: Symbol). DateTime tz -> DateTime tz
forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
$c+ :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
+ :: DateTime tz -> DateTime tz -> DateTime tz
$c- :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
- :: DateTime tz -> DateTime tz -> DateTime tz
$c* :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
* :: DateTime tz -> DateTime tz -> DateTime tz
$cnegate :: forall (tz :: Symbol). DateTime tz -> DateTime tz
negate :: DateTime tz -> DateTime tz
$cabs :: forall (tz :: Symbol). DateTime tz -> DateTime tz
abs :: DateTime tz -> DateTime tz
$csignum :: forall (tz :: Symbol). DateTime tz -> DateTime tz
signum :: DateTime tz -> DateTime tz
$cfromInteger :: forall (tz :: Symbol). Integer -> DateTime tz
fromInteger :: Integer -> DateTime tz
Num, Eq (DateTime tz)
DateTime tz
Eq (DateTime tz) =>
(DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> DateTime tz
-> (Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> Bool)
-> (DateTime tz -> Maybe Int)
-> (DateTime tz -> Int)
-> (DateTime tz -> Bool)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int -> DateTime tz)
-> (DateTime tz -> Int)
-> Bits (DateTime tz)
Int -> DateTime tz
DateTime tz -> Bool
DateTime tz -> Int
DateTime tz -> Maybe Int
DateTime tz -> DateTime tz
DateTime tz -> Int -> Bool
DateTime tz -> Int -> DateTime tz
DateTime tz -> DateTime tz -> DateTime tz
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
forall (tz :: Symbol). Eq (DateTime tz)
forall (tz :: Symbol). DateTime tz
forall (tz :: Symbol). Int -> DateTime tz
forall (tz :: Symbol). DateTime tz -> Bool
forall (tz :: Symbol). DateTime tz -> Int
forall (tz :: Symbol). DateTime tz -> Maybe Int
forall (tz :: Symbol). DateTime tz -> DateTime tz
forall (tz :: Symbol). DateTime tz -> Int -> Bool
forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
$c.&. :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
.&. :: DateTime tz -> DateTime tz -> DateTime tz
$c.|. :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
.|. :: DateTime tz -> DateTime tz -> DateTime tz
$cxor :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
xor :: DateTime tz -> DateTime tz -> DateTime tz
$ccomplement :: forall (tz :: Symbol). DateTime tz -> DateTime tz
complement :: DateTime tz -> DateTime tz
$cshift :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
shift :: DateTime tz -> Int -> DateTime tz
$crotate :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
rotate :: DateTime tz -> Int -> DateTime tz
$czeroBits :: forall (tz :: Symbol). DateTime tz
zeroBits :: DateTime tz
$cbit :: forall (tz :: Symbol). Int -> DateTime tz
bit :: Int -> DateTime tz
$csetBit :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
setBit :: DateTime tz -> Int -> DateTime tz
$cclearBit :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
clearBit :: DateTime tz -> Int -> DateTime tz
$ccomplementBit :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
complementBit :: DateTime tz -> Int -> DateTime tz
$ctestBit :: forall (tz :: Symbol). DateTime tz -> Int -> Bool
testBit :: DateTime tz -> Int -> Bool
$cbitSizeMaybe :: forall (tz :: Symbol). DateTime tz -> Maybe Int
bitSizeMaybe :: DateTime tz -> Maybe Int
$cbitSize :: forall (tz :: Symbol). DateTime tz -> Int
bitSize :: DateTime tz -> Int
$cisSigned :: forall (tz :: Symbol). DateTime tz -> Bool
isSigned :: DateTime tz -> Bool
$cshiftL :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
shiftL :: DateTime tz -> Int -> DateTime tz
$cunsafeShiftL :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
unsafeShiftL :: DateTime tz -> Int -> DateTime tz
$cshiftR :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
shiftR :: DateTime tz -> Int -> DateTime tz
$cunsafeShiftR :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
unsafeShiftR :: DateTime tz -> Int -> DateTime tz
$crotateL :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
rotateL :: DateTime tz -> Int -> DateTime tz
$crotateR :: forall (tz :: Symbol). DateTime tz -> Int -> DateTime tz
rotateR :: DateTime tz -> Int -> DateTime tz
$cpopCount :: forall (tz :: Symbol). DateTime tz -> Int
popCount :: DateTime tz -> Int
Bits, Int -> DateTime tz
DateTime tz -> Int
DateTime tz -> [DateTime tz]
DateTime tz -> DateTime tz
DateTime tz -> DateTime tz -> [DateTime tz]
DateTime tz -> DateTime tz -> DateTime tz -> [DateTime tz]
(DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz)
-> (Int -> DateTime tz)
-> (DateTime tz -> Int)
-> (DateTime tz -> [DateTime tz])
-> (DateTime tz -> DateTime tz -> [DateTime tz])
-> (DateTime tz -> DateTime tz -> [DateTime tz])
-> (DateTime tz -> DateTime tz -> DateTime tz -> [DateTime tz])
-> Enum (DateTime tz)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (tz :: Symbol). Int -> DateTime tz
forall (tz :: Symbol). DateTime tz -> Int
forall (tz :: Symbol). DateTime tz -> [DateTime tz]
forall (tz :: Symbol). DateTime tz -> DateTime tz
forall (tz :: Symbol). DateTime tz -> DateTime tz -> [DateTime tz]
forall (tz :: Symbol).
DateTime tz -> DateTime tz -> DateTime tz -> [DateTime tz]
$csucc :: forall (tz :: Symbol). DateTime tz -> DateTime tz
succ :: DateTime tz -> DateTime tz
$cpred :: forall (tz :: Symbol). DateTime tz -> DateTime tz
pred :: DateTime tz -> DateTime tz
$ctoEnum :: forall (tz :: Symbol). Int -> DateTime tz
toEnum :: Int -> DateTime tz
$cfromEnum :: forall (tz :: Symbol). DateTime tz -> Int
fromEnum :: DateTime tz -> Int
$cenumFrom :: forall (tz :: Symbol). DateTime tz -> [DateTime tz]
enumFrom :: DateTime tz -> [DateTime tz]
$cenumFromThen :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> [DateTime tz]
enumFromThen :: DateTime tz -> DateTime tz -> [DateTime tz]
$cenumFromTo :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> [DateTime tz]
enumFromTo :: DateTime tz -> DateTime tz -> [DateTime tz]
$cenumFromThenTo :: forall (tz :: Symbol).
DateTime tz -> DateTime tz -> DateTime tz -> [DateTime tz]
enumFromThenTo :: DateTime tz -> DateTime tz -> DateTime tz -> [DateTime tz]
Enum, Eq (DateTime tz)
Eq (DateTime tz) =>
(DateTime tz -> DateTime tz -> Ordering)
-> (DateTime tz -> DateTime tz -> Bool)
-> (DateTime tz -> DateTime tz -> Bool)
-> (DateTime tz -> DateTime tz -> Bool)
-> (DateTime tz -> DateTime tz -> Bool)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> Ord (DateTime tz)
DateTime tz -> DateTime tz -> Bool
DateTime tz -> DateTime tz -> Ordering
DateTime tz -> DateTime tz -> DateTime tz
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
forall (tz :: Symbol). Eq (DateTime tz)
forall (tz :: Symbol). DateTime tz -> DateTime tz -> Bool
forall (tz :: Symbol). DateTime tz -> DateTime tz -> Ordering
forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
$ccompare :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> Ordering
compare :: DateTime tz -> DateTime tz -> Ordering
$c< :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> Bool
< :: DateTime tz -> DateTime tz -> Bool
$c<= :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> Bool
<= :: DateTime tz -> DateTime tz -> Bool
$c> :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> Bool
> :: DateTime tz -> DateTime tz -> Bool
$c>= :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> Bool
>= :: DateTime tz -> DateTime tz -> Bool
$cmax :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
max :: DateTime tz -> DateTime tz -> DateTime tz
$cmin :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
min :: DateTime tz -> DateTime tz -> DateTime tz
Ord, Num (DateTime tz)
Ord (DateTime tz)
(Num (DateTime tz), Ord (DateTime tz)) =>
(DateTime tz -> Rational) -> Real (DateTime tz)
DateTime tz -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
forall (tz :: Symbol). Num (DateTime tz)
forall (tz :: Symbol). Ord (DateTime tz)
forall (tz :: Symbol). DateTime tz -> Rational
$ctoRational :: forall (tz :: Symbol). DateTime tz -> Rational
toRational :: DateTime tz -> Rational
Real, Enum (DateTime tz)
Real (DateTime tz)
(Real (DateTime tz), Enum (DateTime tz)) =>
(DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> DateTime tz)
-> (DateTime tz -> DateTime tz -> (DateTime tz, DateTime tz))
-> (DateTime tz -> DateTime tz -> (DateTime tz, DateTime tz))
-> (DateTime tz -> Integer)
-> Integral (DateTime tz)
DateTime tz -> Integer
DateTime tz -> DateTime tz -> (DateTime tz, DateTime tz)
DateTime tz -> DateTime tz -> DateTime tz
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
forall (tz :: Symbol). Enum (DateTime tz)
forall (tz :: Symbol). Real (DateTime tz)
forall (tz :: Symbol). DateTime tz -> Integer
forall (tz :: Symbol).
DateTime tz -> DateTime tz -> (DateTime tz, DateTime tz)
forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
$cquot :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
quot :: DateTime tz -> DateTime tz -> DateTime tz
$crem :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
rem :: DateTime tz -> DateTime tz -> DateTime tz
$cdiv :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
div :: DateTime tz -> DateTime tz -> DateTime tz
$cmod :: forall (tz :: Symbol). DateTime tz -> DateTime tz -> DateTime tz
mod :: DateTime tz -> DateTime tz -> DateTime tz
$cquotRem :: forall (tz :: Symbol).
DateTime tz -> DateTime tz -> (DateTime tz, DateTime tz)
quotRem :: DateTime tz -> DateTime tz -> (DateTime tz, DateTime tz)
$cdivMod :: forall (tz :: Symbol).
DateTime tz -> DateTime tz -> (DateTime tz, DateTime tz)
divMod :: DateTime tz -> DateTime tz -> (DateTime tz, DateTime tz)
$ctoInteger :: forall (tz :: Symbol). DateTime tz -> Integer
toInteger :: DateTime tz -> Integer
Integral, DateTime tz
DateTime tz -> DateTime tz -> Bounded (DateTime tz)
forall a. a -> a -> Bounded a
forall (tz :: Symbol). DateTime tz
$cminBound :: forall (tz :: Symbol). DateTime tz
minBound :: DateTime tz
$cmaxBound :: forall (tz :: Symbol). DateTime tz
maxBound :: DateTime tz
Bounded, DateTime tz -> ()
(DateTime tz -> ()) -> NFData (DateTime tz)
forall a. (a -> ()) -> NFData a
forall (tz :: Symbol). DateTime tz -> ()
$crnf :: forall (tz :: Symbol). DateTime tz -> ()
rnf :: DateTime tz -> ()
NFData)

instance KnownSymbol tz => IsChType (DateTime tz)
  where
  chTypeName :: String
chTypeName = case forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @tz Proxy tz
forall {k} (t :: k). Proxy t
Proxy of
    String
"" -> String
"DateTime"
    String
tz -> String
"DateTime('" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tz String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"')"
  defaultValueOfTypeName :: DateTime tz
defaultValueOfTypeName = UInt32 -> DateTime tz
forall (tz :: Symbol). UInt32 -> DateTime tz
MkDateTime UInt32
0

instance Serializable (DateTime tz) where
  serialize :: ProtocolRevision -> DateTime tz -> Builder
serialize ProtocolRevision
_ (MkDateTime UInt32
w32) = UInt32 -> Builder
word32LE UInt32
w32
  deserialize :: ProtocolRevision -> Get (DateTime tz)
deserialize ProtocolRevision
_ = UInt32 -> DateTime tz
forall (tz :: Symbol). UInt32 -> DateTime tz
MkDateTime (UInt32 -> DateTime tz) -> Get UInt32 -> Get (DateTime tz)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get UInt32
getWord32le
  {-# INLINE deserialize #-}

instance ToChType (DateTime tz) Word32     where
  toChType :: UInt32 -> DateTime tz
toChType = UInt32 -> DateTime tz
forall (tz :: Symbol). UInt32 -> DateTime tz
MkDateTime
  fromChType :: DateTime tz -> UInt32
fromChType (MkDateTime UInt32
w32)= UInt32
w32

instance ToChType (DateTime tz) UTCTime    where
  toChType :: UTCTime -> DateTime tz
toChType = UInt32 -> DateTime tz
forall (tz :: Symbol). UInt32 -> DateTime tz
MkDateTime (UInt32 -> DateTime tz)
-> (UTCTime -> UInt32) -> UTCTime -> DateTime tz
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UInt32
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> UInt32)
-> (UTCTime -> POSIXTime) -> UTCTime -> UInt32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
  fromChType :: DateTime tz -> UTCTime
fromChType (MkDateTime UInt32
w32) = POSIXTime -> UTCTime
posixSecondsToUTCTime (UInt32 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt32
w32)

instance ToQueryPart (DateTime tz)
  where
  toQueryPart :: DateTime tz -> Builder
toQueryPart DateTime tz
chDateTime = let time :: StrictByteString
time = String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (DateTime tz -> String) -> DateTime tz -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt32 -> String
forall a. Show a => a -> String
show (UInt32 -> String)
-> (DateTime tz -> UInt32) -> DateTime tz -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(DateTime tz) @Word32 (DateTime tz -> StrictByteString)
-> DateTime tz -> StrictByteString
forall a b. (a -> b) -> a -> b
$ DateTime tz
chDateTime
    in StrictByteString -> Builder
byteString (Int -> Char -> StrictByteString
BS8.replicate (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- StrictByteString -> Int
BS8.length StrictByteString
time) Char
'0' StrictByteString -> StrictByteString -> StrictByteString
forall a. Semigroup a => a -> a -> a
<> StrictByteString
time)


-- ** DateTime64

{- |
ClickHouse DateTime64 column type (parametrized with timezone)

>>> chTypeName @(DateTime64 3 "")
"DateTime64(3)"
>>> chTypeName @(DateTime64 3 "UTC")
"DateTime64(3, 'UTC')"

__Note:__ conversion from 'UTCTime' may lose sub-second precision if \
the @precision@ parameter is lower than the actual timestamp precision.

>>> let myUtcTime = posixSecondsToUTCTime 42.000_000_042
>>> toChType @(DateTime64 6 "") @UTCTime myUtcTime
42000000
>>> toChType @(DateTime64 9 "") @UTCTime myUtcTime
42000000042
-}
newtype DateTime64 (precision :: Nat) (tz :: Symbol) = MkDateTime64 Word64
  deriving newtype (Int -> DateTime64 precision tz -> ShowS
[DateTime64 precision tz] -> ShowS
DateTime64 precision tz -> String
(Int -> DateTime64 precision tz -> ShowS)
-> (DateTime64 precision tz -> String)
-> ([DateTime64 precision tz] -> ShowS)
-> Show (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
Int -> DateTime64 precision tz -> ShowS
forall (precision :: Nat) (tz :: Symbol).
[DateTime64 precision tz] -> ShowS
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (precision :: Nat) (tz :: Symbol).
Int -> DateTime64 precision tz -> ShowS
showsPrec :: Int -> DateTime64 precision tz -> ShowS
$cshow :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> String
show :: DateTime64 precision tz -> String
$cshowList :: forall (precision :: Nat) (tz :: Symbol).
[DateTime64 precision tz] -> ShowS
showList :: [DateTime64 precision tz] -> ShowS
Show, DateTime64 precision tz -> DateTime64 precision tz -> Bool
(DateTime64 precision tz -> DateTime64 precision tz -> Bool)
-> (DateTime64 precision tz -> DateTime64 precision tz -> Bool)
-> Eq (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Bool
== :: DateTime64 precision tz -> DateTime64 precision tz -> Bool
$c/= :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Bool
/= :: DateTime64 precision tz -> DateTime64 precision tz -> Bool
Eq, Integer -> DateTime64 precision tz
DateTime64 precision tz -> DateTime64 precision tz
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
(DateTime64 precision tz
 -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz -> DateTime64 precision tz)
-> (Integer -> DateTime64 precision tz)
-> Num (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
Integer -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
+ :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$c- :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
- :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$c* :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
* :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$cnegate :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
negate :: DateTime64 precision tz -> DateTime64 precision tz
$cabs :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
abs :: DateTime64 precision tz -> DateTime64 precision tz
$csignum :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
signum :: DateTime64 precision tz -> DateTime64 precision tz
$cfromInteger :: forall (precision :: Nat) (tz :: Symbol).
Integer -> DateTime64 precision tz
fromInteger :: Integer -> DateTime64 precision tz
Num, Eq (DateTime64 precision tz)
DateTime64 precision tz
Eq (DateTime64 precision tz) =>
(DateTime64 precision tz
 -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> DateTime64 precision tz
-> (Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> Bool)
-> (DateTime64 precision tz -> Maybe Int)
-> (DateTime64 precision tz -> Int)
-> (DateTime64 precision tz -> Bool)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int)
-> Bits (DateTime64 precision tz)
Int -> DateTime64 precision tz
DateTime64 precision tz -> Bool
DateTime64 precision tz -> Int
DateTime64 precision tz -> Maybe Int
DateTime64 precision tz -> DateTime64 precision tz
DateTime64 precision tz -> Int -> Bool
DateTime64 precision tz -> Int -> DateTime64 precision tz
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
Eq (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol). DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
Int -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Bool
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Maybe Int
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> Bool
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
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.&. :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
.&. :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$c.|. :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
.|. :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$cxor :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
xor :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$ccomplement :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
complement :: DateTime64 precision tz -> DateTime64 precision tz
$cshift :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
shift :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$crotate :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
rotate :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$czeroBits :: forall (precision :: Nat) (tz :: Symbol). DateTime64 precision tz
zeroBits :: DateTime64 precision tz
$cbit :: forall (precision :: Nat) (tz :: Symbol).
Int -> DateTime64 precision tz
bit :: Int -> DateTime64 precision tz
$csetBit :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
setBit :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$cclearBit :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
clearBit :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$ccomplementBit :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
complementBit :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$ctestBit :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> Bool
testBit :: DateTime64 precision tz -> Int -> Bool
$cbitSizeMaybe :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Maybe Int
bitSizeMaybe :: DateTime64 precision tz -> Maybe Int
$cbitSize :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int
bitSize :: DateTime64 precision tz -> Int
$cisSigned :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Bool
isSigned :: DateTime64 precision tz -> Bool
$cshiftL :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
shiftL :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$cunsafeShiftL :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
unsafeShiftL :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$cshiftR :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
shiftR :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$cunsafeShiftR :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
unsafeShiftR :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$crotateL :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
rotateL :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$crotateR :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int -> DateTime64 precision tz
rotateR :: DateTime64 precision tz -> Int -> DateTime64 precision tz
$cpopCount :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int
popCount :: DateTime64 precision tz -> Int
Bits, Int -> DateTime64 precision tz
DateTime64 precision tz -> Int
DateTime64 precision tz -> [DateTime64 precision tz]
DateTime64 precision tz -> DateTime64 precision tz
DateTime64 precision tz
-> DateTime64 precision tz -> [DateTime64 precision tz]
DateTime64 precision tz
-> DateTime64 precision tz
-> DateTime64 precision tz
-> [DateTime64 precision tz]
(DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz -> DateTime64 precision tz)
-> (Int -> DateTime64 precision tz)
-> (DateTime64 precision tz -> Int)
-> (DateTime64 precision tz -> [DateTime64 precision tz])
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> [DateTime64 precision tz])
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> [DateTime64 precision tz])
-> (DateTime64 precision tz
    -> DateTime64 precision tz
    -> DateTime64 precision tz
    -> [DateTime64 precision tz])
-> Enum (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
Int -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> [DateTime64 precision tz]
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> [DateTime64 precision tz]
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz
-> DateTime64 precision tz
-> [DateTime64 precision tz]
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 :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
succ :: DateTime64 precision tz -> DateTime64 precision tz
$cpred :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz
pred :: DateTime64 precision tz -> DateTime64 precision tz
$ctoEnum :: forall (precision :: Nat) (tz :: Symbol).
Int -> DateTime64 precision tz
toEnum :: Int -> DateTime64 precision tz
$cfromEnum :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Int
fromEnum :: DateTime64 precision tz -> Int
$cenumFrom :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> [DateTime64 precision tz]
enumFrom :: DateTime64 precision tz -> [DateTime64 precision tz]
$cenumFromThen :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> [DateTime64 precision tz]
enumFromThen :: DateTime64 precision tz
-> DateTime64 precision tz -> [DateTime64 precision tz]
$cenumFromTo :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> [DateTime64 precision tz]
enumFromTo :: DateTime64 precision tz
-> DateTime64 precision tz -> [DateTime64 precision tz]
$cenumFromThenTo :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz
-> DateTime64 precision tz
-> [DateTime64 precision tz]
enumFromThenTo :: DateTime64 precision tz
-> DateTime64 precision tz
-> DateTime64 precision tz
-> [DateTime64 precision tz]
Enum, Eq (DateTime64 precision tz)
Eq (DateTime64 precision tz) =>
(DateTime64 precision tz -> DateTime64 precision tz -> Ordering)
-> (DateTime64 precision tz -> DateTime64 precision tz -> Bool)
-> (DateTime64 precision tz -> DateTime64 precision tz -> Bool)
-> (DateTime64 precision tz -> DateTime64 precision tz -> Bool)
-> (DateTime64 precision tz -> DateTime64 precision tz -> Bool)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> Ord (DateTime64 precision tz)
DateTime64 precision tz -> DateTime64 precision tz -> Bool
DateTime64 precision tz -> DateTime64 precision tz -> Ordering
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
Eq (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Bool
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Ordering
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
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 :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Ordering
compare :: DateTime64 precision tz -> DateTime64 precision tz -> Ordering
$c< :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Bool
< :: DateTime64 precision tz -> DateTime64 precision tz -> Bool
$c<= :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Bool
<= :: DateTime64 precision tz -> DateTime64 precision tz -> Bool
$c> :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Bool
> :: DateTime64 precision tz -> DateTime64 precision tz -> Bool
$c>= :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> DateTime64 precision tz -> Bool
>= :: DateTime64 precision tz -> DateTime64 precision tz -> Bool
$cmax :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
max :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$cmin :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
min :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
Ord, Num (DateTime64 precision tz)
Ord (DateTime64 precision tz)
(Num (DateTime64 precision tz), Ord (DateTime64 precision tz)) =>
(DateTime64 precision tz -> Rational)
-> Real (DateTime64 precision tz)
DateTime64 precision tz -> Rational
forall (precision :: Nat) (tz :: Symbol).
Num (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
Ord (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Rational
toRational :: DateTime64 precision tz -> Rational
Real, Enum (DateTime64 precision tz)
Real (DateTime64 precision tz)
(Real (DateTime64 precision tz), Enum (DateTime64 precision tz)) =>
(DateTime64 precision tz
 -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz -> DateTime64 precision tz)
-> (DateTime64 precision tz
    -> DateTime64 precision tz
    -> (DateTime64 precision tz, DateTime64 precision tz))
-> (DateTime64 precision tz
    -> DateTime64 precision tz
    -> (DateTime64 precision tz, DateTime64 precision tz))
-> (DateTime64 precision tz -> Integer)
-> Integral (DateTime64 precision tz)
DateTime64 precision tz -> Integer
DateTime64 precision tz
-> DateTime64 precision tz
-> (DateTime64 precision tz, DateTime64 precision tz)
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
Enum (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
Real (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Integer
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz
-> (DateTime64 precision tz, DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
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 :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
quot :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$crem :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
rem :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$cdiv :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
div :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$cmod :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
mod :: DateTime64 precision tz
-> DateTime64 precision tz -> DateTime64 precision tz
$cquotRem :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz
-> (DateTime64 precision tz, DateTime64 precision tz)
quotRem :: DateTime64 precision tz
-> DateTime64 precision tz
-> (DateTime64 precision tz, DateTime64 precision tz)
$cdivMod :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz
-> DateTime64 precision tz
-> (DateTime64 precision tz, DateTime64 precision tz)
divMod :: DateTime64 precision tz
-> DateTime64 precision tz
-> (DateTime64 precision tz, DateTime64 precision tz)
$ctoInteger :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> Integer
toInteger :: DateTime64 precision tz -> Integer
Integral, DateTime64 precision tz
DateTime64 precision tz
-> DateTime64 precision tz -> Bounded (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol). DateTime64 precision tz
forall a. a -> a -> Bounded a
$cminBound :: forall (precision :: Nat) (tz :: Symbol). DateTime64 precision tz
minBound :: DateTime64 precision tz
$cmaxBound :: forall (precision :: Nat) (tz :: Symbol). DateTime64 precision tz
maxBound :: DateTime64 precision tz
Bounded, DateTime64 precision tz -> ()
(DateTime64 precision tz -> ()) -> NFData (DateTime64 precision tz)
forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall (precision :: Nat) (tz :: Symbol).
DateTime64 precision tz -> ()
rnf :: DateTime64 precision tz -> ()
NFData)

instance
  (KnownSymbol tz, KnownNat precision)
  =>
  IsChType (DateTime64 precision tz)
  where
  chTypeName :: String
chTypeName =
    let
      prec :: String
prec = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal @precision Proxy precision
forall {k} (t :: k). Proxy t
Proxy)
    in
    case forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @tz Proxy tz
forall {k} (t :: k). Proxy t
Proxy of
      String
"" -> String
"DateTime64(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
prec String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
      String
tz -> String
"DateTime64(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
prec String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tz String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"')"
  defaultValueOfTypeName :: DateTime64 precision tz
defaultValueOfTypeName = Word64 -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
Word64 -> DateTime64 precision tz
MkDateTime64 Word64
0

instance Serializable (DateTime64 precision tz) where
  serialize :: ProtocolRevision -> DateTime64 precision tz -> Builder
serialize ProtocolRevision
_ (MkDateTime64 Word64
w64) = Word64 -> Builder
word64LE Word64
w64
  deserialize :: ProtocolRevision -> Get (DateTime64 precision tz)
deserialize ProtocolRevision
_ = Word64 -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
Word64 -> DateTime64 precision tz
MkDateTime64 (Word64 -> DateTime64 precision tz)
-> Get Word64 -> Get (DateTime64 precision tz)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
  {-# INLINE deserialize #-}

instance ToChType (DateTime64 precision tz) Word64 where
  toChType :: Word64 -> DateTime64 precision tz
toChType = Word64 -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
Word64 -> DateTime64 precision tz
MkDateTime64
  fromChType :: DateTime64 precision tz -> Word64
fromChType (MkDateTime64 Word64
w64) = Word64
w64

instance KnownNat precision => ToChType (DateTime64 precision tz) UTCTime where
  toChType :: UTCTime -> DateTime64 precision tz
toChType = Word64 -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
Word64 -> DateTime64 precision tz
MkDateTime64 (Word64 -> DateTime64 precision tz)
-> (UTCTime -> Word64) -> UTCTime -> DateTime64 precision tz
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Word64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Word64)
-> (UTCTime -> POSIXTime) -> UTCTime -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* (POSIXTime
10 POSIXTime -> Integer -> POSIXTime
forall a b. (Num a, Integral b) => a -> b -> a
^ Proxy precision -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @precision)))
    (POSIXTime -> POSIXTime)
-> (UTCTime -> POSIXTime) -> UTCTime -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
  fromChType :: DateTime64 precision tz -> UTCTime
fromChType (MkDateTime64 Word64
w64) = POSIXTime -> UTCTime
posixSecondsToUTCTime
    (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ (POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/ (POSIXTime
10 POSIXTime -> Integer -> POSIXTime
forall a b. (Num a, Integral b) => a -> b -> a
^ Proxy precision -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @precision))) (POSIXTime -> POSIXTime) -> POSIXTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Word64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64

-- ToDo: Need to be fixed
-- instance ToQueryPart (DateTime64 precision tz)
--   where
--   toQueryPart chDateTime =
--     let time = BS8.pack . show . fromChType @_ @Word64 $ chDateTime
--     in byteString (BS8.replicate (12 - BS8.length time) '0' <> time)


-- ** Array

-- | ClickHouse Array column type
newtype Array a = MkChArray [a]
  deriving newtype (Int -> Array a -> ShowS
[Array a] -> ShowS
Array a -> String
(Int -> Array a -> ShowS)
-> (Array a -> String) -> ([Array a] -> ShowS) -> Show (Array a)
forall a. Show a => Int -> Array a -> ShowS
forall a. Show a => [Array a] -> ShowS
forall a. Show a => Array a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Array a -> ShowS
showsPrec :: Int -> Array a -> ShowS
$cshow :: forall a. Show a => Array a -> String
show :: Array a -> String
$cshowList :: forall a. Show a => [Array a] -> ShowS
showList :: [Array a] -> ShowS
Show, Array a -> Array a -> Bool
(Array a -> Array a -> Bool)
-> (Array a -> Array a -> Bool) -> Eq (Array a)
forall a. Eq a => Array a -> Array a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Array a -> Array a -> Bool
== :: Array a -> Array a -> Bool
$c/= :: forall a. Eq a => Array a -> Array a -> Bool
/= :: Array a -> Array a -> Bool
Eq, Array a -> ()
(Array a -> ()) -> NFData (Array a)
forall a. NFData a => Array a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Array a -> ()
rnf :: Array a -> ()
NFData, (forall m. Monoid m => Array m -> m)
-> (forall m a. Monoid m => (a -> m) -> Array a -> m)
-> (forall m a. Monoid m => (a -> m) -> Array a -> m)
-> (forall a b. (a -> b -> b) -> b -> Array a -> b)
-> (forall a b. (a -> b -> b) -> b -> Array a -> b)
-> (forall b a. (b -> a -> b) -> b -> Array a -> b)
-> (forall b a. (b -> a -> b) -> b -> Array a -> b)
-> (forall a. (a -> a -> a) -> Array a -> a)
-> (forall a. (a -> a -> a) -> Array a -> a)
-> (forall a. Array a -> [a])
-> (forall a. Array a -> Bool)
-> (forall a. Array a -> Int)
-> (forall a. Eq a => a -> Array a -> Bool)
-> (forall a. Ord a => Array a -> a)
-> (forall a. Ord a => Array a -> a)
-> (forall a. Num a => Array a -> a)
-> (forall a. Num a => Array a -> a)
-> Foldable Array
forall a. Eq a => a -> Array a -> Bool
forall a. Num a => Array a -> a
forall a. Ord a => Array a -> a
forall m. Monoid m => Array m -> m
forall a. Array a -> Bool
forall a. Array a -> Int
forall a. Array a -> [a]
forall a. (a -> a -> a) -> Array a -> a
forall m a. Monoid m => (a -> m) -> Array a -> m
forall b a. (b -> a -> b) -> b -> Array a -> b
forall a b. (a -> b -> b) -> b -> Array a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Array m -> m
fold :: forall m. Monoid m => Array m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Array a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Array a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Array a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Array a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Array a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Array a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Array a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Array a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Array a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Array a -> a
foldr1 :: forall a. (a -> a -> a) -> Array a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Array a -> a
foldl1 :: forall a. (a -> a -> a) -> Array a -> a
$ctoList :: forall a. Array a -> [a]
toList :: forall a. Array a -> [a]
$cnull :: forall a. Array a -> Bool
null :: forall a. Array a -> Bool
$clength :: forall a. Array a -> Int
length :: forall a. Array a -> Int
$celem :: forall a. Eq a => a -> Array a -> Bool
elem :: forall a. Eq a => a -> Array a -> Bool
$cmaximum :: forall a. Ord a => Array a -> a
maximum :: forall a. Ord a => Array a -> a
$cminimum :: forall a. Ord a => Array a -> a
minimum :: forall a. Ord a => Array a -> a
$csum :: forall a. Num a => Array a -> a
sum :: forall a. Num a => Array a -> a
$cproduct :: forall a. Num a => Array a -> a
product :: forall a. Num a => Array a -> a
Foldable)
instance IsChType chType => IsChType (Array chType)
  where
  chTypeName :: String
chTypeName = String
"Array(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall chType. IsChType chType => String
chTypeName @chType String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  defaultValueOfTypeName :: Array chType
defaultValueOfTypeName = [chType] -> Array chType
forall a. [a] -> Array a
MkChArray []

instance ToChType chType inputType => ToChType (Array chType) [inputType]
  where
  toChType :: [inputType] -> Array chType
toChType = [chType] -> Array chType
forall a. [a] -> Array a
MkChArray ([chType] -> Array chType)
-> ([inputType] -> [chType]) -> [inputType] -> Array 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 userType.
ToChType chType userType =>
userType -> chType
toChType
  fromChType :: Array chType -> [inputType]
fromChType (MkChArray [chType]
values) = (chType -> inputType) -> [chType] -> [inputType]
forall a b. (a -> b) -> [a] -> [b]
map chType -> inputType
forall chType userType.
ToChType chType userType =>
chType -> userType
fromChType [chType]
values

instance (IsChType chType, ToQueryPart chType) => ToQueryPart (Array chType)
  where
  toQueryPart :: Array 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)
-> (Array chType -> Builder) -> Array 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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\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)
-> (Array chType -> [chType]) -> Array chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Array chType) @[chType]


-- ** LowCardinality

-- | ClickHouse LowCardinality(T) column type
newtype LowCardinality chType = MkLowCardinality chType
instance IsLowCardinalitySupported chType => IsChType (LowCardinality chType)
  where
  chTypeName :: String
chTypeName = String
"LowCardinality(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall chType. IsChType chType => String
chTypeName @chType String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  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

deriving newtype instance (Eq chType, IsLowCardinalitySupported chType) => Eq (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 "  DateTime"
    ':$$: 'Text "  Nullable(T)"
    )
  ) => IsLowCardinalitySupported chType

instance
  ToChType inputType chType
  =>
  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 userType.
ToChType chType userType =>
userType -> chType
toChType
  fromChType :: LowCardinality inputType -> chType
fromChType (MkLowCardinality inputType
lc)= forall chType userType.
ToChType chType userType =>
chType -> userType
fromChType @inputType inputType
lc

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


-- ** Generics

class GSerial f where
  gSerialize :: ProtocolRevision -> f p -> Builder
  gDeserialize :: ProtocolRevision -> Get (f p)

instance GSerial f => GSerial (D1 c (C1 c2 f)) where
  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.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev f p
re
  {-# INLINE gSerialize #-}
  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. GSerial f => ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev
  {-# INLINE gDeserialize #-}

instance (GSerial left1,  GSerial right) => GSerial (left1 :*: right) where
  gSerialize :: forall p. ProtocolRevision -> (:*:) left1 right p -> Builder
gSerialize ProtocolRevision
rev (left1 p
l :*: right p
r) = ProtocolRevision -> left1 p -> Builder
forall p. ProtocolRevision -> left1 p -> Builder
forall (f :: * -> *) p.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev left1 p
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> right p -> Builder
forall p. ProtocolRevision -> right p -> Builder
forall (f :: * -> *) p.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev right p
r
  {-# INLINE gSerialize #-}
  gDeserialize :: forall p. ProtocolRevision -> Get ((:*:) left1 right p)
gDeserialize ProtocolRevision
rev = do
    (left1 p -> right p -> (:*:) left1 right p)
-> Get (left1 p) -> Get (right p) -> Get ((:*:) left1 right p)
forall a b c. (a -> b -> c) -> Get a -> Get b -> Get c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 left1 p -> right p -> (:*:) left1 right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
      (ProtocolRevision -> Get (left1 p)
forall p. ProtocolRevision -> Get (left1 p)
forall (f :: * -> *) p. GSerial f => ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev)
      (ProtocolRevision -> Get (right p)
forall p. ProtocolRevision -> Get (right p)
forall (f :: * -> *) p. GSerial f => ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev)
  {-# INLINE gDeserialize #-}

instance
  (Serializable chType, Not (sel == "server_revision") ~ True)
  =>
  GSerial (S1 ('MetaSel ('Just sel) a b c) (Rec0 chType)) where
  gSerialize :: forall p.
ProtocolRevision
-> S1 ('MetaSel ('Just sel) a b c) (Rec0 chType) p -> Builder
gSerialize ProtocolRevision
rev (M1 (K1 chType
re)) = ProtocolRevision -> chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev chType
re
  {-# INLINE gSerialize #-}
  gDeserialize :: forall p.
ProtocolRevision
-> Get (S1 ('MetaSel ('Just sel) a b c) (Rec0 chType) p)
gDeserialize ProtocolRevision
rev = Rec0 chType p -> M1 S ('MetaSel ('Just sel) a b c) (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 sel) a b c) (Rec0 chType) p)
-> (chType -> Rec0 chType p)
-> chType
-> M1 S ('MetaSel ('Just sel) a b c) (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 sel) a b c) (Rec0 chType) p)
-> Get chType
-> Get (M1 S ('MetaSel ('Just sel) a b c) (Rec0 chType) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev
  {-# INLINE gDeserialize #-}


instance {-# OVERLAPPING #-}
  GSerial right
  =>
  GSerial (S1 ('MetaSel ('Just "server_revision") a b c) (Rec0 ProtocolRevision) :*: right)
  where
  gSerialize :: forall p.
ProtocolRevision
-> (:*:)
     (S1
        ('MetaSel ('Just "server_revision") a b c) (Rec0 ProtocolRevision))
     right
     p
-> Builder
gSerialize ProtocolRevision
rev (M1 (K1 (MkProtocolRevision UVarInt
server_rev)) :*: right p
right)= do
    ProtocolRevision -> UVarInt -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev UVarInt
server_rev Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> right p -> Builder
forall p. ProtocolRevision -> right p -> Builder
forall (f :: * -> *) p.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev right p
right
  {-# INLINE gSerialize #-}
  gDeserialize :: forall p.
ProtocolRevision
-> Get
     ((:*:)
        (S1
           ('MetaSel ('Just "server_revision") a b c) (Rec0 ProtocolRevision))
        right
        p)
gDeserialize ProtocolRevision
rev = do
    chosenRev <- ProtocolRevision -> ProtocolRevision -> ProtocolRevision
forall a. Ord a => a -> a -> a
min ProtocolRevision
rev (ProtocolRevision -> ProtocolRevision)
-> (UVarInt -> ProtocolRevision) -> UVarInt -> ProtocolRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UVarInt -> ProtocolRevision
MkProtocolRevision (UVarInt -> ProtocolRevision)
-> Get UVarInt -> Get ProtocolRevision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    liftA2 (:*:)
      (pure . M1 . K1 $ chosenRev)
      (gDeserialize @right chosenRev)
  {-# INLINE gDeserialize #-}




-- * Protocol parts

-- ** UVarInt

{- |
  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, 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)

instance Serializable UVarInt where
  serialize :: ProtocolRevision -> UVarInt -> Builder
serialize ProtocolRevision
_ = UVarInt -> Builder
forall {t}. (Integral t, Bits t) => t -> Builder
goUVarIntSer
    where
    goUVarIntSer :: t -> Builder
goUVarIntSer t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0x80 = UInt8 -> Builder
word8 (t -> UInt8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i)
      | Bool
otherwise = UInt8 -> Builder
word8 (UInt8 -> Int -> UInt8
forall a. Bits a => a -> Int -> a
setBit (t -> UInt8
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
goUVarIntSer (t
i t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7)
  deserialize :: ProtocolRevision -> Get UVarInt
deserialize ProtocolRevision
_ = Int -> UVarInt -> Get UVarInt
forall {a}. (Bits a, Num a) => Int -> a -> Get a
goUVarIntDeser Int
0 (UVarInt
0 :: UVarInt)
    where
    goUVarIntDeser :: Int -> a -> Get a
goUVarIntDeser Int
i a
o | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = do
      byte <- Get UInt8
getWord8
      let o' = a
o a -> a -> a
forall a. Bits a => a -> a -> a
.|. ((UInt8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt8
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 byte .&. 0x80 == 0 then pure $! o' else goUVarIntDeser (i + 1) $! o'
    goUVarIntDeser Int
_ a
_ = String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"input exceeds varuint size"
  {-# INLINE deserialize #-}


-- ** Versioning

-- >>> show major <> "." <> show minor <> "." <> show patch
-- "1.0.0"
major, minor, patch :: UVarInt
major :: UVarInt
major = UVarInt
1
minor :: UVarInt
minor = UVarInt
1
patch :: UVarInt
patch = UVarInt
0

clientName :: ChString
clientName :: ChString
clientName = ChString
"ClickHaskell"

newtype ProtocolRevision = MkProtocolRevision UVarInt
  deriving newtype (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, ProtocolRevision -> Get ProtocolRevision
ProtocolRevision -> ProtocolRevision -> Builder
(ProtocolRevision -> ProtocolRevision -> Builder)
-> (ProtocolRevision -> Get ProtocolRevision)
-> Serializable ProtocolRevision
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> ProtocolRevision -> Builder
serialize :: ProtocolRevision -> ProtocolRevision -> Builder
$cdeserialize :: ProtocolRevision -> Get ProtocolRevision
deserialize :: ProtocolRevision -> Get ProtocolRevision
Serializable)

mkRev :: forall nat . KnownNat nat => ProtocolRevision
mkRev :: forall (nat :: Nat). KnownNat nat => ProtocolRevision
mkRev = (Integer -> ProtocolRevision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ProtocolRevision)
-> (Proxy nat -> Integer) -> Proxy nat -> ProtocolRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy nat -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal) (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @nat)

{- |
Protocol implementation part for backward compatilibity formalization

NB:

  Be carefull with `BeforeRevision` value.

  If **chosen protocol** revision would be >= **revisionNumber**
  then you would get an exception during serialization.

  To avoid this:

  1. On client side - provide `AfterRevision` with some empty value
  2. On proxy side - provide server-to-server packets mapping with fallbacks on revision upgrade

-}
data Revisioned (revisionNumber :: Nat) b a = BeforeRevision b | AfterRevision a

type SinceRevision after rev = Revisioned rev () after

instance
  (KnownNat revision, Serializable before, Serializable after)
  =>
  Serializable (Revisioned revision before after)
  where
  serialize :: ProtocolRevision -> Revisioned revision before after -> Builder
serialize ProtocolRevision
rev Revisioned revision before after
sinceRevVal =
    if ProtocolRevision
rev ProtocolRevision -> ProtocolRevision -> Bool
forall a. Ord a => a -> a -> Bool
< forall (nat :: Nat). KnownNat nat => ProtocolRevision
mkRev @revision
    then Builder
forall a. Monoid a => a
mempty
    else case Revisioned revision before after
sinceRevVal of
      BeforeRevision before
_b -> String -> Builder
forall a. HasCallStack => String -> a
error String
"Protocol-specific implementation error" -- Watch `Revisioned` note
      AfterRevision after
a -> ProtocolRevision -> after -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev after
a
  deserialize :: ProtocolRevision -> Get (Revisioned revision before after)
deserialize ProtocolRevision
rev =
    if ProtocolRevision
rev ProtocolRevision -> ProtocolRevision -> Bool
forall a. Ord a => a -> a -> Bool
< forall (nat :: Nat). KnownNat nat => ProtocolRevision
mkRev @revision
    then before -> Revisioned revision before after
forall (revisionNumber :: Nat) b a.
b -> Revisioned revisionNumber b a
BeforeRevision (before -> Revisioned revision before after)
-> Get before -> Get (Revisioned revision before after)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @before ProtocolRevision
rev
    else after -> Revisioned revision before after
forall (revisionNumber :: Nat) b a.
a -> Revisioned revisionNumber b a
AfterRevision (after -> Revisioned revision before after)
-> Get after -> Get (Revisioned revision before after)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @after ProtocolRevision
rev

instance Serializable () where
  serialize :: ProtocolRevision -> () -> Builder
serialize ProtocolRevision
_ () = Builder
""
  deserialize :: ProtocolRevision -> Get ()
deserialize ProtocolRevision
_ = () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


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

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_INITIAL_PROCESSING_PROTOCOL_VERSION = 1;
type DBMS_CLUSTER_PROCESSING_PROTOCOL_VERSION_WITH_DATA_LAKE_METADATA = 2;
type DBMS_CLUSTER_PROCESSING_PROTOCOL_VERSION = 2;
type DATA_LAKE_TABLE_STATE_SNAPSHOT_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_MIN_VERSION_WITH_PROJECTION = 5;
type DBMS_PARALLEL_REPLICAS_PROTOCOL_VERSION = 5;
type DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS = 54453;
type DBMS_MIN_REVISION_WITH_QUERY_AND_LINE_NUMBERS = 54475;
type DBMS_MERGE_TREE_PART_INFO_VERSION = 1;
type DBMS_QUERY_PLAN_SERIALIZATION_VERSION = 0;
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; -- ToDo
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;
type DBMS_MIN_PROTOCOL_VERSION_WITH_INTERSERVER_EXTERNALLY_GRANTED_ROLES = 54472;
type DBMS_MIN_REVISION_WITH_V2_DYNAMIC_AND_JSON_SERIALIZATION = 54473;
type DBMS_MIN_REVISION_WITH_SERVER_SETTINGS = 54474;
type DBMS_MIN_REVISON_WITH_JWT_IN_INTERSERVER = 54476;
type DBMS_MIN_REVISION_WITH_QUERY_PLAN_SERIALIZATION = 54477;
type DBMS_MIN_REVISON_WITH_PARALLEL_BLOCK_MARSHALLING = 54478;
type DBMS_MIN_REVISION_WITH_VERSIONED_CLUSTER_FUNCTION_PROTOCOL = 54479;
type DBMS_MIN_REVISION_WITH_OUT_OF_ORDER_BUCKETS_IN_AGGREGATION = 54480;
type DBMS_MIN_REVISION_WITH_COMPRESSED_LOGS_PROFILE_EVENTS_COLUMNS = 54481;