{- |
  Module:      ClickHaskell
  Copyright:   (c) 2023 Dmitry Kovalev
  License:     BSD-3-Clause
  Maintainer:  Dmitry Kovalev
  Stability:   Experimental

  For full documentation, visit: https://clickhaskell.dev/
-}

module ClickHaskell
  (
  {- * Connection -}
    ConnectionArgs, defaultConnectionArgs
  , setHost, setPort, setUser, setDatabase, setPassword
  , overrideNetwork
  , Connection(..), openConnection
  , Buffer(..)

  {- * Errors -}
  , ClientError(..)
  , ConnectionError(..)
  , UserError(..)
  , InternalError(..)

  {- * Client wrappers -}
  {- ** SELECT -}
  , select, selectFrom, selectFromView, generateRandom
  , ClickHaskell(..), FromChType(fromChType)
  {- ** INSERT -}
  , insertInto
  , ToChType(toChType)
  {- ** Arbitrary commands -}, command, ping
  {- ** Shared -}
  , Column, KnownColumn, SerializableColumn
  , Table, View
  {- *** Query -}
  , ToQueryPart(toQueryPart), parameter, Parameter, Parameters, viewParameters

  {- * ClickHouse types -}
  , IsChType(chTypeName, defaultValueOfTypeName)
  , DateTime(..), DateTime64
  , Int8, Int16, Int32, Int64, Int128(..)
  , UInt8, UInt16, UInt32, UInt64, UInt128, Word128(..)
  , Nullable
  , LowCardinality, IsLowCardinalitySupported
  , UUID(..)
  , Array(..)
  , ChString(..)


  {- * Protocol parts -}

  {- ** Shared -}
  , UVarInt(..), SinceRevision(..), ProtocolRevision
  {- *** Data packet -}, DataPacket(..), BlockInfo(..)

  {- ** Client -}, ClientPacket(..)
  {- *** Hello -}, HelloPacket(..), Addendum(..)
  {- *** Query -}
  , QueryPacket(..)
  , DbSettings(..), QueryParameters(..), QueryStage(..)
  , ClientInfo(..), QueryKind(..)
  
  {- ** Server -}, ServerPacket(..)
  {- *** Hello -}, HelloResponse(..), PasswordComplexityRules(..)
  {- *** Exception -}, ExceptionPacket(..)
  {- *** Progress -}, ProgressPacket(..)
  {- *** ProfileInfo -}, ProfileInfo(..)
  {- *** TableColumns -}, TableColumns(..)
  ) where

-- Internal
import ClickHaskell.Connection
import ClickHaskell.Columns
import ClickHaskell.Packets
import ClickHaskell.Primitive

-- GHC included
import Control.Applicative (liftA2)
import Control.Concurrent (newMVar, putMVar, takeMVar)
import Control.Exception (Exception, SomeException, bracketOnError, catch, finally, mask, onException, throw, throwIO)
import Control.Monad (when, (<$!>))
import Data.Binary.Get
import Data.Bits (Bits (unsafeShiftR))
import Data.ByteString as BS (ByteString)
import Data.ByteString.Builder
import Data.ByteString.Char8 as BS8 (concatMap, length, pack, replicate, singleton)
import Data.ByteString.Lazy as BSL (toStrict)
import Data.Coerce (coerce)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Type)
import Data.List (uncons)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.Text (Text)
import Data.Text.Encoding as Text (encodeUtf8)
import Data.Time (UTCTime, ZonedTime, zonedTimeToUTC)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Data.Typeable (Proxy (..))
import Data.Word (Word16, Word32, Word64)
import GHC.Generics (C1, D1, Generic (..), K1 (K1, unK1), M1 (M1, unM1), Meta (MetaSel), Rec0, S1, type (:*:) (..))
import GHC.Stack (HasCallStack, callStack, prettyCallStack)
import GHC.TypeLits (ErrorMessage (..), KnownSymbol, Symbol, TypeError, symbolVal)
import Prelude hiding (liftA2)
import System.Environment (lookupEnv)
import System.Timeout (timeout)

-- External
import Data.WideWord (Int128 (..), Word128(..))
import Network.Socket hiding (SocketOption(..))

readBuffer :: Buffer -> Get a -> IO a
readBuffer :: forall a. Buffer -> Get a -> IO a
readBuffer Buffer
buffer Get a
deseralize =
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch @InternalError
    (Buffer -> Get a -> IO a
forall a. Buffer -> Get a -> IO a
rawBufferRead Buffer
buffer Get a
deseralize)
    (ClientError -> IO a
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO a)
-> (InternalError -> ClientError) -> InternalError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => InternalError -> ClientError
InternalError -> ClientError
InternalError)

withConnection :: HasCallStack => Connection -> (ConnectionState -> IO a) -> IO a
withConnection :: forall a.
HasCallStack =>
Connection -> (ConnectionState -> IO a) -> IO a
withConnection (MkConnection MVar ConnectionState
connStateMVar) ConnectionState -> IO a
f =
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    ConnectionState
connState <- MVar ConnectionState -> IO ConnectionState
forall a. MVar a -> IO a
takeMVar MVar ConnectionState
connStateMVar
    a
b <- IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
onException
      (IO a -> IO a
forall a. IO a -> IO a
restore (ConnectionState -> IO a
f ConnectionState
connState))
      (MVar ConnectionState -> ConnectionState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ConnectionState
connStateMVar (ConnectionState -> IO ()) -> IO ConnectionState -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConnectionState -> IO ConnectionState
reopenConnection ConnectionState
connState)
    MVar ConnectionState -> ConnectionState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ConnectionState
connStateMVar ConnectionState
connState
    a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b

openConnection :: HasCallStack => ConnectionArgs -> IO Connection
openConnection :: HasCallStack => ConnectionArgs -> IO Connection
openConnection ConnectionArgs
creds = (MVar ConnectionState -> Connection)
-> IO (MVar ConnectionState) -> IO Connection
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVar ConnectionState -> Connection
MkConnection (IO (MVar ConnectionState) -> IO Connection)
-> (ConnectionState -> IO (MVar ConnectionState))
-> ConnectionState
-> IO Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionState -> IO (MVar ConnectionState)
forall a. a -> IO (MVar a)
newMVar (ConnectionState -> IO Connection)
-> IO ConnectionState -> IO Connection
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConnectionArgs -> IO ConnectionState
createConnectionState ConnectionArgs
creds

reopenConnection :: ConnectionState -> IO ConnectionState
reopenConnection :: ConnectionState -> IO ConnectionState
reopenConnection MkConnectionState{ConnectionArgs
creds :: ConnectionArgs
creds :: ConnectionState -> ConnectionArgs
creds, Buffer
buffer :: Buffer
buffer :: ConnectionState -> Buffer
buffer} = do
  Buffer -> IO ()
flushBuffer Buffer
buffer
  Buffer -> IO ()
closeSock Buffer
buffer
  ConnectionArgs -> IO ConnectionState
createConnectionState ConnectionArgs
creds

createConnectionState :: ConnectionArgs -> IO ConnectionState
createConnectionState :: ConnectionArgs -> IO ConnectionState
createConnectionState creds :: ConnectionArgs
creds@MkConnectionArgs {Text
user :: Text
user :: ConnectionArgs -> Text
user, Text
pass :: Text
pass :: ConnectionArgs -> Text
pass, Text
db :: Text
db :: ConnectionArgs -> Text
db, ServiceName
host :: ServiceName
host :: ConnectionArgs -> ServiceName
host, Maybe ServiceName
mPort :: Maybe ServiceName
mPort :: ConnectionArgs -> Maybe ServiceName
mPort, ServiceName -> SockAddr -> Socket -> IO Buffer
initBuffer :: ServiceName -> SockAddr -> Socket -> IO Buffer
initBuffer :: ConnectionArgs -> ServiceName -> SockAddr -> Socket -> IO Buffer
initBuffer, Bool
isTLS :: Bool
isTLS :: ConnectionArgs -> Bool
isTLS} = do
  let port :: ServiceName
