{-# LANGUAGE
    AllowAmbiguousTypes
  , DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , GeneralizedNewtypeDeriving
  , InstanceSigs
  , LambdaCase
  , OverloadedStrings
  , StandaloneDeriving
  , UndecidableInstances
#-}

{-# OPTIONS_GHC
  -Wno-missing-methods
#-}

module ClickHaskell.DbTypes
( IsChType(ToChTypeName, chTypeName, IsWriteOptional)
, ToChType(toChType)
, FromChType(fromChType)
, ToQueryPart(toQueryPart)

, ChDateTime

, ChInt8
, ChInt16
, ChInt32
, ChInt64
, ChInt128, Int128

, ChUInt8
, ChUInt16
, ChUInt32
, ChUInt64
, ChUInt128, Word128

, ChString
, ChUUID

, ChArray
, Nullable
, LowCardinality, IsLowCardinalitySupported
) where


-- External
import Data.UUID     as UUID (UUID, toWords64, fromWords64)
import Data.WideWord (Int128, Word128(Word128))


-- GHC included
import Control.DeepSeq         (NFData)
import Data.ByteString         as BS (StrictByteString)
import Data.ByteString.Builder as BS (Builder, byteString)
import Data.ByteString.Char8   as BS8 (concatMap, pack, singleton, length, replicate)
import Data.Coerce             (coerce)
import Data.Int                (Int32, Int16, Int8, Int64)
import Data.Text               as Text (Text)
import Data.Text.Encoding      as Text (encodeUtf8)
import Data.Time
  ( UTCTime
  , ZonedTime, zonedTimeToUTC
  )
import Data.Time.Clock.POSIX         (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
import Data.Typeable                 (Proxy(..))
import Data.List                     (uncons)
import Data.String                   (IsString)
import Data.Vector.Primitive.Mutable (Prim)
import Data.Word                     (Word64, Word32, Word16, Word8)
import GHC.TypeLits                  (AppendSymbol, ErrorMessage (..), Symbol, TypeError, KnownSymbol, symbolVal)


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

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

  -- |
  -- There is only one native ClickHaskell write optional type - Nullable(T)
  --
  -- @
  -- type IsWriteOptional (Nullable someChType) = True
  -- @
  type IsWriteOptional chType :: Bool


class
  IsChType chType
  =>
  ToChType chType inputType
  where
  toChType :: inputType -> chType

class
  IsChType chType
  =>
  FromChType chType outputType
  where
  fromChType :: chType -> outputType

class
  IsChType chType
  =>
  ToQueryPart chType
  where
  toQueryPart :: chType -> BS.Builder








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

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

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

instance
  IsChType chType
  =>
  IsChType (Nullable chType)
  where
  type ToChTypeName (Nullable chType) = NullableTypeName chType
  type IsWriteOptional (Nullable _)   = 'True

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

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 inputType.
ToChType chType inputType =>
inputType -> chType
toChType @inputType @chType)

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








-- | ClickHouse LowCardinality(T) column type
newtype LowCardinality chType = MkLowCardinality chType
deriving instance (Eq chType, IsLowCardinalitySupported chType) => Eq (LowCardinality chType)
deriving instance (Show chType, IsLowCardinalitySupported chType) => Show (LowCardinality chType)
deriving 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 => IsLowCardinalitySupported (Nullable chType)

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

instance
  IsLowCardinalitySupported chType
  =>
  IsChType (LowCardinality chType)
  where
  type ToChTypeName (LowCardinality chType) = "LowCardinality(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")"
  type IsWriteOptional (LowCardinality chType) = IsWriteOptional chType

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

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

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

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

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








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

instance IsChType ChUUID
  where
  type ToChTypeName    ChUUID = "UUID"
  type IsWriteOptional ChUUID = 'False

instance ToChType ChUUID ChUUID where toChType :: ChUUID -> ChUUID
toChType = ChUUID -> ChUUID
forall a. a -> a
id
instance ToChType ChUUID UUID   where toChType :: UUID -> ChUUID
toChType = UUID -> ChUUID
MkChUUID
instance ToChType ChUUID Word64 where toChType :: Word64 -> ChUUID
toChType = UUID -> ChUUID
MkChUUID (UUID -> ChUUID) -> (Word64 -> UUID) -> Word64 -> ChUUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64 -> UUID
UUID.fromWords64 Word64
0 (Word64 -> UUID) -> (Word64 -> Word64) -> Word64 -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance FromChType ChUUID ChUUID where fromChType :: ChUUID -> ChUUID
fromChType = ChUUID -> ChUUID
forall a. a -> a
id
instance FromChType ChUUID UUID   where fromChType :: ChUUID -> UUID
fromChType (MkChUUID UUID
uuid) = UUID
uuid








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

instance IsChType ChString
  where
  type ToChTypeName    ChString = "String"
  type IsWriteOptional ChString = 'False

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

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

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

instance FromChType ChString ChString         where fromChType :: ChString -> ChString
fromChType = ChString -> ChString
forall a. a -> a
id
instance FromChType ChString StrictByteString where fromChType :: ChString -> ByteString
fromChType (MkChString ByteString
string) = ByteString
string
instance
  ( TypeError
    (     'Text "You are trying to convert ChString to Text using FromChType convertion mechanism"
    ':$$: 'Text "It could be a bad idea since Text is semantically smaller than ByteString"
    ':$$: 'Text "Decode ByteString manually if you are sure it's always can be decoded or replace it with ByteString"
    )
  ) =>
  FromChType ChString Text








-- | ClickHouse Int8 column type
newtype ChInt8 = MkChInt8 Int8
  deriving newtype (Int -> ChInt8 -> ShowS
[ChInt8] -> ShowS
ChInt8 -> String
(Int -> ChInt8 -> ShowS)
-> (ChInt8 -> String) -> ([ChInt8] -> ShowS) -> Show ChInt8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt8 -> ShowS
showsPrec :: Int -> ChInt8 -> ShowS
$cshow :: ChInt8 -> String
show :: ChInt8 -> String
$cshowList :: [ChInt8] -> ShowS
showList :: [ChInt8] -> ShowS
Show, ChInt8 -> ChInt8 -> Bool
(ChInt8 -> ChInt8 -> Bool)
-> (ChInt8 -> ChInt8 -> Bool) -> Eq ChInt8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt8 -> ChInt8 -> Bool
== :: ChInt8 -> ChInt8 -> Bool
$c/= :: ChInt8 -> ChInt8 -> Bool
/= :: ChInt8 -> ChInt8 -> Bool
Eq, Integer -> ChInt8
ChInt8 -> ChInt8
ChInt8 -> ChInt8 -> ChInt8
(ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8)
-> (ChInt8 -> ChInt8)
-> (Integer -> ChInt8)
-> Num ChInt8
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt8 -> ChInt8 -> ChInt8
+ :: ChInt8 -> ChInt8 -> ChInt8
$c- :: ChInt8 -> ChInt8 -> ChInt8
- :: ChInt8 -> ChInt8 -> ChInt8
$c* :: ChInt8 -> ChInt8 -> ChInt8
* :: ChInt8 -> ChInt8 -> ChInt8
$cnegate :: ChInt8 -> ChInt8
negate :: ChInt8 -> ChInt8
$cabs :: ChInt8 -> ChInt8
abs :: ChInt8 -> ChInt8
$csignum :: ChInt8 -> ChInt8
signum :: ChInt8 -> ChInt8
$cfromInteger :: Integer -> ChInt8
fromInteger :: Integer -> ChInt8
Num, Addr# -> Int# -> ChInt8
ByteArray# -> Int# -> ChInt8
ChInt8 -> Int#
(ChInt8 -> Int#)
-> (ChInt8 -> Int#)
-> (ByteArray# -> Int# -> ChInt8)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt8 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt8 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt8 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt8)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt8 #))
-> (forall s. Addr# -> Int# -> ChInt8 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt8 -> State# s -> State# s)
-> Prim ChInt8
forall s. Addr# -> Int# -> Int# -> ChInt8 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt8 #)
forall s. Addr# -> Int# -> ChInt8 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt8 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt8 #)
forall s.
MutableByteArray# s -> Int# -> ChInt8 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt8 -> Int#
sizeOf# :: ChInt8 -> Int#
$calignment# :: ChInt8 -> Int#
alignment# :: ChInt8 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt8
indexByteArray# :: ByteArray# -> Int# -> ChInt8
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt8 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt8 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt8 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt8 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt8 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt8 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt8
indexOffAddr# :: Addr# -> Int# -> ChInt8
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt8 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt8 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt8 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt8 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt8 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt8 -> State# s -> State# s
Prim, ChInt8
ChInt8 -> ChInt8 -> Bounded ChInt8
forall a. a -> a -> Bounded a
$cminBound :: ChInt8
minBound :: ChInt8
$cmaxBound :: ChInt8
maxBound :: ChInt8
Bounded, ChInt8 -> ()
(ChInt8 -> ()) -> NFData ChInt8
forall a. (a -> ()) -> NFData a
$crnf :: ChInt8 -> ()
rnf :: ChInt8 -> ()
NFData)

instance IsChType ChInt8
  where
  type ToChTypeName    ChInt8 = "Int8"
  type IsWriteOptional ChInt8 = 'False

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

instance ToChType ChInt8 ChInt8 where toChType :: ChInt8 -> ChInt8
toChType = ChInt8 -> ChInt8
forall a. a -> a
id
instance ToChType ChInt8 Int8   where toChType :: Int8 -> ChInt8
toChType = Int8 -> ChInt8
MkChInt8

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








-- | ClickHouse Int16 column type
newtype ChInt16 = MkChInt16 Int16
  deriving newtype (Int -> ChInt16 -> ShowS
[ChInt16] -> ShowS
ChInt16 -> String
(Int -> ChInt16 -> ShowS)
-> (ChInt16 -> String) -> ([ChInt16] -> ShowS) -> Show ChInt16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt16 -> ShowS
showsPrec :: Int -> ChInt16 -> ShowS
$cshow :: ChInt16 -> String
show :: ChInt16 -> String
$cshowList :: [ChInt16] -> ShowS
showList :: [ChInt16] -> ShowS
Show, ChInt16 -> ChInt16 -> Bool
(ChInt16 -> ChInt16 -> Bool)
-> (ChInt16 -> ChInt16 -> Bool) -> Eq ChInt16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt16 -> ChInt16 -> Bool
== :: ChInt16 -> ChInt16 -> Bool
$c/= :: ChInt16 -> ChInt16 -> Bool
/= :: ChInt16 -> ChInt16 -> Bool
Eq, Integer -> ChInt16
ChInt16 -> ChInt16
ChInt16 -> ChInt16 -> ChInt16
(ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16)
-> (ChInt16 -> ChInt16)
-> (Integer -> ChInt16)
-> Num ChInt16
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt16 -> ChInt16 -> ChInt16
+ :: ChInt16 -> ChInt16 -> ChInt16
$c- :: ChInt16 -> ChInt16 -> ChInt16
- :: ChInt16 -> ChInt16 -> ChInt16
$c* :: ChInt16 -> ChInt16 -> ChInt16
* :: ChInt16 -> ChInt16 -> ChInt16
$cnegate :: ChInt16 -> ChInt16
negate :: ChInt16 -> ChInt16
$cabs :: ChInt16 -> ChInt16
abs :: ChInt16 -> ChInt16
$csignum :: ChInt16 -> ChInt16
signum :: ChInt16 -> ChInt16
$cfromInteger :: Integer -> ChInt16
fromInteger :: Integer -> ChInt16
Num, Addr# -> Int# -> ChInt16
ByteArray# -> Int# -> ChInt16
ChInt16 -> Int#
(ChInt16 -> Int#)
-> (ChInt16 -> Int#)
-> (ByteArray# -> Int# -> ChInt16)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt16 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt16 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt16 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt16)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt16 #))
-> (forall s. Addr# -> Int# -> ChInt16 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt16 -> State# s -> State# s)
-> Prim ChInt16
forall s. Addr# -> Int# -> Int# -> ChInt16 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt16 #)
forall s. Addr# -> Int# -> ChInt16 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt16 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt16 #)
forall s.
MutableByteArray# s -> Int# -> ChInt16 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt16 -> Int#
sizeOf# :: ChInt16 -> Int#
$calignment# :: ChInt16 -> Int#
alignment# :: ChInt16 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt16
indexByteArray# :: ByteArray# -> Int# -> ChInt16
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt16 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt16 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt16 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt16 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt16 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt16 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt16
indexOffAddr# :: Addr# -> Int# -> ChInt16
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt16 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt16 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt16 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt16 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt16 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt16 -> State# s -> State# s
Prim, ChInt16
ChInt16 -> ChInt16 -> Bounded ChInt16
forall a. a -> a -> Bounded a
$cminBound :: ChInt16
minBound :: ChInt16
$cmaxBound :: ChInt16
maxBound :: ChInt16
Bounded, ChInt16 -> ()
(ChInt16 -> ()) -> NFData ChInt16
forall a. (a -> ()) -> NFData a
$crnf :: ChInt16 -> ()
rnf :: ChInt16 -> ()
NFData)

instance IsChType ChInt16
  where
  type ToChTypeName    ChInt16 = "Int16"
  type IsWriteOptional ChInt16 = 'False

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

instance ToChType ChInt16 ChInt16 where toChType :: ChInt16 -> ChInt16
toChType = ChInt16 -> ChInt16
forall a. a -> a
id
instance ToChType ChInt16 Int16   where toChType :: Int16 -> ChInt16
toChType = Int16 -> ChInt16
MkChInt16

instance FromChType ChInt16 ChInt16 where fromChType :: ChInt16 -> ChInt16
fromChType = ChInt16 -> ChInt16
forall a. a -> a
id
instance FromChType ChInt16 Int16   where fromChType :: ChInt16 -> Int16
fromChType (MkChInt16 Int16
int16) = Int16
int16








-- | ClickHouse Int32 column type
newtype ChInt32 = MkChInt32 Int32
  deriving newtype (Int -> ChInt32 -> ShowS
[ChInt32] -> ShowS
ChInt32 -> String
(Int -> ChInt32 -> ShowS)
-> (ChInt32 -> String) -> ([ChInt32] -> ShowS) -> Show ChInt32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt32 -> ShowS
showsPrec :: Int -> ChInt32 -> ShowS
$cshow :: ChInt32 -> String
show :: ChInt32 -> String
$cshowList :: [ChInt32] -> ShowS
showList :: [ChInt32] -> ShowS
Show, ChInt32 -> ChInt32 -> Bool
(ChInt32 -> ChInt32 -> Bool)
-> (ChInt32 -> ChInt32 -> Bool) -> Eq ChInt32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt32 -> ChInt32 -> Bool
== :: ChInt32 -> ChInt32 -> Bool
$c/= :: ChInt32 -> ChInt32 -> Bool
/= :: ChInt32 -> ChInt32 -> Bool
Eq, Integer -> ChInt32
ChInt32 -> ChInt32
ChInt32 -> ChInt32 -> ChInt32
(ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (Integer -> ChInt32)
-> Num ChInt32
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt32 -> ChInt32 -> ChInt32
+ :: ChInt32 -> ChInt32 -> ChInt32
$c- :: ChInt32 -> ChInt32 -> ChInt32
- :: ChInt32 -> ChInt32 -> ChInt32
$c* :: ChInt32 -> ChInt32 -> ChInt32
* :: ChInt32 -> ChInt32 -> ChInt32
$cnegate :: ChInt32 -> ChInt32
negate :: ChInt32 -> ChInt32
$cabs :: ChInt32 -> ChInt32
abs :: ChInt32 -> ChInt32
$csignum :: ChInt32 -> ChInt32
signum :: ChInt32 -> ChInt32
$cfromInteger :: Integer -> ChInt32
fromInteger :: Integer -> ChInt32
Num, Addr# -> Int# -> ChInt32
ByteArray# -> Int# -> ChInt32
ChInt32 -> Int#
(ChInt32 -> Int#)
-> (ChInt32 -> Int#)
-> (ByteArray# -> Int# -> ChInt32)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt32 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt32 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt32 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt32)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt32 #))
-> (forall s. Addr# -> Int# -> ChInt32 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt32 -> State# s -> State# s)
-> Prim ChInt32
forall s. Addr# -> Int# -> Int# -> ChInt32 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt32 #)
forall s. Addr# -> Int# -> ChInt32 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt32 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt32 #)
forall s.
MutableByteArray# s -> Int# -> ChInt32 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt32 -> Int#
sizeOf# :: ChInt32 -> Int#
$calignment# :: ChInt32 -> Int#
alignment# :: ChInt32 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt32
indexByteArray# :: ByteArray# -> Int# -> ChInt32
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt32 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt32 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt32 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt32 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt32 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt32 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt32
indexOffAddr# :: Addr# -> Int# -> ChInt32
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt32 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt32 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt32 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt32 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt32 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt32 -> State# s -> State# s
Prim, ChInt32
ChInt32 -> ChInt32 -> Bounded ChInt32
forall a. a -> a -> Bounded a
$cminBound :: ChInt32
minBound :: ChInt32
$cmaxBound :: ChInt32
maxBound :: ChInt32
Bounded, Int -> ChInt32
ChInt32 -> Int
ChInt32 -> [ChInt32]
ChInt32 -> ChInt32
ChInt32 -> ChInt32 -> [ChInt32]
ChInt32 -> ChInt32 -> ChInt32 -> [ChInt32]
(ChInt32 -> ChInt32)
-> (ChInt32 -> ChInt32)
-> (Int -> ChInt32)
-> (ChInt32 -> Int)
-> (ChInt32 -> [ChInt32])
-> (ChInt32 -> ChInt32 -> [ChInt32])
-> (ChInt32 -> ChInt32 -> [ChInt32])
-> (ChInt32 -> ChInt32 -> ChInt32 -> [ChInt32])
-> Enum ChInt32
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChInt32 -> ChInt32
succ :: ChInt32 -> ChInt32
$cpred :: ChInt32 -> ChInt32
pred :: ChInt32 -> ChInt32
$ctoEnum :: Int -> ChInt32
toEnum :: Int -> ChInt32
$cfromEnum :: ChInt32 -> Int
fromEnum :: ChInt32 -> Int
$cenumFrom :: ChInt32 -> [ChInt32]
enumFrom :: ChInt32 -> [ChInt32]
$cenumFromThen :: ChInt32 -> ChInt32 -> [ChInt32]
enumFromThen :: ChInt32 -> ChInt32 -> [ChInt32]
$cenumFromTo :: ChInt32 -> ChInt32 -> [ChInt32]
enumFromTo :: ChInt32 -> ChInt32 -> [ChInt32]
$cenumFromThenTo :: ChInt32 -> ChInt32 -> ChInt32 -> [ChInt32]
enumFromThenTo :: ChInt32 -> ChInt32 -> ChInt32 -> [ChInt32]
Enum, ChInt32 -> ()
(ChInt32 -> ()) -> NFData ChInt32
forall a. (a -> ()) -> NFData a
$crnf :: ChInt32 -> ()
rnf :: ChInt32 -> ()
NFData)

instance IsChType ChInt32
  where
  type ToChTypeName    ChInt32 = "Int32"
  type IsWriteOptional ChInt32 = 'False

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

instance ToChType ChInt32 ChInt32 where toChType :: ChInt32 -> ChInt32
toChType = ChInt32 -> ChInt32
forall a. a -> a
id
instance ToChType ChInt32 Int32   where toChType :: Int32 -> ChInt32
toChType = Int32 -> ChInt32
MkChInt32

instance FromChType ChInt32 ChInt32 where fromChType :: ChInt32 -> ChInt32
fromChType = ChInt32 -> ChInt32
forall a. a -> a
id
instance FromChType ChInt32 Int32   where fromChType :: ChInt32 -> Int32
fromChType (MkChInt32 Int32
int32) = Int32
int32








-- | ClickHouse Int64 column type
newtype ChInt64 = MkChInt64 Int64
  deriving newtype (Int -> ChInt64 -> ShowS
[ChInt64] -> ShowS
ChInt64 -> String
(Int -> ChInt64 -> ShowS)
-> (ChInt64 -> String) -> ([ChInt64] -> ShowS) -> Show ChInt64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt64 -> ShowS
showsPrec :: Int -> ChInt64 -> ShowS
$cshow :: ChInt64 -> String
show :: ChInt64 -> String
$cshowList :: [ChInt64] -> ShowS
showList :: [ChInt64] -> ShowS
Show, ChInt64 -> ChInt64 -> Bool
(ChInt64 -> ChInt64 -> Bool)
-> (ChInt64 -> ChInt64 -> Bool) -> Eq ChInt64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt64 -> ChInt64 -> Bool
== :: ChInt64 -> ChInt64 -> Bool
$c/= :: ChInt64 -> ChInt64 -> Bool
/= :: ChInt64 -> ChInt64 -> Bool
Eq, Integer -> ChInt64
ChInt64 -> ChInt64
ChInt64 -> ChInt64 -> ChInt64
(ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (Integer -> ChInt64)
-> Num ChInt64
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt64 -> ChInt64 -> ChInt64
+ :: ChInt64 -> ChInt64 -> ChInt64
$c- :: ChInt64 -> ChInt64 -> ChInt64
- :: ChInt64 -> ChInt64 -> ChInt64
$c* :: ChInt64 -> ChInt64 -> ChInt64
* :: ChInt64 -> ChInt64 -> ChInt64
$cnegate :: ChInt64 -> ChInt64
negate :: ChInt64 -> ChInt64
$cabs :: ChInt64 -> ChInt64
abs :: ChInt64 -> ChInt64
$csignum :: ChInt64 -> ChInt64
signum :: ChInt64 -> ChInt64
$cfromInteger :: Integer -> ChInt64
fromInteger :: Integer -> ChInt64
Num, Addr# -> Int# -> ChInt64
ByteArray# -> Int# -> ChInt64
ChInt64 -> Int#
(ChInt64 -> Int#)
-> (ChInt64 -> Int#)
-> (ByteArray# -> Int# -> ChInt64)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt64 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt64 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt64 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt64)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt64 #))
-> (forall s. Addr# -> Int# -> ChInt64 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt64 -> State# s -> State# s)
-> Prim ChInt64
forall s. Addr# -> Int# -> Int# -> ChInt64 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt64 #)
forall s. Addr# -> Int# -> ChInt64 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt64 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt64 #)
forall s.
MutableByteArray# s -> Int# -> ChInt64 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt64 -> Int#
sizeOf# :: ChInt64 -> Int#
$calignment# :: ChInt64 -> Int#
alignment# :: ChInt64 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt64
indexByteArray# :: ByteArray# -> Int# -> ChInt64
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt64 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt64 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt64 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt64 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt64 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt64 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt64
indexOffAddr# :: Addr# -> Int# -> ChInt64
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt64 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt64 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt64 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt64 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt64 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt64 -> State# s -> State# s
Prim, ChInt64
ChInt64 -> ChInt64 -> Bounded ChInt64
forall a. a -> a -> Bounded a
$cminBound :: ChInt64
minBound :: ChInt64
$cmaxBound :: ChInt64
maxBound :: ChInt64
Bounded, Int -> ChInt64
ChInt64 -> Int
ChInt64 -> [ChInt64]
ChInt64 -> ChInt64
ChInt64 -> ChInt64 -> [ChInt64]
ChInt64 -> ChInt64 -> ChInt64 -> [ChInt64]
(ChInt64 -> ChInt64)
-> (ChInt64 -> ChInt64)
-> (Int -> ChInt64)
-> (ChInt64 -> Int)
-> (ChInt64 -> [ChInt64])
-> (ChInt64 -> ChInt64 -> [ChInt64])
-> (ChInt64 -> ChInt64 -> [ChInt64])
-> (ChInt64 -> ChInt64 -> ChInt64 -> [ChInt64])
-> Enum ChInt64
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChInt64 -> ChInt64
succ :: ChInt64 -> ChInt64
$cpred :: ChInt64 -> ChInt64
pred :: ChInt64 -> ChInt64
$ctoEnum :: Int -> ChInt64
toEnum :: Int -> ChInt64
$cfromEnum :: ChInt64 -> Int
fromEnum :: ChInt64 -> Int
$cenumFrom :: ChInt64 -> [ChInt64]
enumFrom :: ChInt64 -> [ChInt64]
$cenumFromThen :: ChInt64 -> ChInt64 -> [ChInt64]
enumFromThen :: ChInt64 -> ChInt64 -> [ChInt64]
$cenumFromTo :: ChInt64 -> ChInt64 -> [ChInt64]
enumFromTo :: ChInt64 -> ChInt64 -> [ChInt64]
$cenumFromThenTo :: ChInt64 -> ChInt64 -> ChInt64 -> [ChInt64]
enumFromThenTo :: ChInt64 -> ChInt64 -> ChInt64 -> [ChInt64]
Enum, ChInt64 -> ()
(ChInt64 -> ()) -> NFData ChInt64
forall a. (a -> ()) -> NFData a
$crnf :: ChInt64 -> ()
rnf :: ChInt64 -> ()
NFData)

instance IsChType ChInt64
  where
  type ToChTypeName    ChInt64 = "Int64"
  type IsWriteOptional ChInt64 = 'False

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

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

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








-- | ClickHouse Int128 column type
newtype ChInt128 = MkChInt128 Int128
  deriving newtype (Int -> ChInt128 -> ShowS
[ChInt128] -> ShowS
ChInt128 -> String
(Int -> ChInt128 -> ShowS)
-> (ChInt128 -> String) -> ([ChInt128] -> ShowS) -> Show ChInt128
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChInt128 -> ShowS
showsPrec :: Int -> ChInt128 -> ShowS
$cshow :: ChInt128 -> String
show :: ChInt128 -> String
$cshowList :: [ChInt128] -> ShowS
showList :: [ChInt128] -> ShowS
Show, ChInt128 -> ChInt128 -> Bool
(ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> Bool) -> Eq ChInt128
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChInt128 -> ChInt128 -> Bool
== :: ChInt128 -> ChInt128 -> Bool
$c/= :: ChInt128 -> ChInt128 -> Bool
/= :: ChInt128 -> ChInt128 -> Bool
Eq, Integer -> ChInt128
ChInt128 -> ChInt128
ChInt128 -> ChInt128 -> ChInt128
(ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (Integer -> ChInt128)
-> Num ChInt128
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChInt128 -> ChInt128 -> ChInt128
+ :: ChInt128 -> ChInt128 -> ChInt128
$c- :: ChInt128 -> ChInt128 -> ChInt128
- :: ChInt128 -> ChInt128 -> ChInt128
$c* :: ChInt128 -> ChInt128 -> ChInt128
* :: ChInt128 -> ChInt128 -> ChInt128
$cnegate :: ChInt128 -> ChInt128
negate :: ChInt128 -> ChInt128
$cabs :: ChInt128 -> ChInt128
abs :: ChInt128 -> ChInt128
$csignum :: ChInt128 -> ChInt128
signum :: ChInt128 -> ChInt128
$cfromInteger :: Integer -> ChInt128
fromInteger :: Integer -> ChInt128
Num, Addr# -> Int# -> ChInt128
ByteArray# -> Int# -> ChInt128
ChInt128 -> Int#
(ChInt128 -> Int#)
-> (ChInt128 -> Int#)
-> (ByteArray# -> Int# -> ChInt128)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChInt128 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChInt128 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChInt128 -> State# s -> State# s)
-> (Addr# -> Int# -> ChInt128)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChInt128 #))
-> (forall s. Addr# -> Int# -> ChInt128 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChInt128 -> State# s -> State# s)
-> Prim ChInt128
forall s. Addr# -> Int# -> Int# -> ChInt128 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt128 #)
forall s. Addr# -> Int# -> ChInt128 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt128 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt128 #)
forall s.
MutableByteArray# s -> Int# -> ChInt128 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChInt128 -> Int#
sizeOf# :: ChInt128 -> Int#
$calignment# :: ChInt128 -> Int#
alignment# :: ChInt128 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChInt128
indexByteArray# :: ByteArray# -> Int# -> ChInt128
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt128 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChInt128 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt128 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChInt128 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt128 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChInt128 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChInt128
indexOffAddr# :: Addr# -> Int# -> ChInt128
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt128 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChInt128 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChInt128 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChInt128 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt128 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChInt128 -> State# s -> State# s
Prim, Eq ChInt128
Eq ChInt128 =>
(ChInt128 -> ChInt128 -> Ordering)
-> (ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> Bool)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> Ord ChInt128
ChInt128 -> ChInt128 -> Bool
ChInt128 -> ChInt128 -> Ordering
ChInt128 -> ChInt128 -> ChInt128
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChInt128 -> ChInt128 -> Ordering
compare :: ChInt128 -> ChInt128 -> Ordering
$c< :: ChInt128 -> ChInt128 -> Bool
< :: ChInt128 -> ChInt128 -> Bool
$c<= :: ChInt128 -> ChInt128 -> Bool
<= :: ChInt128 -> ChInt128 -> Bool
$c> :: ChInt128 -> ChInt128 -> Bool
> :: ChInt128 -> ChInt128 -> Bool
$c>= :: ChInt128 -> ChInt128 -> Bool
>= :: ChInt128 -> ChInt128 -> Bool
$cmax :: ChInt128 -> ChInt128 -> ChInt128
max :: ChInt128 -> ChInt128 -> ChInt128
$cmin :: ChInt128 -> ChInt128 -> ChInt128
min :: ChInt128 -> ChInt128 -> ChInt128
Ord, Num ChInt128
Ord ChInt128
(Num ChInt128, Ord ChInt128) =>
(ChInt128 -> Rational) -> Real ChInt128
ChInt128 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChInt128 -> Rational
toRational :: ChInt128 -> Rational
Real, Int -> ChInt128
ChInt128 -> Int
ChInt128 -> [ChInt128]
ChInt128 -> ChInt128
ChInt128 -> ChInt128 -> [ChInt128]
ChInt128 -> ChInt128 -> ChInt128 -> [ChInt128]
(ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128)
-> (Int -> ChInt128)
-> (ChInt128 -> Int)
-> (ChInt128 -> [ChInt128])
-> (ChInt128 -> ChInt128 -> [ChInt128])
-> (ChInt128 -> ChInt128 -> [ChInt128])
-> (ChInt128 -> ChInt128 -> ChInt128 -> [ChInt128])
-> Enum ChInt128
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChInt128 -> ChInt128
succ :: ChInt128 -> ChInt128
$cpred :: ChInt128 -> ChInt128
pred :: ChInt128 -> ChInt128
$ctoEnum :: Int -> ChInt128
toEnum :: Int -> ChInt128
$cfromEnum :: ChInt128 -> Int
fromEnum :: ChInt128 -> Int
$cenumFrom :: ChInt128 -> [ChInt128]
enumFrom :: ChInt128 -> [ChInt128]
$cenumFromThen :: ChInt128 -> ChInt128 -> [ChInt128]
enumFromThen :: ChInt128 -> ChInt128 -> [ChInt128]
$cenumFromTo :: ChInt128 -> ChInt128 -> [ChInt128]
enumFromTo :: ChInt128 -> ChInt128 -> [ChInt128]
$cenumFromThenTo :: ChInt128 -> ChInt128 -> ChInt128 -> [ChInt128]
enumFromThenTo :: ChInt128 -> ChInt128 -> ChInt128 -> [ChInt128]
Enum, Enum ChInt128
Real ChInt128
(Real ChInt128, Enum ChInt128) =>
(ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> ChInt128)
-> (ChInt128 -> ChInt128 -> (ChInt128, ChInt128))
-> (ChInt128 -> ChInt128 -> (ChInt128, ChInt128))
-> (ChInt128 -> Integer)
-> Integral ChInt128
ChInt128 -> Integer
ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
ChInt128 -> ChInt128 -> ChInt128
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChInt128 -> ChInt128 -> ChInt128
quot :: ChInt128 -> ChInt128 -> ChInt128
$crem :: ChInt128 -> ChInt128 -> ChInt128
rem :: ChInt128 -> ChInt128 -> ChInt128
$cdiv :: ChInt128 -> ChInt128 -> ChInt128
div :: ChInt128 -> ChInt128 -> ChInt128
$cmod :: ChInt128 -> ChInt128 -> ChInt128
mod :: ChInt128 -> ChInt128 -> ChInt128
$cquotRem :: ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
quotRem :: ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
$cdivMod :: ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
divMod :: ChInt128 -> ChInt128 -> (ChInt128, ChInt128)
$ctoInteger :: ChInt128 -> Integer
toInteger :: ChInt128 -> Integer
Integral, ChInt128
ChInt128 -> ChInt128 -> Bounded ChInt128
forall a. a -> a -> Bounded a
$cminBound :: ChInt128
minBound :: ChInt128
$cmaxBound :: ChInt128
maxBound :: ChInt128
Bounded, ChInt128 -> ()
(ChInt128 -> ()) -> NFData ChInt128
forall a. (a -> ()) -> NFData a
$crnf :: ChInt128 -> ()
rnf :: ChInt128 -> ()
NFData)

instance IsChType ChInt128
  where
  type ToChTypeName    ChInt128 = "Int128"
  type IsWriteOptional ChInt128 = 'False

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

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

instance FromChType ChInt128 ChInt128 where fromChType :: ChInt128 -> ChInt128
fromChType = ChInt128 -> ChInt128
forall a. a -> a
id
instance FromChType ChInt128 Int128   where fromChType :: ChInt128 -> Int128
fromChType (MkChInt128 Int128
int128) = Int128
int128








-- | ClickHouse UInt8 column type
newtype ChUInt8 = MkChUInt8 Word8
  deriving newtype (Int -> ChUInt8 -> ShowS
[ChUInt8] -> ShowS
ChUInt8 -> String
(Int -> ChUInt8 -> ShowS)
-> (ChUInt8 -> String) -> ([ChUInt8] -> ShowS) -> Show ChUInt8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt8 -> ShowS
showsPrec :: Int -> ChUInt8 -> ShowS
$cshow :: ChUInt8 -> String
show :: ChUInt8 -> String
$cshowList :: [ChUInt8] -> ShowS
showList :: [ChUInt8] -> ShowS
Show, ChUInt8 -> ChUInt8 -> Bool
(ChUInt8 -> ChUInt8 -> Bool)
-> (ChUInt8 -> ChUInt8 -> Bool) -> Eq ChUInt8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt8 -> ChUInt8 -> Bool
== :: ChUInt8 -> ChUInt8 -> Bool
$c/= :: ChUInt8 -> ChUInt8 -> Bool
/= :: ChUInt8 -> ChUInt8 -> Bool
Eq, Integer -> ChUInt8
ChUInt8 -> ChUInt8
ChUInt8 -> ChUInt8 -> ChUInt8
(ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8)
-> (ChUInt8 -> ChUInt8)
-> (Integer -> ChUInt8)
-> Num ChUInt8
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt8 -> ChUInt8 -> ChUInt8
+ :: ChUInt8 -> ChUInt8 -> ChUInt8
$c- :: ChUInt8 -> ChUInt8 -> ChUInt8
- :: ChUInt8 -> ChUInt8 -> ChUInt8
$c* :: ChUInt8 -> ChUInt8 -> ChUInt8
* :: ChUInt8 -> ChUInt8 -> ChUInt8
$cnegate :: ChUInt8 -> ChUInt8
negate :: ChUInt8 -> ChUInt8
$cabs :: ChUInt8 -> ChUInt8
abs :: ChUInt8 -> ChUInt8
$csignum :: ChUInt8 -> ChUInt8
signum :: ChUInt8 -> ChUInt8
$cfromInteger :: Integer -> ChUInt8
fromInteger :: Integer -> ChUInt8
Num, Addr# -> Int# -> ChUInt8
ByteArray# -> Int# -> ChUInt8
ChUInt8 -> Int#
(ChUInt8 -> Int#)
-> (ChUInt8 -> Int#)
-> (ByteArray# -> Int# -> ChUInt8)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt8 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt8 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt8 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt8)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt8 #))
-> (forall s. Addr# -> Int# -> ChUInt8 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt8 -> State# s -> State# s)
-> Prim ChUInt8
forall s. Addr# -> Int# -> Int# -> ChUInt8 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt8 #)
forall s. Addr# -> Int# -> ChUInt8 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt8 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt8 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt8 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt8 -> Int#
sizeOf# :: ChUInt8 -> Int#
$calignment# :: ChUInt8 -> Int#
alignment# :: ChUInt8 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt8
indexByteArray# :: ByteArray# -> Int# -> ChUInt8
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt8 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt8 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt8 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt8 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt8 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt8 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt8
indexOffAddr# :: Addr# -> Int# -> ChUInt8
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt8 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt8 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt8 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt8 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt8 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt8 -> State# s -> State# s
Prim, ChUInt8
ChUInt8 -> ChUInt8 -> Bounded ChUInt8
forall a. a -> a -> Bounded a
$cminBound :: ChUInt8
minBound :: ChUInt8
$cmaxBound :: ChUInt8
maxBound :: ChUInt8
Bounded, ChUInt8 -> ()
(ChUInt8 -> ()) -> NFData ChUInt8
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt8 -> ()
rnf :: ChUInt8 -> ()
NFData)

instance IsChType ChUInt8
  where
  type ToChTypeName    ChUInt8 = "UInt8"
  type IsWriteOptional ChUInt8 = 'False

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

instance ToChType ChUInt8 ChUInt8 where toChType :: ChUInt8 -> ChUInt8
toChType = ChUInt8 -> ChUInt8
forall a. a -> a
id
instance ToChType ChUInt8 Word8   where toChType :: Word8 -> ChUInt8
toChType = Word8 -> ChUInt8
MkChUInt8

instance FromChType ChUInt8 ChUInt8 where fromChType :: ChUInt8 -> ChUInt8
fromChType = ChUInt8 -> ChUInt8
forall a. a -> a
id
instance FromChType ChUInt8 Word8   where fromChType :: ChUInt8 -> Word8
fromChType (MkChUInt8 Word8
word8) = Word8
word8








-- | ClickHouse UInt16 column type
newtype ChUInt16 = MkChUInt16 Word16
  deriving newtype (Int -> ChUInt16 -> ShowS
[ChUInt16] -> ShowS
ChUInt16 -> String
(Int -> ChUInt16 -> ShowS)
-> (ChUInt16 -> String) -> ([ChUInt16] -> ShowS) -> Show ChUInt16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt16 -> ShowS
showsPrec :: Int -> ChUInt16 -> ShowS
$cshow :: ChUInt16 -> String
show :: ChUInt16 -> String
$cshowList :: [ChUInt16] -> ShowS
showList :: [ChUInt16] -> ShowS
Show, ChUInt16 -> ChUInt16 -> Bool
(ChUInt16 -> ChUInt16 -> Bool)
-> (ChUInt16 -> ChUInt16 -> Bool) -> Eq ChUInt16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt16 -> ChUInt16 -> Bool
== :: ChUInt16 -> ChUInt16 -> Bool
$c/= :: ChUInt16 -> ChUInt16 -> Bool
/= :: ChUInt16 -> ChUInt16 -> Bool
Eq, Integer -> ChUInt16
ChUInt16 -> ChUInt16
ChUInt16 -> ChUInt16 -> ChUInt16
(ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16)
-> (ChUInt16 -> ChUInt16)
-> (Integer -> ChUInt16)
-> Num ChUInt16
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt16 -> ChUInt16 -> ChUInt16
+ :: ChUInt16 -> ChUInt16 -> ChUInt16
$c- :: ChUInt16 -> ChUInt16 -> ChUInt16
- :: ChUInt16 -> ChUInt16 -> ChUInt16
$c* :: ChUInt16 -> ChUInt16 -> ChUInt16
* :: ChUInt16 -> ChUInt16 -> ChUInt16
$cnegate :: ChUInt16 -> ChUInt16
negate :: ChUInt16 -> ChUInt16
$cabs :: ChUInt16 -> ChUInt16
abs :: ChUInt16 -> ChUInt16
$csignum :: ChUInt16 -> ChUInt16
signum :: ChUInt16 -> ChUInt16
$cfromInteger :: Integer -> ChUInt16
fromInteger :: Integer -> ChUInt16
Num, Addr# -> Int# -> ChUInt16
ByteArray# -> Int# -> ChUInt16
ChUInt16 -> Int#
(ChUInt16 -> Int#)
-> (ChUInt16 -> Int#)
-> (ByteArray# -> Int# -> ChUInt16)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChUInt16 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt16 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt16 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt16)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChUInt16 #))
-> (forall s. Addr# -> Int# -> ChUInt16 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt16 -> State# s -> State# s)
-> Prim ChUInt16
forall s. Addr# -> Int# -> Int# -> ChUInt16 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt16 #)
forall s. Addr# -> Int# -> ChUInt16 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt16 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt16 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt16 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt16 -> Int#
sizeOf# :: ChUInt16 -> Int#
$calignment# :: ChUInt16 -> Int#
alignment# :: ChUInt16 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt16
indexByteArray# :: ByteArray# -> Int# -> ChUInt16
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt16 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt16 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt16 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt16 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt16 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt16 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt16
indexOffAddr# :: Addr# -> Int# -> ChUInt16
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt16 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt16 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt16 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt16 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt16 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt16 -> State# s -> State# s
Prim, ChUInt16
ChUInt16 -> ChUInt16 -> Bounded ChUInt16
forall a. a -> a -> Bounded a
$cminBound :: ChUInt16
minBound :: ChUInt16
$cmaxBound :: ChUInt16
maxBound :: ChUInt16
Bounded, ChUInt16 -> ()
(ChUInt16 -> ()) -> NFData ChUInt16
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt16 -> ()
rnf :: ChUInt16 -> ()
NFData)

instance IsChType ChUInt16
  where
  type ToChTypeName    ChUInt16 = "UInt16"
  type IsWriteOptional ChUInt16 = 'False

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

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

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








-- | ClickHouse UInt32 column type
newtype ChUInt32 = MkChUInt32 Word32
  deriving newtype (Int -> ChUInt32 -> ShowS
[ChUInt32] -> ShowS
ChUInt32 -> String
(Int -> ChUInt32 -> ShowS)
-> (ChUInt32 -> String) -> ([ChUInt32] -> ShowS) -> Show ChUInt32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt32 -> ShowS
showsPrec :: Int -> ChUInt32 -> ShowS
$cshow :: ChUInt32 -> String
show :: ChUInt32 -> String
$cshowList :: [ChUInt32] -> ShowS
showList :: [ChUInt32] -> ShowS
Show, ChUInt32 -> ChUInt32 -> Bool
(ChUInt32 -> ChUInt32 -> Bool)
-> (ChUInt32 -> ChUInt32 -> Bool) -> Eq ChUInt32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt32 -> ChUInt32 -> Bool
== :: ChUInt32 -> ChUInt32 -> Bool
$c/= :: ChUInt32 -> ChUInt32 -> Bool
/= :: ChUInt32 -> ChUInt32 -> Bool
Eq, Integer -> ChUInt32
ChUInt32 -> ChUInt32
ChUInt32 -> ChUInt32 -> ChUInt32
(ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (Integer -> ChUInt32)
-> Num ChUInt32
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt32 -> ChUInt32 -> ChUInt32
+ :: ChUInt32 -> ChUInt32 -> ChUInt32
$c- :: ChUInt32 -> ChUInt32 -> ChUInt32
- :: ChUInt32 -> ChUInt32 -> ChUInt32
$c* :: ChUInt32 -> ChUInt32 -> ChUInt32
* :: ChUInt32 -> ChUInt32 -> ChUInt32
$cnegate :: ChUInt32 -> ChUInt32
negate :: ChUInt32 -> ChUInt32
$cabs :: ChUInt32 -> ChUInt32
abs :: ChUInt32 -> ChUInt32
$csignum :: ChUInt32 -> ChUInt32
signum :: ChUInt32 -> ChUInt32
$cfromInteger :: Integer -> ChUInt32
fromInteger :: Integer -> ChUInt32
Num, Addr# -> Int# -> ChUInt32
ByteArray# -> Int# -> ChUInt32
ChUInt32 -> Int#
(ChUInt32 -> Int#)
-> (ChUInt32 -> Int#)
-> (ByteArray# -> Int# -> ChUInt32)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChUInt32 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt32 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt32 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt32)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChUInt32 #))
-> (forall s. Addr# -> Int# -> ChUInt32 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt32 -> State# s -> State# s)
-> Prim ChUInt32
forall s. Addr# -> Int# -> Int# -> ChUInt32 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt32 #)
forall s. Addr# -> Int# -> ChUInt32 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt32 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt32 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt32 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt32 -> Int#
sizeOf# :: ChUInt32 -> Int#
$calignment# :: ChUInt32 -> Int#
alignment# :: ChUInt32 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt32
indexByteArray# :: ByteArray# -> Int# -> ChUInt32
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt32 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt32 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt32 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt32 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt32 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt32 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt32
indexOffAddr# :: Addr# -> Int# -> ChUInt32
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt32 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt32 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt32 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt32 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt32 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt32 -> State# s -> State# s
Prim, ChUInt32
ChUInt32 -> ChUInt32 -> Bounded ChUInt32
forall a. a -> a -> Bounded a
$cminBound :: ChUInt32
minBound :: ChUInt32
$cmaxBound :: ChUInt32
maxBound :: ChUInt32
Bounded, Int -> ChUInt32
ChUInt32 -> Int
ChUInt32 -> [ChUInt32]
ChUInt32 -> ChUInt32
ChUInt32 -> ChUInt32 -> [ChUInt32]
ChUInt32 -> ChUInt32 -> ChUInt32 -> [ChUInt32]
(ChUInt32 -> ChUInt32)
-> (ChUInt32 -> ChUInt32)
-> (Int -> ChUInt32)
-> (ChUInt32 -> Int)
-> (ChUInt32 -> [ChUInt32])
-> (ChUInt32 -> ChUInt32 -> [ChUInt32])
-> (ChUInt32 -> ChUInt32 -> [ChUInt32])
-> (ChUInt32 -> ChUInt32 -> ChUInt32 -> [ChUInt32])
-> Enum ChUInt32
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUInt32 -> ChUInt32
succ :: ChUInt32 -> ChUInt32
$cpred :: ChUInt32 -> ChUInt32
pred :: ChUInt32 -> ChUInt32
$ctoEnum :: Int -> ChUInt32
toEnum :: Int -> ChUInt32
$cfromEnum :: ChUInt32 -> Int
fromEnum :: ChUInt32 -> Int
$cenumFrom :: ChUInt32 -> [ChUInt32]
enumFrom :: ChUInt32 -> [ChUInt32]
$cenumFromThen :: ChUInt32 -> ChUInt32 -> [ChUInt32]
enumFromThen :: ChUInt32 -> ChUInt32 -> [ChUInt32]
$cenumFromTo :: ChUInt32 -> ChUInt32 -> [ChUInt32]
enumFromTo :: ChUInt32 -> ChUInt32 -> [ChUInt32]
$cenumFromThenTo :: ChUInt32 -> ChUInt32 -> ChUInt32 -> [ChUInt32]
enumFromThenTo :: ChUInt32 -> ChUInt32 -> ChUInt32 -> [ChUInt32]
Enum, ChUInt32 -> ()
(ChUInt32 -> ()) -> NFData ChUInt32
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt32 -> ()
rnf :: ChUInt32 -> ()
NFData)

instance IsChType ChUInt32
  where
  type ToChTypeName    ChUInt32 = "UInt32"
  type IsWriteOptional ChUInt32 = 'False

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

instance ToChType ChUInt32 ChUInt32 where toChType :: ChUInt32 -> ChUInt32
toChType = ChUInt32 -> ChUInt32
forall a. a -> a
id
instance ToChType ChUInt32 Word32   where toChType :: Word32 -> ChUInt32
toChType = Word32 -> ChUInt32
MkChUInt32

instance FromChType ChUInt32 ChUInt32 where fromChType :: ChUInt32 -> ChUInt32
fromChType = ChUInt32 -> ChUInt32
forall a. a -> a
id
instance FromChType ChUInt32 Word32   where fromChType :: ChUInt32 -> Word32
fromChType (MkChUInt32 Word32
word32) = Word32
word32








-- | ClickHouse UInt64 column type
newtype ChUInt64 = MkChUInt64 Word64
  deriving newtype (Int -> ChUInt64 -> ShowS
[ChUInt64] -> ShowS
ChUInt64 -> String
(Int -> ChUInt64 -> ShowS)
-> (ChUInt64 -> String) -> ([ChUInt64] -> ShowS) -> Show ChUInt64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt64 -> ShowS
showsPrec :: Int -> ChUInt64 -> ShowS
$cshow :: ChUInt64 -> String
show :: ChUInt64 -> String
$cshowList :: [ChUInt64] -> ShowS
showList :: [ChUInt64] -> ShowS
Show, ChUInt64 -> ChUInt64 -> Bool
(ChUInt64 -> ChUInt64 -> Bool)
-> (ChUInt64 -> ChUInt64 -> Bool) -> Eq ChUInt64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt64 -> ChUInt64 -> Bool
== :: ChUInt64 -> ChUInt64 -> Bool
$c/= :: ChUInt64 -> ChUInt64 -> Bool
/= :: ChUInt64 -> ChUInt64 -> Bool
Eq, Integer -> ChUInt64
ChUInt64 -> ChUInt64
ChUInt64 -> ChUInt64 -> ChUInt64
(ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (Integer -> ChUInt64)
-> Num ChUInt64
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt64 -> ChUInt64 -> ChUInt64
+ :: ChUInt64 -> ChUInt64 -> ChUInt64
$c- :: ChUInt64 -> ChUInt64 -> ChUInt64
- :: ChUInt64 -> ChUInt64 -> ChUInt64
$c* :: ChUInt64 -> ChUInt64 -> ChUInt64
* :: ChUInt64 -> ChUInt64 -> ChUInt64
$cnegate :: ChUInt64 -> ChUInt64
negate :: ChUInt64 -> ChUInt64
$cabs :: ChUInt64 -> ChUInt64
abs :: ChUInt64 -> ChUInt64
$csignum :: ChUInt64 -> ChUInt64
signum :: ChUInt64 -> ChUInt64
$cfromInteger :: Integer -> ChUInt64
fromInteger :: Integer -> ChUInt64
Num, Addr# -> Int# -> ChUInt64
ByteArray# -> Int# -> ChUInt64
ChUInt64 -> Int#
(ChUInt64 -> Int#)
-> (ChUInt64 -> Int#)
-> (ByteArray# -> Int# -> ChUInt64)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChUInt64 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt64 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt64 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt64)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChUInt64 #))
-> (forall s. Addr# -> Int# -> ChUInt64 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt64 -> State# s -> State# s)
-> Prim ChUInt64
forall s. Addr# -> Int# -> Int# -> ChUInt64 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt64 #)
forall s. Addr# -> Int# -> ChUInt64 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt64 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt64 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt64 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt64 -> Int#
sizeOf# :: ChUInt64 -> Int#
$calignment# :: ChUInt64 -> Int#
alignment# :: ChUInt64 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt64
indexByteArray# :: ByteArray# -> Int# -> ChUInt64
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt64 #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, ChUInt64 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt64 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt64 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt64 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt64 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt64
indexOffAddr# :: Addr# -> Int# -> ChUInt64
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt64 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt64 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt64 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt64 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt64 -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> ChUInt64 -> State# s -> State# s
Prim, ChUInt64
ChUInt64 -> ChUInt64 -> Bounded ChUInt64
forall a. a -> a -> Bounded a
$cminBound :: ChUInt64
minBound :: ChUInt64
$cmaxBound :: ChUInt64
maxBound :: ChUInt64
Bounded, Int -> ChUInt64
ChUInt64 -> Int
ChUInt64 -> [ChUInt64]
ChUInt64 -> ChUInt64
ChUInt64 -> ChUInt64 -> [ChUInt64]
ChUInt64 -> ChUInt64 -> ChUInt64 -> [ChUInt64]
(ChUInt64 -> ChUInt64)
-> (ChUInt64 -> ChUInt64)
-> (Int -> ChUInt64)
-> (ChUInt64 -> Int)
-> (ChUInt64 -> [ChUInt64])
-> (ChUInt64 -> ChUInt64 -> [ChUInt64])
-> (ChUInt64 -> ChUInt64 -> [ChUInt64])
-> (ChUInt64 -> ChUInt64 -> ChUInt64 -> [ChUInt64])
-> Enum ChUInt64
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUInt64 -> ChUInt64
succ :: ChUInt64 -> ChUInt64
$cpred :: ChUInt64 -> ChUInt64
pred :: ChUInt64 -> ChUInt64
$ctoEnum :: Int -> ChUInt64
toEnum :: Int -> ChUInt64
$cfromEnum :: ChUInt64 -> Int
fromEnum :: ChUInt64 -> Int
$cenumFrom :: ChUInt64 -> [ChUInt64]
enumFrom :: ChUInt64 -> [ChUInt64]
$cenumFromThen :: ChUInt64 -> ChUInt64 -> [ChUInt64]
enumFromThen :: ChUInt64 -> ChUInt64 -> [ChUInt64]
$cenumFromTo :: ChUInt64 -> ChUInt64 -> [ChUInt64]
enumFromTo :: ChUInt64 -> ChUInt64 -> [ChUInt64]
$cenumFromThenTo :: ChUInt64 -> ChUInt64 -> ChUInt64 -> [ChUInt64]
enumFromThenTo :: ChUInt64 -> ChUInt64 -> ChUInt64 -> [ChUInt64]
Enum, ChUInt64 -> ()
(ChUInt64 -> ()) -> NFData ChUInt64
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt64 -> ()
rnf :: ChUInt64 -> ()
NFData)

instance IsChType ChUInt64
  where
  type ToChTypeName    ChUInt64 = "UInt64"
  type IsWriteOptional ChUInt64 = 'False

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

instance ToChType ChUInt64 ChUInt64 where toChType :: ChUInt64 -> ChUInt64
toChType = ChUInt64 -> ChUInt64
forall a. a -> a
id
instance ToChType ChUInt64 Word64   where toChType :: Word64 -> ChUInt64
toChType = Word64 -> ChUInt64
MkChUInt64

instance FromChType ChUInt64 ChUInt64 where fromChType :: ChUInt64 -> ChUInt64
fromChType = ChUInt64 -> ChUInt64
forall a. a -> a
id
instance FromChType ChUInt64 Word64   where fromChType :: ChUInt64 -> Word64
fromChType (MkChUInt64 Word64
w64) = Word64
w64








-- | ClickHouse UInt128 column type
newtype ChUInt128 = MkChUInt128 Word128
  deriving newtype (Int -> ChUInt128 -> ShowS
[ChUInt128] -> ShowS
ChUInt128 -> String
(Int -> ChUInt128 -> ShowS)
-> (ChUInt128 -> String)
-> ([ChUInt128] -> ShowS)
-> Show ChUInt128
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChUInt128 -> ShowS
showsPrec :: Int -> ChUInt128 -> ShowS
$cshow :: ChUInt128 -> String
show :: ChUInt128 -> String
$cshowList :: [ChUInt128] -> ShowS
showList :: [ChUInt128] -> ShowS
Show, ChUInt128 -> ChUInt128 -> Bool
(ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> Bool) -> Eq ChUInt128
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChUInt128 -> ChUInt128 -> Bool
== :: ChUInt128 -> ChUInt128 -> Bool
$c/= :: ChUInt128 -> ChUInt128 -> Bool
/= :: ChUInt128 -> ChUInt128 -> Bool
Eq, Integer -> ChUInt128
ChUInt128 -> ChUInt128
ChUInt128 -> ChUInt128 -> ChUInt128
(ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (Integer -> ChUInt128)
-> Num ChUInt128
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChUInt128 -> ChUInt128 -> ChUInt128
+ :: ChUInt128 -> ChUInt128 -> ChUInt128
$c- :: ChUInt128 -> ChUInt128 -> ChUInt128
- :: ChUInt128 -> ChUInt128 -> ChUInt128
$c* :: ChUInt128 -> ChUInt128 -> ChUInt128
* :: ChUInt128 -> ChUInt128 -> ChUInt128
$cnegate :: ChUInt128 -> ChUInt128
negate :: ChUInt128 -> ChUInt128
$cabs :: ChUInt128 -> ChUInt128
abs :: ChUInt128 -> ChUInt128
$csignum :: ChUInt128 -> ChUInt128
signum :: ChUInt128 -> ChUInt128
$cfromInteger :: Integer -> ChUInt128
fromInteger :: Integer -> ChUInt128
Num, Addr# -> Int# -> ChUInt128
ByteArray# -> Int# -> ChUInt128
ChUInt128 -> Int#
(ChUInt128 -> Int#)
-> (ChUInt128 -> Int#)
-> (ByteArray# -> Int# -> ChUInt128)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ChUInt128 #))
-> (forall s.
    MutableByteArray# s -> Int# -> ChUInt128 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> ChUInt128 -> State# s -> State# s)
-> (Addr# -> Int# -> ChUInt128)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, ChUInt128 #))
-> (forall s. Addr# -> Int# -> ChUInt128 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> ChUInt128 -> State# s -> State# s)
-> Prim ChUInt128
forall s.
Addr# -> Int# -> Int# -> ChUInt128 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt128 #)
forall s. Addr# -> Int# -> ChUInt128 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt128 -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChUInt128 #)
forall s.
MutableByteArray# s -> Int# -> ChUInt128 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOf# :: ChUInt128 -> Int#
sizeOf# :: ChUInt128 -> Int#
$calignment# :: ChUInt128 -> Int#
alignment# :: ChUInt128 -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> ChUInt128
indexByteArray# :: ByteArray# -> Int# -> ChUInt128
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChUInt128 #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ChUInt128 #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt128 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> ChUInt128 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt128 -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> ChUInt128 -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> ChUInt128
indexOffAddr# :: Addr# -> Int# -> ChUInt128
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt128 #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, ChUInt128 #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> ChUInt128 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> ChUInt128 -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> ChUInt128 -> State# s -> State# s
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> ChUInt128 -> State# s -> State# s
Prim, ChUInt128
ChUInt128 -> ChUInt128 -> Bounded ChUInt128
forall a. a -> a -> Bounded a
$cminBound :: ChUInt128
minBound :: ChUInt128
$cmaxBound :: ChUInt128
maxBound :: ChUInt128
Bounded, Int -> ChUInt128
ChUInt128 -> Int
ChUInt128 -> [ChUInt128]
ChUInt128 -> ChUInt128
ChUInt128 -> ChUInt128 -> [ChUInt128]
ChUInt128 -> ChUInt128 -> ChUInt128 -> [ChUInt128]
(ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128)
-> (Int -> ChUInt128)
-> (ChUInt128 -> Int)
-> (ChUInt128 -> [ChUInt128])
-> (ChUInt128 -> ChUInt128 -> [ChUInt128])
-> (ChUInt128 -> ChUInt128 -> [ChUInt128])
-> (ChUInt128 -> ChUInt128 -> ChUInt128 -> [ChUInt128])
-> Enum ChUInt128
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChUInt128 -> ChUInt128
succ :: ChUInt128 -> ChUInt128
$cpred :: ChUInt128 -> ChUInt128
pred :: ChUInt128 -> ChUInt128
$ctoEnum :: Int -> ChUInt128
toEnum :: Int -> ChUInt128
$cfromEnum :: ChUInt128 -> Int
fromEnum :: ChUInt128 -> Int
$cenumFrom :: ChUInt128 -> [ChUInt128]
enumFrom :: ChUInt128 -> [ChUInt128]
$cenumFromThen :: ChUInt128 -> ChUInt128 -> [ChUInt128]
enumFromThen :: ChUInt128 -> ChUInt128 -> [ChUInt128]
$cenumFromTo :: ChUInt128 -> ChUInt128 -> [ChUInt128]
enumFromTo :: ChUInt128 -> ChUInt128 -> [ChUInt128]
$cenumFromThenTo :: ChUInt128 -> ChUInt128 -> ChUInt128 -> [ChUInt128]
enumFromThenTo :: ChUInt128 -> ChUInt128 -> ChUInt128 -> [ChUInt128]
Enum, Eq ChUInt128
Eq ChUInt128 =>
(ChUInt128 -> ChUInt128 -> Ordering)
-> (ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> Bool)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> Ord ChUInt128
ChUInt128 -> ChUInt128 -> Bool
ChUInt128 -> ChUInt128 -> Ordering
ChUInt128 -> ChUInt128 -> ChUInt128
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChUInt128 -> ChUInt128 -> Ordering
compare :: ChUInt128 -> ChUInt128 -> Ordering
$c< :: ChUInt128 -> ChUInt128 -> Bool
< :: ChUInt128 -> ChUInt128 -> Bool
$c<= :: ChUInt128 -> ChUInt128 -> Bool
<= :: ChUInt128 -> ChUInt128 -> Bool
$c> :: ChUInt128 -> ChUInt128 -> Bool
> :: ChUInt128 -> ChUInt128 -> Bool
$c>= :: ChUInt128 -> ChUInt128 -> Bool
>= :: ChUInt128 -> ChUInt128 -> Bool
$cmax :: ChUInt128 -> ChUInt128 -> ChUInt128
max :: ChUInt128 -> ChUInt128 -> ChUInt128
$cmin :: ChUInt128 -> ChUInt128 -> ChUInt128
min :: ChUInt128 -> ChUInt128 -> ChUInt128
Ord, Num ChUInt128
Ord ChUInt128
(Num ChUInt128, Ord ChUInt128) =>
(ChUInt128 -> Rational) -> Real ChUInt128
ChUInt128 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ChUInt128 -> Rational
toRational :: ChUInt128 -> Rational
Real, Enum ChUInt128
Real ChUInt128
(Real ChUInt128, Enum ChUInt128) =>
(ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> ChUInt128)
-> (ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128))
-> (ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128))
-> (ChUInt128 -> Integer)
-> Integral ChUInt128
ChUInt128 -> Integer
ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
ChUInt128 -> ChUInt128 -> ChUInt128
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChUInt128 -> ChUInt128 -> ChUInt128
quot :: ChUInt128 -> ChUInt128 -> ChUInt128
$crem :: ChUInt128 -> ChUInt128 -> ChUInt128
rem :: ChUInt128 -> ChUInt128 -> ChUInt128
$cdiv :: ChUInt128 -> ChUInt128 -> ChUInt128
div :: ChUInt128 -> ChUInt128 -> ChUInt128
$cmod :: ChUInt128 -> ChUInt128 -> ChUInt128
mod :: ChUInt128 -> ChUInt128 -> ChUInt128
$cquotRem :: ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
quotRem :: ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
$cdivMod :: ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
divMod :: ChUInt128 -> ChUInt128 -> (ChUInt128, ChUInt128)
$ctoInteger :: ChUInt128 -> Integer
toInteger :: ChUInt128 -> Integer
Integral, ChUInt128 -> ()
(ChUInt128 -> ()) -> NFData ChUInt128
forall a. (a -> ()) -> NFData a
$crnf :: ChUInt128 -> ()
rnf :: ChUInt128 -> ()
NFData)

instance IsChType ChUInt128
  where
  type ToChTypeName    ChUInt128 = "UInt128"
  type IsWriteOptional ChUInt128 = 'False

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

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

instance FromChType ChUInt128 ChUInt128 where fromChType :: ChUInt128 -> ChUInt128
fromChType = ChUInt128 -> ChUInt128
forall a. a -> a
id
instance FromChType ChUInt128 Word128   where fromChType :: ChUInt128 -> Word128
fromChType (MkChUInt128 Word128
w128) = Word128
w128








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

instance IsChType ChDateTime
  where
  type ToChTypeName    ChDateTime = "DateTime"
  type IsWriteOptional ChDateTime = 'False

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

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

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








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

instance IsChType ChDate
  where
  type ToChTypeName    ChDate = "Date"
  type IsWriteOptional ChDate = 'False








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

instance IsChType chType => IsChType (ChArray chType)
  where
  type ToChTypeName    (ChArray chType) = "Array(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")"
  type IsWriteOptional (ChArray chType) = 'False

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

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

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