module Database.DuckDB.Query
    ( module Database.DuckDB.Value

      -- * Query
    , query

      -- * Prepare statement
    , prepare
    , destroyPrepare
    , executePrepared

      -- * Prepare statement parameters
    , bindBool
    , bindInt8
    , bindInt16
    , bindInt32
    , bindInt64
    , bindUint8
    , bindUint16
    , bindUint32
    , bindUint64
    , bindFloat
    , bindDouble
    , bindDate
    , bindTime
    , bindTimestamp
    , bindVarChar
    , bindNull
    )
where

import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Int
import Data.Word
import Database.DuckDB.Internal
import Database.DuckDB.Internal.FFI
    ( DuckDBConnection
    , DuckDBPreparedStatement
    )
import Database.DuckDB.Internal.FFI qualified as FFI
import Database.DuckDB.Value
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable

query :: DuckDBConnection -> String -> DuckDBMonad DuckDBResult
query :: DuckDBConnection -> String -> DuckDBMonad (Ptr DuckDBResult)
query DuckDBConnection
conn String
q = do
    Ptr DuckDBResult
result <- forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
q forall a b. (a -> b) -> a -> b
$ \CString
q' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        Ptr DuckDBResult
result <-
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                forall a. CSize -> IO (Ptr a)
FFI.duckdb_malloc (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: FFI.DuckDBResult))
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr DuckDBResult
result forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall a b. (a -> b) -> a -> b
$
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_malloc failed"
        DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBConnection -> CString -> Ptr DuckDBResult -> IO DuckDBState
FFI.duckdb_query DuckDBConnection
conn CString
q' Ptr DuckDBResult
result
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$ do
            String
message <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                CString
p <- Ptr DuckDBResult -> IO CString
FFI.duckdb_result_error Ptr DuckDBResult
result
                CString -> IO String
peekCString CString
p
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                Ptr DuckDBResult -> IO ()
FFI.duckdb_destroy_result Ptr DuckDBResult
result
                forall a. Ptr a -> IO ()
FFI.duckdb_free Ptr DuckDBResult
result
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"duckdb_query failed: " forall a. [a] -> [a] -> [a]
++ String
message
        forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DuckDBResult
result
    forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DuckDBResult
result

prepare :: DuckDBConnection -> String -> DuckDBMonad DuckDBPreparedStatement
prepare :: DuckDBConnection -> String -> DuckDBMonad DuckDBPreparedStatement
prepare DuckDBConnection
conn String
q = do
    DuckDBPreparedStatement
stmt <- forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
q forall a b. (a -> b) -> a -> b
$ \CString
q' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBPreparedStatement
stmt' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBConnection
-> CString -> Ptr DuckDBPreparedStatement -> IO DuckDBState
FFI.duckdb_prepare DuckDBConnection
conn CString
q' Ptr DuckDBPreparedStatement
stmt'
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$ do
            String
message <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                DuckDBPreparedStatement
stmt <- forall a. Storable a => Ptr a -> IO a
peek Ptr DuckDBPreparedStatement
stmt'
                CString
p <- DuckDBPreparedStatement -> IO CString
FFI.duckdb_prepare_error DuckDBPreparedStatement
stmt
                CString -> IO String
peekCString CString
p
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Ptr DuckDBPreparedStatement -> IO ()
FFI.duckdb_destroy_prepare Ptr DuckDBPreparedStatement
stmt'
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"duckdb_prepare failed: " forall a. [a] -> [a] -> [a]
++ String
message
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr DuckDBPreparedStatement
stmt'
    forall (m :: * -> *) a. Monad m => a -> m a
return DuckDBPreparedStatement
stmt

destroyPrepare :: DuckDBPreparedStatement -> DuckDBMonad ()
destroyPrepare :: DuckDBPreparedStatement -> DuckDBMonad ()
destroyPrepare DuckDBPreparedStatement
stmt = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBPreparedStatement
stmt' -> do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBPreparedStatement
stmt' DuckDBPreparedStatement
stmt
        Ptr DuckDBPreparedStatement -> IO ()
FFI.duckdb_destroy_prepare Ptr DuckDBPreparedStatement
stmt'

prepareParameters :: DuckDBPreparedStatement -> DuckDBMonad Int
prepareParameters :: DuckDBPreparedStatement -> DuckDBMonad Int
prepareParameters DuckDBPreparedStatement
stmt = do
    DuckDBIndexType