port = ServiceName -> Maybe ServiceName -> ServiceName
forall a. a -> Maybe a -> a
fromMaybe (if Bool
isTLS then ServiceName
"9440" else ServiceName
"9000") Maybe ServiceName
mPort
  ChString
hostname <- ChString
-> (ServiceName -> ChString) -> Maybe ServiceName -> ChString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChString
"" ServiceName -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Maybe ServiceName -> ChString)
-> IO (Maybe ServiceName) -> IO ChString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceName -> IO (Maybe ServiceName)
lookupEnv ServiceName
"HOSTNAME"
  ChString
os_user <- ChString
-> (ServiceName -> ChString) -> Maybe ServiceName -> ChString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChString
"" ServiceName -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Maybe ServiceName -> ChString)
-> IO (Maybe ServiceName) -> IO ChString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceName -> IO (Maybe ServiceName)
lookupEnv ServiceName
"USER"
  AddrInfo{Family
addrFamily :: Family
addrFamily :: AddrInfo -> Family
addrFamily, SocketType
addrSocketType :: SocketType
addrSocketType :: AddrInfo -> SocketType
addrSocketType, ProtocolNumber
addrProtocol :: ProtocolNumber
addrProtocol :: AddrInfo -> ProtocolNumber
addrProtocol, SockAddr
addrAddress :: SockAddr
addrAddress :: AddrInfo -> SockAddr
addrAddress}
    <- IO AddrInfo
-> (AddrInfo -> IO AddrInfo) -> Maybe AddrInfo -> IO AddrInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConnectionError -> IO AddrInfo
forall e a. Exception e => e -> IO a
throwIO ConnectionError
NoAdressResolved) AddrInfo -> IO AddrInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AddrInfo -> IO AddrInfo)
-> ([AddrInfo] -> Maybe AddrInfo) -> [AddrInfo] -> IO AddrInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AddrInfo] -> Maybe AddrInfo
forall a. [a] -> Maybe a
listToMaybe
    ([AddrInfo] -> IO AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe AddrInfo
-> Maybe ServiceName -> Maybe ServiceName -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo
-> Maybe ServiceName -> Maybe ServiceName -> IO (t AddrInfo)
getAddrInfo
      (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
defaultHints{addrFlags = [AI_ADDRCONFIG], addrSocketType = Stream})
      (ServiceName -> Maybe ServiceName
forall a. a -> Maybe a
Just ServiceName
host)
      (ServiceName -> Maybe ServiceName
forall a. a -> Maybe a
Just ServiceName
port)
  Buffer
buffer <- IO Buffer -> (Buffer -> IO Buffer) -> Maybe Buffer -> IO Buffer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConnectionError -> IO Buffer
forall e a. Exception e => e -> IO a
throwIO ConnectionError
EstablishTimeout) Buffer -> IO Buffer
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe Buffer -> IO Buffer) -> IO (Maybe Buffer) -> IO Buffer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO Buffer -> IO (Maybe Buffer)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
3_000_000 (
      IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Buffer) -> IO Buffer
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        (Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
addrFamily SocketType
addrSocketType ProtocolNumber
addrProtocol)
        (\Socket
sock ->
          forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch @SomeException
            (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally (Socket -> ShutdownCmd -> IO ()
shutdown Socket
sock ShutdownCmd
ShutdownBoth) (Socket -> IO ()
close Socket
sock))
            (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        )
        (\Socket
sock -> ServiceName -> SockAddr -> Socket -> IO Buffer
initBuffer ServiceName
host SockAddr
addrAddress Socket
sock)
      )

  (Buffer -> ByteString -> IO ()
writeSock Buffer
buffer (ByteString -> IO ())
-> (ClientPacket -> ByteString) -> ClientPacket -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (ClientPacket -> Builder) -> ClientPacket -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolRevision -> ClientPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
latestSupportedRevision)
    (Text -> Text -> Text -> ClientPacket
mkHelloPacket Text
db Text
user Text
pass)
  ServerPacket
serverPacketType <- Buffer -> Get ServerPacket -> IO ServerPacket
forall a. Buffer -> Get a -> IO a
readBuffer Buffer
buffer (ProtocolRevision -> Get ServerPacket
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
latestSupportedRevision)
  case ServerPacket
serverPacketType of
    HelloResponse MkHelloResponse{ProtocolRevision
server_revision :: ProtocolRevision
server_revision :: HelloResponse -> ProtocolRevision
server_revision} -> do
      let revision :: ProtocolRevision
revision = ProtocolRevision -> ProtocolRevision -> ProtocolRevision
forall a. Ord a => a -> a -> a
min ProtocolRevision
server_revision ProtocolRevision
latestSupportedRevision
          conn :: ConnectionState
conn = MkConnectionState{user :: ChString
user = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
user, ProtocolRevision
ChString
ConnectionArgs
Buffer
creds :: ConnectionArgs
buffer :: Buffer
creds :: ConnectionArgs
hostname :: ChString
os_user :: ChString
buffer :: Buffer
revision :: ProtocolRevision
revision :: ProtocolRevision
os_user :: ChString
hostname :: ChString
..}
      ConnectionState -> Addendum -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
conn MkAddendum{quota_key :: SinceRevision ChString DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
quota_key = ChString
-> SinceRevision ChString DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""}
      ConnectionState -> IO ConnectionState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionState
conn
    Exception ExceptionPacket
exception -> ClientError -> IO ConnectionState
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
    ServerPacket
otherPacket         -> ClientError -> IO ConnectionState
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => InternalError -> ClientError
InternalError -> ClientError
InternalError (InternalError -> ClientError) -> InternalError -> ClientError
forall a b. (a -> b) -> a -> b
$ UVarInt -> InternalError
UnexpectedPacketType (UVarInt -> InternalError) -> UVarInt -> InternalError
forall a b. (a -> b) -> a -> b
$ ServerPacket -> UVarInt
serverPacketToNum ServerPacket
otherPacket)


{- |
  Might be used for any command without data responses

  For example: CREATE, TRUNCATE, KILL, SET, GRANT

  __Throws exception if any data was returned__
-}
command :: HasCallStack => Connection -> ChString -> IO ()
command :: HasCallStack => Connection -> ChString -> IO ()
command Connection
conn ChString
query = do
  Connection -> (ConnectionState -> IO ()) -> IO ()