count <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement -> IO DuckDBIndexType
FFI.duckdb_nparams DuckDBPreparedStatement
stmt
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral DuckDBIndexType
count)

prepareParamType :: DuckDBPreparedStatement -> Int -> DuckDBMonad DuckDBType
prepareParamType :: DuckDBPreparedStatement -> Int -> DuckDBMonad DuckDBState
prepareParamType DuckDBPreparedStatement
stmt Int
idx = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement -> DuckDBIndexType -> IO DuckDBState
FFI.duckdb_param_type DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx)

prepareClearBindings :: DuckDBPreparedStatement -> DuckDBMonad ()
prepareClearBindings :: DuckDBPreparedStatement -> DuckDBMonad ()
prepareClearBindings DuckDBPreparedStatement
stmt = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement -> IO DuckDBState
FFI.duckdb_clear_bindings DuckDBPreparedStatement
stmt
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_clear_bindings failed"

executePrepared :: DuckDBPreparedStatement -> DuckDBMonad DuckDBResult
executePrepared :: DuckDBPreparedStatement -> DuckDBMonad (Ptr DuckDBResult)
executePrepared DuckDBPreparedStatement
stmt = do
    Ptr DuckDBResult
result <-
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            forall a. CSize -> IO (Ptr a)
FFI.duckdb_malloc (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: FFI.DuckDBResult))
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr DuckDBResult
result forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_malloc failed"
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement -> Ptr DuckDBResult -> IO DuckDBState
FFI.duckdb_execute_prepared DuckDBPreparedStatement
stmt Ptr DuckDBResult
result
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$ do
        String
message <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            CString
p <- Ptr DuckDBResult -> IO CString
FFI.duckdb_result_error Ptr DuckDBResult
result
            CString -> IO String
peekCString CString
p
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            Ptr DuckDBResult -> IO ()
FFI.duckdb_destroy_result Ptr DuckDBResult
result
            forall a. Ptr a -> IO ()
FFI.duckdb_free Ptr DuckDBResult
result
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"duckdb_execute_prepared failed: " forall a. [a] -> [a] -> [a]
++ String
message
    forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DuckDBResult
result

bindBool
    :: DuckDBPreparedStatement -> Int -> Bool -> DuckDBMonad ()
bindBool :: DuckDBPreparedStatement -> Int -> Bool -> DuckDBMonad ()
bindBool DuckDBPreparedStatement
stmt Int
idx Bool
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Bool -> IO DuckDBState
FFI.duckdb_bind_boolean DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Bool
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_boolean failed"

bindInt8 :: DuckDBPreparedStatement -> Int -> Int8 -> DuckDBMonad ()
bindInt8 :: DuckDBPreparedStatement -> Int -> Int8 -> DuckDBMonad ()
bindInt8 DuckDBPreparedStatement
stmt Int
idx Int8
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Int8 -> IO DuckDBState
FFI.duckdb_bind_int8 DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Int8
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_int8 failed"

bindInt16 :: DuckDBPreparedStatement -> Int -> Int16 -> DuckDBMonad ()
bindInt16 :: DuckDBPreparedStatement -> Int -> Int16 -> DuckDBMonad ()
bindInt16 DuckDBPreparedStatement
stmt Int
idx Int16
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Int16 -> IO DuckDBState
FFI.duckdb_bind_int16 DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Int16
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_int16 failed"

bindInt32 :: DuckDBPreparedStatement -> Int -> Int32 -> DuckDBMonad ()
bindInt32 :: DuckDBPreparedStatement -> Int -> DuckDBState -> DuckDBMonad ()
bindInt32 DuckDBPreparedStatement
stmt Int
idx DuckDBState
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> DuckDBState -> IO DuckDBState
FFI.duckdb_bind_int32 DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) DuckDBState
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_int32 failed"

bindInt64 :: DuckDBPreparedStatement -> Int -> Int64 -> DuckDBMonad ()
bindInt64 :: DuckDBPreparedStatement -> Int -> Int64 -> DuckDBMonad ()
bindInt64 DuckDBPreparedStatement
stmt Int
idx Int64
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Int64 -> IO DuckDBState
FFI.duckdb_bind_int64 DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Int64
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_int64 failed"

bindUint8 :: DuckDBPreparedStatement -> Int -> Word8 -> DuckDBMonad ()
bindUint8 :: DuckDBPreparedStatement -> Int -> Word8 -> DuckDBMonad ()
bindUint8 DuckDBPreparedStatement
stmt Int
idx Word8
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Word8 -> IO DuckDBState
FFI.duckdb_bind_uint8 DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Word8
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_uint8 failed"