forall a.
HasCallStack =>
Connection -> (ConnectionState -> IO a) -> IO a
withConnection Connection
conn ((ConnectionState -> IO ()) -> IO ())
-> (ConnectionState -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConnectionState
connState -> do
    ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
connState (ConnectionState -> ChString -> ClientPacket
mkQueryPacket ConnectionState
connState ChString
query)
    ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
connState (ChString -> UVarInt -> UVarInt -> ClientPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    ConnectionState -> IO ()
handleCreate ConnectionState
connState
  where
  handleCreate :: ConnectionState -> IO ()
  handleCreate :: ConnectionState -> IO ()
handleCreate MkConnectionState{ProtocolRevision
ChString
ConnectionArgs
Buffer
creds :: ConnectionState -> ConnectionArgs
buffer :: ConnectionState -> Buffer
user :: ConnectionState -> ChString
revision :: ConnectionState -> ProtocolRevision
os_user :: ConnectionState -> ChString
hostname :: ConnectionState -> ChString
user :: ChString
hostname :: ChString
os_user :: ChString
buffer :: Buffer
revision :: ProtocolRevision
creds :: ConnectionArgs
..} =
    Buffer -> Get ServerPacket -> IO ServerPacket
forall a. Buffer -> Get a -> IO a
readBuffer Buffer
buffer (ProtocolRevision -> Get ServerPacket
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision)
    IO ServerPacket -> (ServerPacket -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ServerPacket
packet -> case ServerPacket
packet of
      ServerPacket
EndOfStream         -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Exception ExceptionPacket
exception -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
      ServerPacket
otherPacket         -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => InternalError -> ClientError
InternalError -> ClientError
InternalError (InternalError -> ClientError) -> InternalError -> ClientError
forall a b. (a -> b) -> a -> b
$ UVarInt -> InternalError
UnexpectedPacketType (UVarInt -> InternalError) -> UVarInt -> InternalError
forall a b. (a -> b) -> a -> b
$ ServerPacket -> UVarInt
serverPacketToNum ServerPacket
otherPacket)


-- * Ping

ping :: HasCallStack => Connection -> IO ()
ping :: HasCallStack => Connection -> IO ()
ping Connection
conn = do
  Connection -> (ConnectionState -> IO ()) -> IO ()
forall a.
HasCallStack =>
Connection -> (ConnectionState -> IO a) -> IO a
withConnection Connection
conn ((ConnectionState -> IO ()) -> IO ())
-> (ConnectionState -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \connState :: ConnectionState
connState@MkConnectionState{ProtocolRevision
revision :: ConnectionState -> ProtocolRevision
revision :: ProtocolRevision
revision, Buffer
buffer :: ConnectionState -> Buffer
buffer :: Buffer
buffer} -> do
    ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
connState ClientPacket
Ping
    ServerPacket
responsePacket <- Buffer -> Get ServerPacket -> IO ServerPacket
forall a. Buffer -> Get a -> IO a
readBuffer Buffer
buffer (ProtocolRevision -> Get ServerPacket
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision)
    case ServerPacket
responsePacket of
      ServerPacket
Pong                -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Exception ExceptionPacket
exception -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
      ServerPacket
otherPacket         -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => InternalError -> ClientError
InternalError -> ClientError
InternalError (InternalError -> ClientError) -> InternalError -> ClientError
forall a b. (a -> b) -> a -> b
$ UVarInt -> InternalError
UnexpectedPacketType (UVarInt -> InternalError) -> UVarInt -> InternalError
forall a b. (a -> b) -> a -> b
$ ServerPacket -> UVarInt
serverPacketToNum ServerPacket
otherPacket)




-- * Client wrappers

-- ** SELECT

select ::
  forall columns output result
  .
  ClickHaskell columns output
  =>
  Connection -> ChString -> ([output] -> IO result) -> IO [result]
select :: forall (columns :: [*]) output result.
ClickHaskell columns output =>
Connection -> ChString -> ([output] -> IO result) -> IO [result]
select Connection
conn ChString
query [output] -> IO result
f = do
  Connection -> (ConnectionState -> IO [result]) -> IO [result]
forall a.
HasCallStack =>
Connection -> (ConnectionState -> IO a) -> IO a
withConnection Connection
conn ((ConnectionState -> IO [result]) -> IO [result])
-> (ConnectionState -> IO [result]) -> IO [result]
forall a b. (a -> b) -> a -> b
$ \ConnectionState
connState -> do
    ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
connState (ConnectionState -> ChString -> ClientPacket
mkQueryPacket ConnectionState
connState ChString
query)
    ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
connState (ChString -> UVarInt -> UVarInt -> ClientPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    forall (columns :: [*]) output result.
ClickHaskell columns output =>
ConnectionState -> ([output] -> IO result) -> IO [result]
handleSelect @columns ConnectionState
connState (\[output]
x -> result -> result
forall a. a -> a
id (result -> result) -> IO result -> IO result
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> [output] -> IO result
f [output]
x)

selectFrom ::
  forall table output result
  .
  ClickHaskellTable table output
  =>
  Connection -> ([output] -> IO result) -> IO [result]
selectFrom :: forall table output result.
ClickHaskellTable table output =>
Connection -> ([output] -> IO result) -> IO [result]
selectFrom Connection
conn [output] -> IO result
f = forall (columns :: [*]) output result.
ClickHaskell columns output =>
Connection -> ChString -> ([output] -> IO result) -> IO [result]
select @(GetColumns table) Connection
conn ChString
query [output] -> IO result
f
  where
  query :: ChString
query = Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$
    Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) record.
ClickHaskell columns record =>
Builder
columns @(GetColumns table) @output Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall table. KnownSymbol (GetTableName table) => Builder
tableName @table

selectFromView ::
  forall view output result parameters
  .
  ClickHaskellView view output
  =>
  Connection -> (Parameters '[] -> Parameters parameters) -> ([output] -> IO result) -> IO [result]
selectFromView :: forall view output result (parameters :: [*]).
ClickHaskellView view output =>
Connection
-> (Parameters '[] -> Parameters parameters)
-> ([output] -> IO result)
-> IO [result]
selectFromView Connection
conn Parameters '[] -> Parameters parameters
interpreter [output] -> IO result
f = forall (columns :: [*]) output result.
ClickHaskell columns output =>
Connection -> ChString -> ([output] -> IO result) -> IO [result]
select @(GetColumns view) Connection
conn ChString
query [output] -> IO result
f
  where
  query :: ChString
query = Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$
    Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) record.
ClickHaskell columns record =>
Builder
columns @(GetColumns view) @output Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall table. KnownSymbol (GetTableName table) => Builder
tableName @view Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Parameters '[] -> Parameters parameters) -> Builder
forall (passedParameters :: [*]).
(Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters Parameters '[] -> Parameters parameters
interpreter

generateRandom ::
  forall columns output result
  .
  ClickHaskell columns output
  =>
  Connection -> (UInt64, UInt64, UInt64) -> UInt64 -> ([output] -> IO result) -> IO [result]
generateRandom :: forall (columns :: [*]) output result.
ClickHaskell columns output =>
Connection
-> (UInt64, UInt64, UInt64)
-> UInt64
-> ([output] -> IO result)
-> IO [result]
generateRandom Connection
conn (UInt64
randomSeed, UInt64
maxStrLen, UInt64
maxArrayLen) UInt64
limit [output] -> IO result
f = forall (columns :: [*]) output result.
ClickHaskell columns output =>
Connection -> ChString -> ([output] -> IO result) -> IO [result]
select @columns Connection
conn ChString
query [output] -> IO result
f
  where
  query :: ChString
query = Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$
    Builder
"SELECT * FROM generateRandom(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) record.
ClickHaskell columns record =>
Builder
readingColumnsAndTypes @columns @output Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"' ," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          UInt64 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart UInt64
randomSeed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          UInt64 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart UInt64
maxStrLen Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          UInt64 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart UInt64
maxArrayLen Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
")" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
" LIMIT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> UInt64 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart UInt64
limit Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"

-- | Internal
handleSelect ::
  forall columns output result
  .
  ClickHaskell columns output
  =>
  ConnectionState -> ([output] -> IO result) -> IO [result]
handleSelect :: forall (columns :: [*]) output result.
ClickHaskell columns output =>
ConnectionState -> ([output] -> IO result) -> IO [result]
handleSelect MkConnectionState{ProtocolRevision
ChString
ConnectionArgs
Buffer
creds :: ConnectionState -> ConnectionArgs
buffer :: ConnectionState -> Buffer
user :: ConnectionState -> ChString
revision :: ConnectionState -> ProtocolRevision
os_user :: ConnectionState -> ChString
hostname :: ConnectionState -> ChString
user :: ChString
hostname :: ChString
os_user :: ChString
buffer :: Buffer
revision :: ProtocolRevision
creds :: ConnectionArgs
..} [output] -> IO result
f = [result] -> IO [result]
loop []
  where
  loop :: [result] -> IO [result]
loop [result]
acc =
    Buffer -> Get ServerPacket -> IO ServerPacket
forall a. Buffer -> Get a -> IO a
readBuffer Buffer
buffer (ProtocolRevision -> Get ServerPacket
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision)
    IO ServerPacket -> (ServerPacket -> IO [result]) -> IO [result]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ServerPacket
packet -> case ServerPacket
packet of
      DataResponse MkDataPacket{columns_count :: DataPacket -> UVarInt
columns_count = UVarInt
0, rows_count :: DataPacket -> UVarInt
rows_count = UVarInt
0} -> [result] -> IO [result]
loop [result]
acc
      DataResponse MkDataPacket{UVarInt
columns_count :: DataPacket -> UVarInt
columns_count :: UVarInt
columns_count, UVarInt
rows_count :: DataPacket -> UVarInt
rows_count :: UVarInt
rows_count} -> do
        let expected :: UVarInt
expected = forall (columns :: [*]) record.
ClickHaskell columns record =>
UVarInt
columnsCount @columns @output
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UVarInt
columns_count UVarInt -> UVarInt -> Bool
forall a. Eq a => a -> a -> Bool
/= UVarInt
expected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          (ClientError -> IO ()
forall a e. Exception e => e -> a
throw (ClientError -> IO ())
-> (ServiceName -> ClientError) -> ServiceName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => UserError -> ClientError
UserError -> ClientError
UnmatchedResult (UserError -> ClientError)
-> (ServiceName -> UserError) -> ServiceName -> ClientError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> UserError
UnmatchedColumnsCount)
            (ServiceName
"Expected " ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> UVarInt -> ServiceName
forall a. Show a => a -> ServiceName
show UVarInt
expected ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> ServiceName
" columns but got " ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> UVarInt -> ServiceName
forall a. Show a => a -> ServiceName
show UVarInt
columns_count)
        result
result <- [output] -> IO result
f ([output] -> IO result) -> IO [output] -> IO result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Buffer -> Get [output] -> IO [output]
forall a. Buffer -> Get a -> IO a
readBuffer Buffer
buffer (forall (columns :: [*]) record.
ClickHaskell columns record =>
Bool -> ProtocolRevision -> UVarInt -> Get [record]
deserializeColumns @columns Bool
True ProtocolRevision
revision UVarInt
rows_count)
        [result] -> IO [result]
loop (result
result result -> [result] -> [result]
forall a. a -> [a] -> [a]
: [result]
acc)
      Progress    ProgressPacket
_       -> [result] -> IO [result]
loop [result]
acc
      ProfileInfo ProfileInfo
_       -> [result] -> IO [result]
loop [result]
acc
      ServerPacket
EndOfStream         -> [result] -> IO [result]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [result]
acc
      Exception ExceptionPacket
exception -> ClientError -> IO [result]
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
      ServerPacket
otherPacket         -> ClientError -> IO [result]
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => InternalError -> ClientError
InternalError -> ClientError
InternalError (InternalError -> ClientError) -> InternalError -> ClientError
forall a b. (a -> b) -> a -> b
$ UVarInt -> InternalError
UnexpectedPacketType (UVarInt -> InternalError) -> UVarInt -> InternalError
forall a b. (a -> b) -> a -> b
$ ServerPacket -> UVarInt
serverPacketToNum ServerPacket
otherPacket)


-- ** INSERT

insertInto ::
  forall table record
  .
  ClickHaskellTable table record
  =>
  Connection -> [record] -> IO ()
insertInto :: forall table record.
ClickHaskellTable table record =>
Connection -> [record] -> IO ()
insertInto Connection
conn [record]
columnsData = do
  Connection -> (ConnectionState -> IO ()) -> IO ()
forall a.
HasCallStack =>
Connection -> (ConnectionState -> IO a) -> IO a
withConnection Connection
conn ((ConnectionState -> IO ()) -> IO ())
-> (ConnectionState -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConnectionState
connState -> do
    ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
connState (ConnectionState -> ChString -> ClientPacket
mkQueryPacket ConnectionState
connState ChString
query)
    ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
connState (ChString -> UVarInt -> UVarInt -> ClientPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    forall (columns :: [*]) record.
ClickHaskell columns record =>
ConnectionState -> [record] -> IO ()
handleInsertResult @(GetColumns table) ConnectionState
connState [record]
columnsData
  where
  query :: ChString
query = Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (Builder -> ChString) -> Builder -> ChString
forall a b. (a -> b) -> a -> b
$
    Builder
"INSERT INTO " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall table. KnownSymbol (GetTableName table) => Builder
tableName @table
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) record.
ClickHaskell columns record =>
Builder
columns @(GetColumns table) @record Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") VALUES"

-- | Internal
handleInsertResult :: forall columns record . ClickHaskell columns record => ConnectionState -> [record] -> IO ()
handleInsertResult :: forall (columns :: [*]) record.
ClickHaskell columns record =>
ConnectionState -> [record] -> IO ()
handleInsertResult conn :: ConnectionState
conn@MkConnectionState{ProtocolRevision
ChString
ConnectionArgs
Buffer
creds :: ConnectionState -> ConnectionArgs
buffer :: ConnectionState -> Buffer
user :: ConnectionState -> ChString
revision :: ConnectionState -> ProtocolRevision
os_user :: ConnectionState -> ChString
hostname :: ConnectionState -> ChString
user :: ChString
hostname :: ChString
os_user :: ChString
buffer :: Buffer
revision :: ProtocolRevision
creds :: ConnectionArgs
..} [record]
records = do
  ServerPacket
firstPacket <- Buffer -> Get ServerPacket -> IO ServerPacket
forall a. Buffer -> Get a -> IO a
readBuffer Buffer
buffer (ProtocolRevision -> Get ServerPacket
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision)
  case ServerPacket
firstPacket of
    TableColumns      TableColumns
_ -> forall (columns :: [*]) record.
ClickHaskell columns record =>
ConnectionState -> [record] -> IO ()
handleInsertResult @columns ConnectionState
conn [record]
records
    DataResponse MkDataPacket{} -> do
      [record]
_emptyDataPacket <- Buffer -> Get [record] -> IO [record]
forall a. Buffer -> Get a -> IO a
readBuffer Buffer
buffer (forall (columns :: [*]) record.
ClickHaskell columns record =>
Bool -> ProtocolRevision -> UVarInt -> Get [record]
deserializeColumns @columns @record Bool
False ProtocolRevision
revision UVarInt
0)
      ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
conn (ChString -> UVarInt -> UVarInt -> ClientPacket
mkDataPacket ChString
"" (forall (columns :: [*]) record.
ClickHaskell columns record =>
UVarInt
columnsCount @columns @record) (Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> Int -> UVarInt
forall a b. (a -> b) -> a -> b
$ [record] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [record]
records))
      ConnectionState -> (ProtocolRevision -> Builder) -> IO ()
writeToConnectionEncode ConnectionState
conn (forall (columns :: [*]) record.
ClickHaskell columns record =>
[record] -> ProtocolRevision -> Builder
serializeRecords @columns [record]
records)
      ConnectionState -> ClientPacket -> IO ()
forall packet.
Serializable packet =>
ConnectionState -> packet -> IO ()
writeToConnection ConnectionState
conn (ChString -> UVarInt -> UVarInt -> ClientPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
      forall (columns :: [*]) record.
ClickHaskell columns record =>
ConnectionState -> [record] -> IO ()
handleInsertResult @columns @record ConnectionState
conn []
    ServerPacket
EndOfStream         -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Exception ExceptionPacket
exception -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
    ServerPacket
otherPacket         -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => InternalError -> ClientError
InternalError -> ClientError
InternalError (InternalError -> ClientError) -> InternalError -> ClientError
forall a b. (a -> b) -> a -> b
$ UVarInt -> InternalError
UnexpectedPacketType (UVarInt -> InternalError) -> UVarInt -> InternalError
forall a b. (a -> b) -> a -> b
$ ServerPacket -> UVarInt
serverPacketToNum ServerPacket
otherPacket)

-- ** Common parts

type family GetTableName table :: Symbol
type instance (GetTableName (Table name columns)) = name
type instance (GetTableName (View name columns params)) = name

type family GetColumns table :: [Type]
type instance (GetColumns (Table name columns)) = columns
type instance GetColumns (View name columns params) = columns

tableName :: forall table . KnownSymbol (GetTableName table) => Builder
tableName :: forall table. KnownSymbol (GetTableName table) => Builder
tableName = (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (ServiceName -> StrictByteString) -> ServiceName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack) (Proxy (GetTableName table) -> ServiceName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ServiceName
symbolVal (Proxy (GetTableName table) -> ServiceName)
-> Proxy (GetTableName table) -> ServiceName
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(GetTableName table))

class IsTable table

-- | Type wrapper for statements generation
data Table (name :: Symbol) (columns :: [Type])
instance IsTable (Table name columns) where

type ClickHaskellTable table record =
  ( IsTable table
  , KnownSymbol (GetTableName table)
  , ClickHaskell (GetColumns table) record
  )


class IsView view

-- | Type wrapper for statements generation
data View (name :: Symbol) (columns :: [Type]) (parameters :: [Type])
instance IsView (View name columns parameters)

type ClickHaskellView view record =
  ( IsView view
  , KnownSymbol (GetTableName view)
  , ClickHaskell (GetColumns view) record
  )

mkQueryPacket :: ConnectionState -> ChString -> ClientPacket
mkQueryPacket :: ConnectionState -> ChString -> ClientPacket
mkQueryPacket MkConnectionState{ProtocolRevision
ChString
ConnectionArgs
Buffer
creds :: ConnectionState -> ConnectionArgs
buffer :: ConnectionState -> Buffer
user :: ConnectionState -> ChString
revision :: ConnectionState -> ProtocolRevision
os_user :: ConnectionState -> ChString
hostname :: ConnectionState -> ChString
user :: ChString
hostname :: ChString
os_user :: ChString
buffer :: Buffer
revision :: ProtocolRevision
creds :: ConnectionArgs
..} ChString
query = QueryPacket -> ClientPacket
Query
  MkQueryPacket
  { query_id :: ChString
query_id = ChString
""
  , client_info :: SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
client_info                    = ClientInfo
-> SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision MkClientInfo
    { query_kind :: QueryKind
query_kind                   = QueryKind
InitialQuery
    , initial_user :: ChString
initial_user                 = ChString
user
    , initial_query_id :: ChString
initial_query_id             = ChString
""
    , initial_adress :: ChString
initial_adress               = ChString
"0.0.0.0:0"
    , initial_time :: SinceRevision
  Int64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
initial_time                 = Int64
-> SinceRevision
     Int64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision Int64
0
    , interface_type :: UInt8
interface_type               = UInt8
1 -- [tcp - 1, http - 2]
    , ChString
os_user :: ChString
os_user :: ChString
os_user, ChString
hostname :: ChString
hostname :: ChString
hostname
    , client_name :: ChString
client_name                  = ChString
clientName
    , client_version_major :: UVarInt
client_version_major         = UVarInt
major
    , client_version_minor :: UVarInt
client_version_minor         = UVarInt
minor
    , client_revision :: ProtocolRevision
client_revision              = ProtocolRevision
revision
    , quota_key :: SinceRevision
  ChString DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
quota_key                    = ChString
-> SinceRevision
     ChString DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
    , distrubuted_depth :: SinceRevision
  UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
distrubuted_depth            = UVarInt
-> SinceRevision
     UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , client_version_patch :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_patch         = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
patch
    , open_telemetry :: SinceRevision UInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
open_telemetry               = UInt8 -> SinceRevision UInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UInt8
0
    , collaborate_with_initiator :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
collaborate_with_initiator   = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , count_participating_replicas :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
count_participating_replicas = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , number_of_current_replica :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
number_of_current_replica    = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    }
  , settings :: DbSettings
settings           = DbSettings
MkDbSettings
  , interserver_secret :: SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
interserver_secret = ChString
-> SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
  , query_stage :: QueryStage
query_stage        = QueryStage
Complete
  , compression :: UVarInt
compression        = UVarInt
0
  , ChString
query :: ChString
query :: ChString
query
  , parameters :: SinceRevision
  QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
parameters         = QueryParameters
-> SinceRevision
     QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision QueryParameters
MkQueryParameters
  }

mkHelloPacket :: Text -> Text -> Text -> ClientPacket
mkHelloPacket :: Text -> Text -> Text -> ClientPacket
mkHelloPacket Text
db Text
user Text
pass = HelloPacket -> ClientPacket
Hello
  MkHelloPacket
    { client_name :: ChString
client_name          = ChString
clientName
    , client_version_major :: UVarInt
client_version_major = UVarInt
major
    , client_version_minor :: UVarInt
client_version_minor = UVarInt
minor
    , tcp_protocol_version :: ProtocolRevision
tcp_protocol_version = ProtocolRevision
latestSupportedRevision
    , default_database :: ChString
default_database     = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
db
    , user :: ChString
user                 = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
user
    , pass :: ChString
pass                 = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
pass
    }

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








-- * Errors handling

{- |
  A wrapper for all client-related errors
-}
data ClientError where
  UnmatchedResult :: HasCallStack => UserError -> ClientError
  DatabaseException :: HasCallStack => ExceptionPacket -> ClientError
    -- ^ Database responded with an exception packet
  InternalError :: HasCallStack => InternalError -> ClientError
  deriving anyclass (Show ClientError
Typeable ClientError
(Typeable ClientError, Show ClientError) =>
(ClientError -> SomeException)
-> (SomeException -> Maybe ClientError)
-> (ClientError -> ServiceName)
-> Exception ClientError
SomeException -> Maybe ClientError
ClientError -> ServiceName
ClientError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> ServiceName) -> Exception e
$ctoException :: ClientError -> SomeException
toException :: ClientError -> SomeException
$cfromException :: SomeException -> Maybe ClientError
fromException :: SomeException -> Maybe ClientError
$cdisplayException :: ClientError -> ServiceName
displayException :: ClientError -> ServiceName
Exception)

instance Show ClientError where
  show :: ClientError -> ServiceName
show (UnmatchedResult UserError
err) = ServiceName
"UserError " ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> UserError -> ServiceName
forall a. Show a => a -> ServiceName
show UserError
err ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> ServiceName
"\n" ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> CallStack -> ServiceName
prettyCallStack CallStack
HasCallStack => CallStack
callStack
  show (DatabaseException ExceptionPacket
err) = ServiceName
"DatabaseException " ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> ExceptionPacket -> ServiceName
forall a. Show a => a -> ServiceName
show ExceptionPacket
err ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> ServiceName
"\n" ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> CallStack -> ServiceName
prettyCallStack CallStack
HasCallStack => CallStack
callStack
  show (InternalError InternalError
err) = ServiceName
"InternalError " ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> InternalError -> ServiceName
forall a. Show a => a -> ServiceName
show InternalError
err ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> ServiceName
"\n" ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> CallStack -> ServiceName
prettyCallStack CallStack
HasCallStack => CallStack
callStack









-- * Deserialization

-- ** Generic API

type GenericClickHaskell record hasColumns =
  ( Generic record
  , GClickHaskell hasColumns (Rep record)
  )

class ClickHaskell columns record
  where
  default deserializeColumns :: GenericClickHaskell record columns => Bool -> ProtocolRevision -> UVarInt -> Get [record]
  deserializeColumns :: Bool -> ProtocolRevision -> UVarInt -> Get [record]
  deserializeColumns Bool
isCheckRequired ProtocolRevision
rev UVarInt
size = (Rep record Any -> record
forall a x. Generic a => Rep a x -> a
forall x. Rep record x -> record
to (Rep record Any -> record) -> [Rep record Any] -> [record]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) ([Rep record Any] -> [record])
-> Get [Rep record Any] -> Get [record]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (columns :: [*]) (f :: * -> *) p.
GClickHaskell columns f =>
Bool -> ProtocolRevision -> UVarInt -> Get [f p]
gFromColumns @columns Bool
isCheckRequired ProtocolRevision
rev UVarInt
size

  default columns :: GenericClickHaskell record columns => Builder
  columns :: Builder
  columns = [(Builder, Builder)] -> Builder
forall {a} {b}. (Monoid a, IsString a) => [(a, b)] -> a
buildCols (forall (columns :: [*]) (f :: * -> *).
GClickHaskell columns f =>
[(Builder, Builder)]
gReadingColumns @columns @(Rep record))
    where
    buildCols :: [(a, b)] -> a
buildCols [] = a
forall a. Monoid a => a
mempty
    buildCols ((a
col, b
_):[])   = a
col
    buildCols ((a
col, b
_):[(a, b)]
rest) = a
col a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
", " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> [(a, b)] -> a
buildCols [(a, b)]
rest

  default readingColumnsAndTypes :: GenericClickHaskell record columns => Builder
  readingColumnsAndTypes ::  Builder
  readingColumnsAndTypes = [(Builder, Builder)] -> Builder
forall {a}. (Monoid a, IsString a) => [(a, a)] -> a
buildColsTypes (forall (columns :: [*]) (f :: * -> *).
GClickHaskell columns f =>
[(Builder, Builder)]
gReadingColumns @columns @(Rep record))
    where
    buildColsTypes :: [(a, a)] -> a
buildColsTypes [] = a
forall a. Monoid a => a
mempty
    buildColsTypes ((a
col, a
typ):[])   = a
col a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
typ
    buildColsTypes ((a
col, a
typ):[(a, a)]
rest) = a
col a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
typ a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
", " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> [(a, a)] -> a
buildColsTypes [(a, a)]
rest

  default serializeRecords :: GenericClickHaskell record columns => [record] -> ProtocolRevision -> Builder
  serializeRecords :: [record] -> ProtocolRevision -> Builder
  serializeRecords [record]
records ProtocolRevision
rev = forall (columns :: [*]) (f :: * -> *) p.
GClickHaskell columns f =>
ProtocolRevision -> [f p] -> Builder
gSerializeRecords @columns ProtocolRevision
rev (record -> Rep record Any
forall x. record -> Rep record x
forall a x. Generic a => a -> Rep a x
from (record -> Rep record Any) -> [record] -> [Rep record Any]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> [record]
records)

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

class GClickHaskell (columns :: [Type]) f
  where
  gFromColumns :: Bool -> ProtocolRevision -> UVarInt -> Get [f p]
  gReadingColumns :: [(Builder, Builder)]
  gSerializeRecords :: ProtocolRevision -> [f p] -> Builder
  gColumnsCount :: UVarInt

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

instance
  (GClickHaskell columns left, GClickHaskell columns right)
  =>
  GClickHaskell columns (left :*: right)
  where
  {-# INLINE gFromColumns #-}
  gFromColumns :: forall p.
Bool -> ProtocolRevision -> UVarInt -> Get [(:*:) left right p]
gFromColumns Bool
isCheckRequired ProtocolRevision
rev UVarInt
size = do
    ([left p] -> [right p] -> [(:*:) left right p])
-> Get [left p] -> Get [right p] -> Get [(:*:) left right p]
forall a b c. (a -> b -> c) -> Get a -> Get b -> Get c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((left p -> right p -> (:*:) left right p)
-> [left p] -> [right p] -> [(:*:) left right p]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith left p -> right p -> (:*:) left right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:))
      (forall (columns :: [*]) (f :: * -> *) p.
GClickHaskell columns f =>
Bool -> ProtocolRevision -> UVarInt -> Get [f p]
gFromColumns @columns @left Bool
isCheckRequired ProtocolRevision
rev UVarInt
size)
      (forall (columns :: [*]) (f :: * -> *) p.
GClickHaskell columns f =>
Bool -> ProtocolRevision -> UVarInt -> Get [f p]
gFromColumns @columns @right Bool
isCheckRequired ProtocolRevision
rev UVarInt
size)
  gReadingColumns :: [(Builder, Builder)]
gReadingColumns = forall (columns :: [*]) (f :: * -> *).
GClickHaskell columns f =>
[(Builder, Builder)]
gReadingColumns @columns @left [(Builder, Builder)]
-> [(Builder, Builder)] -> [(Builder, Builder)]
forall a. [a] -> [a] -> [a]
++ forall (columns :: [*]) (f :: * -> *).
GClickHaskell columns f =>
[(Builder, Builder)]
gReadingColumns @columns @right
  {-# INLINE gSerializeRecords #-}
  gSerializeRecords :: forall p. ProtocolRevision -> [(:*:) left right p] -> Builder
gSerializeRecords ProtocolRevision
rev [(:*:) left right p]
xs =
    (\([left p]
ls,[right p]
rs) -> forall (columns :: [*]) (f :: * -> *) p.
GClickHaskell columns f =>
ProtocolRevision -> [f p] -> Builder
gSerializeRecords @columns ProtocolRevision
rev [left p]
ls Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) (f :: * -> *) p.
GClickHaskell columns f =>
ProtocolRevision -> [f p] -> Builder
gSerializeRecords @columns ProtocolRevision
rev [right p]
rs)
      (((:*:) left right p
 -> ([left p], [right p]) -> ([left p], [right p]))
-> ([left p], [right p])
-> [(:*:) left right p]
-> ([left p], [right p])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(left p
l :*: right p
r) ([left p]
accL, [right p]
accR) -> (left p
lleft p -> [left p] -> [left p]
forall a. a -> [a] -> [a]
:[left p]
accL, right p
rright p -> [right p] -> [right p]
forall a. a -> [a] -> [a]
:[right p]
accR)) ([], []) [(:*:) left right p]
xs)
  gColumnsCount :: UVarInt
gColumnsCount = forall (columns :: [*]) (f :: * -> *).
GClickHaskell columns f =>
UVarInt
gColumnsCount @columns @left UVarInt -> UVarInt -> UVarInt
forall a. Num a => a -> a -> a
+ forall (columns :: [*]) (f :: * -> *).
GClickHaskell columns f =>
UVarInt
gColumnsCount @columns @right


instance
  ( KnownColumn (Column name chType)
  , SerializableColumn (Column name chType)
  , FromChType chType inputType
  , ToChType chType inputType
  , Column name chType ~ TakeColumn name columns
  ) => GClickHaskell columns ((S1 (MetaSel (Just name) a b f)) (Rec0 inputType))
  where
  {-# INLINE gFromColumns #-}
  gFromColumns :: forall p.
Bool
-> ProtocolRevision
-> UVarInt
-> Get [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
gFromColumns Bool
isCheckRequired ProtocolRevision
rev UVarInt
size =
    (UserError
 -> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p])
-> (Column name chType
    -> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p])
-> Either UserError (Column name chType)
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ClientError
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall a e. Exception e => e -> a
throw (ClientError
 -> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p])
-> (UserError -> ClientError)
-> UserError
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => UserError -> ClientError
UserError -> ClientError
UnmatchedResult) ((chType -> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p)
-> [chType]
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall a b. (a -> b) -> [a] -> [b]
map (Rec0 inputType p
-> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 inputType p
 -> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p)
-> (chType -> Rec0 inputType p)
-> chType
-> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. inputType -> Rec0 inputType p
forall k i c (p :: k). c -> K1 i c p
K1 (inputType -> Rec0 inputType p)
-> (chType -> inputType) -> chType -> Rec0 inputType p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @chType) ([chType] -> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p])
-> (Column name chType -> [chType])
-> Column name chType
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column name chType -> [chType]
forall (name :: Symbol) chType. Column name chType -> [chType]
columnValues)
      (Either UserError (Column name chType)
 -> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p])
-> Get (Either UserError (Column name chType))
-> Get [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall column.
SerializableColumn column =>
ProtocolRevision
-> Bool -> UVarInt -> Get (Either UserError column)
deserializeColumn @(Column name chType) ProtocolRevision
rev Bool
isCheckRequired UVarInt
size
  gReadingColumns :: [(Builder, Builder)]
gReadingColumns = (forall column. KnownColumn column => Builder
renderColumnName @(Column name chType), forall column. KnownColumn column => Builder
renderColumnType @(Column name chType)) (Builder, Builder) -> [(Builder, Builder)] -> [(Builder, Builder)]
forall a. a -> [a] -> [a]
: []
  {-# INLINE gSerializeRecords #-}
  gSerializeRecords :: forall p.
ProtocolRevision
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p] -> Builder
gSerializeRecords ProtocolRevision
rev = ProtocolRevision -> Column name chType -> Builder
forall column.
SerializableColumn column =>
ProtocolRevision -> column -> Builder
serializeColumn ProtocolRevision
rev (Column name chType -> Builder)
-> ([S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
    -> Column name chType)
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall column.
KnownColumn column =>
[GetColumnType column]
-> Column (GetColumnName column) (GetColumnType column)
mkColumn @(Column name chType) ([chType] -> Column name chType)
-> ([S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
    -> [chType])
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
-> Column name chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p -> chType)
-> [S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p]
-> [chType]
forall a b. (a -> b) -> [a] -> [b]
map (inputType -> chType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (inputType -> chType)
-> (S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
    -> inputType)
-> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
-> chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R inputType p -> inputType
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R inputType p -> inputType)
-> (S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
    -> K1 R inputType p)
-> S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
-> inputType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel ('Just name) a b f) (Rec0 inputType) p
-> K1 R inputType p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1)
  gColumnsCount :: UVarInt
gColumnsCount = UVarInt
1


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

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


-- ** FromChType

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

instance FromChType UUID (Word64, Word64) where fromChType :: UUID -> (UInt64, UInt64)
fromChType (MkUUID (Word128 UInt64
w64hi UInt64
w64lo)) = (UInt64
w64hi, UInt64
w64lo)
instance {-# OVERLAPPABLE #-} (IsChType chType, chType ~ inputType) => FromChType chType inputType where fromChType :: chType -> inputType
fromChType = chType -> chType
chType -> inputType
forall a. a -> a
id
instance FromChType (DateTime tz) Word32     where fromChType :: DateTime tz -> Word32
fromChType = DateTime tz -> Word32
forall a b. Coercible a b => a -> b
coerce
instance FromChType (DateTime tz) UTCTime    where fromChType :: DateTime tz -> UTCTime
fromChType (MkDateTime Word32
w32) = POSIXTime -> UTCTime
posixSecondsToUTCTime (Word32 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32)
instance FromChType (DateTime64 precision tz) Word64 where fromChType :: DateTime64 precision tz -> UInt64
fromChType = DateTime64 precision tz -> UInt64
forall a b. Coercible a b => a -> b
coerce
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)
instance FromChType chType (LowCardinality chType) where
  fromChType :: chType -> LowCardinality chType
fromChType = chType -> LowCardinality chType
forall chType. chType -> LowCardinality chType
MkLowCardinality
instance FromChType Date Word16 where fromChType :: Date -> Word16
fromChType = Date -> Word16
forall a b. Coercible a b => a -> b
coerce
instance
  FromChType chType outputType
  =>
  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 FromChType ChString BS.ByteString where fromChType :: ChString -> StrictByteString
fromChType (MkChString StrictByteString
string) = StrictByteString
string
instance FromChType ChString Builder where fromChType :: ChString -> Builder
fromChType (MkChString StrictByteString
string) = StrictByteString -> Builder
byteString StrictByteString
string
instance
  ( TypeError
    (     'Text "ChString to Text using FromChType convertion could cause exception"
    ':$$: 'Text "Decode ByteString manually if you are sure it's always can be decoded or replace it with ByteString"
    )
  ) =>
  FromChType ChString Text
  where
  fromChType :: ChString -> Text
fromChType = ServiceName -> ChString -> Text
forall a. HasCallStack => ServiceName -> a
error ServiceName
"Unreachable"
instance FromChType chType inputType => FromChType (Array chType) [inputType]
  where
  fromChType :: Array chType -> [inputType]
fromChType (MkChArray [chType]
values) = (chType -> inputType) -> [chType] -> [inputType]
forall a b. (a -> b) -> [a] -> [b]
map chType -> inputType
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType [chType]
values








-- * Parameters

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

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

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

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

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


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

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

    
class ToQueryPart chType where toQueryPart :: chType -> Builder
instance ToQueryPart Int8 where toQueryPart :: Int8 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int8 -> StrictByteString) -> Int8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Int8 -> ServiceName) -> Int8 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart Int16 where toQueryPart :: Int16 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int16 -> StrictByteString) -> Int16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Int16 -> ServiceName) -> Int16 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart Int32 where toQueryPart :: Int32 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int32 -> StrictByteString) -> Int32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Int32 -> ServiceName) -> Int32 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart Int64 where toQueryPart :: Int64 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int64 -> StrictByteString) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Int64 -> ServiceName) -> Int64 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart Int128 where toQueryPart :: Int128 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Int128 -> StrictByteString) -> Int128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Int128 -> ServiceName) -> Int128 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int128 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart UInt8 where toQueryPart :: UInt8 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt8 -> StrictByteString) -> UInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (UInt8 -> ServiceName) -> UInt8 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt8 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart UInt16 where toQueryPart :: Word16 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Word16 -> StrictByteString) -> Word16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Word16 -> ServiceName) -> Word16 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart UInt32 where toQueryPart :: Word32 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Word32 -> StrictByteString) -> Word32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Word32 -> ServiceName) -> Word32 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart UInt64 where toQueryPart :: UInt64 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (UInt64 -> StrictByteString) -> UInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (UInt64 -> ServiceName) -> UInt64 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt64 -> ServiceName
forall a. Show a => a -> ServiceName
show
instance ToQueryPart UInt128 where toQueryPart :: Word128 -> Builder
toQueryPart = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Word128 -> StrictByteString) -> Word128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Word128 -> ServiceName) -> Word128 -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word128 -> ServiceName
forall a. Show a => a -> ServiceName
show
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 ToQueryPart chType => ToQueryPart (LowCardinality chType)
  where
  toQueryPart :: LowCardinality chType -> Builder