bindUint16 :: DuckDBPreparedStatement -> Int -> Word16 -> DuckDBMonad ()
bindUint16 :: DuckDBPreparedStatement -> Int -> Word16 -> DuckDBMonad ()
bindUint16 DuckDBPreparedStatement
stmt Int
idx Word16
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Word16 -> IO DuckDBState
FFI.duckdb_bind_uint16 DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Word16
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_uint16 failed"

bindUint32 :: DuckDBPreparedStatement -> Int -> Word32 -> DuckDBMonad ()
bindUint32 :: DuckDBPreparedStatement -> Int -> Word32 -> DuckDBMonad ()
bindUint32 DuckDBPreparedStatement
stmt Int
idx Word32
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Word32 -> IO DuckDBState
FFI.duckdb_bind_uint32 DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Word32
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_uint32 failed"

bindUint64 :: DuckDBPreparedStatement -> Int -> Word64 -> DuckDBMonad ()
bindUint64 :: DuckDBPreparedStatement -> Int -> DuckDBIndexType -> DuckDBMonad ()
bindUint64 DuckDBPreparedStatement
stmt Int
idx DuckDBIndexType
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> DuckDBIndexType -> IO DuckDBState
FFI.duckdb_bind_uint64 DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) DuckDBIndexType
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_uint64 failed"

bindFloat :: DuckDBPreparedStatement -> Int -> Float -> DuckDBMonad ()
bindFloat :: DuckDBPreparedStatement -> Int -> Float -> DuckDBMonad ()
bindFloat DuckDBPreparedStatement
stmt Int
idx Float
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Float -> IO DuckDBState
FFI.duckdb_bind_float DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Float
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_float failed"

bindDouble :: DuckDBPreparedStatement -> Int -> Double -> DuckDBMonad ()
bindDouble :: DuckDBPreparedStatement -> Int -> Double -> DuckDBMonad ()
bindDouble DuckDBPreparedStatement
stmt Int
idx Double
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Double -> IO DuckDBState
FFI.duckdb_bind_double DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Double
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_double failed"

bindDate :: DuckDBPreparedStatement -> Int -> DuckDBDate -> DuckDBMonad ()
bindDate :: DuckDBPreparedStatement -> Int -> DuckDBState -> DuckDBMonad ()
bindDate DuckDBPreparedStatement
stmt Int
idx DuckDBState
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> DuckDBState -> IO DuckDBState
FFI.duckdb_bind_date DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) DuckDBState
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_date failed"

bindTime :: DuckDBPreparedStatement -> Int -> DuckDBTime -> DuckDBMonad ()
bindTime :: DuckDBPreparedStatement -> Int -> Int64 -> DuckDBMonad ()
bindTime DuckDBPreparedStatement
stmt Int
idx Int64
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Int64 -> IO DuckDBState
FFI.duckdb_bind_time DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Int64
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_time failed"

bindTimestamp
    :: DuckDBPreparedStatement -> Int -> DuckDBTimestamp -> DuckDBMonad ()
bindTimestamp :: DuckDBPreparedStatement -> Int -> Int64 -> DuckDBMonad ()
bindTimestamp DuckDBPreparedStatement
stmt Int
idx Int64
val = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> Int64 -> IO DuckDBState
FFI.duckdb_bind_timestamp DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Int64
val
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_timestamp failed"

bindVarChar :: DuckDBPreparedStatement -> Int -> String -> DuckDBMonad ()
bindVarChar :: DuckDBPreparedStatement -> Int -> String -> DuckDBMonad ()
bindVarChar DuckDBPreparedStatement
stmt Int
idx String
val = do
    forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
val forall a b. (a -> b) -> a -> b
$ \CString
val' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement
-> DuckDBIndexType -> CString -> IO DuckDBState
FFI.duckdb_bind_varchar DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) CString
val'
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_varchar failed"

bindNull :: DuckDBPreparedStatement -> Int -> DuckDBMonad ()
bindNull :: DuckDBPreparedStatement -> Int -> DuckDBMonad ()
bindNull DuckDBPreparedStatement
stmt Int
idx = do
    DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBPreparedStatement -> DuckDBIndexType -> IO DuckDBState
FFI.duckdb_bind_null DuckDBPreparedStatement
stmt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_bind_null failed"