toQueryPart (MkLowCardinality chType
chType) = chType -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart chType
chType
instance ToQueryPart UUID where
  toQueryPart :: UUID -> Builder
toQueryPart (MkUUID (Word128 UInt64
hi UInt64
lo)) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [Builder
"'", Int -> UInt64 -> Builder
p Int
3 UInt64
hi, Int -> UInt64 -> Builder
p Int
2 UInt64
hi, Builder
"-", Int -> UInt64 -> Builder
p Int
1 UInt64
hi, Builder
"-", Int -> UInt64 -> Builder
p Int
0 UInt64
hi, Builder
"-", Int -> UInt64 -> Builder
p Int
3 UInt64
lo, Builder
"-", Int -> UInt64 -> Builder
p Int
2 UInt64
lo, Int -> UInt64 -> Builder
p Int
1 UInt64
lo, Int -> UInt64 -> Builder
p Int
0 UInt64
lo, Builder
"'"]
    where
    p :: Int -> Word64 -> Builder
    p :: Int -> UInt64 -> Builder
p Int
shiftN UInt64
word = Word16 -> Builder
word16HexFixed (Word16 -> Builder) -> Word16 -> Builder
forall a b. (a -> b) -> a -> b
$ UInt64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt64
word UInt64 -> Int -> UInt64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
shiftNInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
16))
instance ToQueryPart ChString where
  toQueryPart :: ChString -> Builder
toQueryPart (MkChString StrictByteString
string) =  Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
escapeQuery StrictByteString
string Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"
    where
    escapeQuery :: BS.ByteString -> Builder
    escapeQuery :: StrictByteString -> Builder
escapeQuery = StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (StrictByteString -> StrictByteString)
-> StrictByteString
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> StrictByteString) -> StrictByteString -> StrictByteString
BS8.concatMap (\case Char
'\'' -> StrictByteString
"\\\'"; Char
'\\' -> StrictByteString
"\\\\"; Char
sym -> Char -> StrictByteString
singleton Char
sym;)

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

instance ToQueryPart (DateTime tz)
  where
  toQueryPart :: DateTime tz -> Builder
toQueryPart DateTime tz
chDateTime = let time :: StrictByteString
time = ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (DateTime tz -> ServiceName) -> DateTime tz -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ServiceName
forall a. Show a => a -> ServiceName
show (Word32 -> ServiceName)
-> (DateTime tz -> Word32) -> DateTime tz -> ServiceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @(DateTime tz) @Word32 (DateTime tz -> StrictByteString)
-> DateTime tz -> StrictByteString
forall a b. (a -> b) -> a -> b
$ DateTime tz
chDateTime
    in StrictByteString -> Builder
byteString (Int -> Char -> StrictByteString
BS8.replicate (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- StrictByteString -> Int
BS8.length StrictByteString
time) Char
'0' StrictByteString -> StrictByteString -> StrictByteString
forall a. Semigroup a => a -> a -> a
<> StrictByteString
time)
instance (IsChType chType, ToQueryPart chType) => ToQueryPart (Array chType)
  where
  toQueryPart :: Array chType -> Builder
toQueryPart
    = (\Builder
x -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]")
    (Builder -> Builder)
-> (Array chType -> Builder) -> Array chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
-> ((Builder, [Builder]) -> Builder)
-> Maybe (Builder, [Builder])
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" ((Builder -> [Builder] -> Builder)
-> (Builder, [Builder]) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall 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)
-> (Array chType -> [chType]) -> Array chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @(Array chType) @[chType]








-- ** ToChType

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

instance {-# OVERLAPPABLE #-} (IsChType chType, chType ~ inputType) => ToChType chType inputType where toChType :: inputType -> chType
toChType = inputType -> chType
inputType -> inputType
forall a. a -> a
id
instance ToChType Int64 Int where toChType :: Int -> Int64
toChType = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToChType UInt128 UInt64 where toChType :: UInt64 -> Word128
toChType = UInt64 -> Word128
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToChType ChString BS.ByteString where toChType :: StrictByteString -> ChString
toChType = StrictByteString -> ChString
MkChString
instance ToChType ChString Builder       where toChType :: Builder -> ChString
toChType = StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Builder -> StrictByteString) -> Builder -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> StrictByteString
toStrict (ByteString -> StrictByteString)
-> (Builder -> ByteString) -> Builder -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
instance ToChType ChString String        where toChType :: ServiceName -> ChString
toChType = StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (ServiceName -> StrictByteString) -> ServiceName -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack
instance ToChType ChString Text          where toChType :: Text -> ChString
toChType = StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Text -> StrictByteString) -> Text -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StrictByteString
Text.encodeUtf8
instance ToChType ChString Int           where toChType :: Int -> ChString
toChType = StrictByteString -> ChString
MkChString (StrictByteString -> ChString)
-> (Int -> StrictByteString) -> Int -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> StrictByteString
BS8.pack (ServiceName -> StrictByteString)
-> (Int -> ServiceName) -> Int -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ServiceName
forall a. Show a => a -> ServiceName
show
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 ToChType inputType chType => ToChType (LowCardinality inputType) chType where toChType :: chType -> LowCardinality inputType
toChType = inputType -> LowCardinality inputType
forall chType. chType -> LowCardinality chType
MkLowCardinality (inputType -> LowCardinality inputType)
-> (chType -> inputType) -> chType -> LowCardinality inputType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> inputType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType
instance ToChType UUID Word64 where toChType :: UInt64 -> UUID
toChType = Word128 -> UUID
MkUUID (Word128 -> UUID) -> (UInt64 -> Word128) -> UInt64 -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt64 -> UInt64 -> Word128) -> UInt64 -> UInt64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip UInt64 -> UInt64 -> Word128
Word128 UInt64
0
instance ToChType UUID (Word64, Word64) where toChType :: (UInt64, UInt64) -> UUID
toChType = Word128 -> UUID
MkUUID (Word128 -> UUID)
-> ((UInt64, UInt64) -> Word128) -> (UInt64, UInt64) -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt64 -> UInt64 -> Word128) -> (UInt64, UInt64) -> Word128
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((UInt64 -> UInt64 -> Word128) -> UInt64 -> UInt64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip UInt64 -> UInt64 -> Word128
Word128)
instance ToChType (DateTime tz) Word32     where toChType :: Word32 -> DateTime tz
toChType = Word32 -> DateTime tz
forall (tz :: Symbol). Word32 -> DateTime tz
MkDateTime
instance ToChType (DateTime tz) UTCTime    where toChType :: UTCTime -> DateTime tz
toChType = Word32 -> DateTime tz
forall (tz :: Symbol). Word32 -> DateTime tz
MkDateTime (Word32 -> DateTime tz)
-> (UTCTime -> Word32) -> UTCTime -> DateTime tz
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 (DateTime tz) ZonedTime  where toChType :: ZonedTime -> DateTime tz
toChType = Word32 -> DateTime tz
forall (tz :: Symbol). Word32 -> DateTime tz
MkDateTime (Word32 -> DateTime tz)
-> (ZonedTime -> Word32) -> ZonedTime -> DateTime tz
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 ToChType (DateTime64 precision tz) Word64 where toChType :: UInt64 -> DateTime64 precision tz
toChType = UInt64 -> DateTime64 precision tz
forall (precision :: Nat) (tz :: Symbol).
UInt64 -> DateTime64 precision tz
MkDateTime64
instance ToChType Date Word16 where toChType :: Word16 -> Date
toChType = Word16 -> Date
MkDate
instance ToChType chType inputType => ToChType (Array chType) [inputType]
  where
  toChType :: [inputType] -> Array chType
toChType = [chType] -> Array chType
forall a. [a] -> Array a
MkChArray ([chType] -> Array chType)
-> ([inputType] -> [chType]) -> [inputType] -> Array chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (inputType -> chType) -> [inputType] -> [chType]
forall a b. (a -> b) -> [a] -> [b]
map inputType -> chType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType