{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Database.DuckDB.Simple.ToField
Description : Convert Haskell parameters into DuckDB bindable values.

The 'ToField' class mirrors the interface provided by @sqlite-simple@ while
delegating to the DuckDB C API under the hood.
-}
module Database.DuckDB.Simple.ToField (
    FieldBinding,
    ToField (..),
    NamedParam (..),
    bindFieldBinding,
    renderFieldBinding,
) where

import Control.Exception (bracket, throwIO)
import Control.Monad (when)
import qualified Data.ByteString as BS
import Data.Int (Int16, Int32, Int64)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Foreign as TextForeign
import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds)
import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..), timeOfDayToTime, utc, utcToLocalTime)
import Data.Word (Word16, Word32, Word64, Word8)
import Database.DuckDB.FFI
import Database.DuckDB.Simple.Internal (
    SQLError (..),
    Statement (..),
    withStatementHandle,
 )
import Database.DuckDB.Simple.Types (Null (..))
import Foreign.C.String (peekCString)
import Foreign.C.Types (CDouble (..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (poke)

-- | Represents a named parameter binding using the @:=@ operator.
data NamedParam where
    (:=) :: (ToField a) => Text -> a -> NamedParam

infixr 3 :=

-- | Encapsulates the action required to bind a single positional parameter, together with a textual description used in diagnostics.
data FieldBinding = FieldBinding
    { FieldBinding -> Statement -> DuckDBIdx -> IO ()
fieldBindingAction :: !(Statement -> DuckDBIdx -> IO ())
    , FieldBinding -> String
fieldBindingDisplay :: !String
    }

-- | Apply a 'FieldBinding' to the given statement/index.
bindFieldBinding :: Statement -> DuckDBIdx -> FieldBinding -> IO ()
bindFieldBinding :: Statement -> DuckDBIdx -> FieldBinding -> IO ()
bindFieldBinding Statement
stmt DuckDBIdx
idx FieldBinding{Statement -> DuckDBIdx -> IO ()
fieldBindingAction :: FieldBinding -> Statement -> DuckDBIdx -> IO ()
fieldBindingAction :: Statement -> DuckDBIdx -> IO ()
fieldBindingAction} = Statement -> DuckDBIdx -> IO ()
fieldBindingAction Statement
stmt DuckDBIdx
idx

-- | Render a bound parameter for error reporting.
renderFieldBinding :: FieldBinding -> String
renderFieldBinding :: FieldBinding -> String
renderFieldBinding FieldBinding{String
fieldBindingDisplay :: FieldBinding -> String
fieldBindingDisplay :: String
fieldBindingDisplay} = String
fieldBindingDisplay

mkFieldBinding :: String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding :: String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding String
display Statement -> DuckDBIdx -> IO ()
action =
    FieldBinding
        { fieldBindingAction :: Statement -> DuckDBIdx -> IO ()
fieldBindingAction = Statement -> DuckDBIdx -> IO ()
action
        , fieldBindingDisplay :: String
fieldBindingDisplay = String
display
        }

-- | Types that can be used as positional parameters.
class ToField a where
    toField :: a -> FieldBinding

instance ToField Null where
    toField :: Null -> FieldBinding
toField Null
Null = String -> FieldBinding
nullBinding String
"NULL"

instance ToField Bool where
    toField :: Bool -> FieldBinding
toField Bool
value =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding (Bool -> String
forall a. Show a => a -> String
show Bool
value) ((Statement -> DuckDBIdx -> IO ()) -> FieldBinding)
-> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
forall a b. (a -> b) -> a -> b
$ \Statement
stmt DuckDBIdx
idx ->
            Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (CBool -> IO DuckDBValue
c_duckdb_create_bool (if Bool
value then CBool
1 else CBool
0))

instance ToField Int where
    toField :: MonthOfYear -> FieldBinding
toField = Int64 -> FieldBinding
intBinding (Int64 -> FieldBinding)
-> (MonthOfYear -> Int64) -> MonthOfYear -> FieldBinding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MonthOfYear -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Int64)

instance ToField Int16 where
    toField :: Int16 -> FieldBinding
toField = Int64 -> FieldBinding
intBinding (Int64 -> FieldBinding)
-> (Int16 -> Int64) -> Int16 -> FieldBinding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int16 -> Int64)

instance ToField Int32 where
    toField :: Int32 -> FieldBinding
toField = Int64 -> FieldBinding
intBinding (Int64 -> FieldBinding)
-> (Int32 -> Int64) -> Int32 -> FieldBinding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int32 -> Int64)

instance ToField Int64 where
    toField :: Int64 -> FieldBinding
toField = Int64 -> FieldBinding
intBinding

instance ToField Word where
    toField :: Word -> FieldBinding
toField Word
value = Int64 -> FieldBinding
intBinding (Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
value :: Int64)

instance ToField Word16 where
    toField :: Word16 -> FieldBinding
toField Word16
value = Int64 -> FieldBinding
intBinding (Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
value :: Int64)

instance ToField Word32 where
    toField :: Word32 -> FieldBinding
toField Word32
value = Int64 -> FieldBinding
intBinding (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value :: Int64)

instance ToField Word64 where
    toField :: DuckDBIdx -> FieldBinding
toField DuckDBIdx
value =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (DuckDBIdx -> String
forall a. Show a => a -> String
show DuckDBIdx
value)
            \Statement
stmt DuckDBIdx
idx ->
                Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (Int64 -> IO DuckDBValue
c_duckdb_create_int64 (DuckDBIdx -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral DuckDBIdx
value))

instance ToField Double where
    toField :: Double -> FieldBinding
toField Double
value =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (Double -> String
forall a. Show a => a -> String
show Double
value)
            \Statement
stmt DuckDBIdx
idx ->
                Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (CDouble -> IO DuckDBValue
c_duckdb_create_double (Double -> CDouble
CDouble Double
value))

instance ToField Float where
    toField :: Float -> FieldBinding
toField Float
value =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (Float -> String
forall a. Show a => a -> String
show Float
value)
            \Statement
stmt DuckDBIdx
idx ->
                Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (CDouble -> IO DuckDBValue
c_duckdb_create_double (Double -> CDouble
CDouble (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
value)))

instance ToField Text where
    toField :: Text -> FieldBinding
toField Text
txt =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (Text -> String
forall a. Show a => a -> String
show Text
txt)
            \Statement
stmt DuckDBIdx
idx ->
                Text -> (CString -> IO ()) -> IO ()
forall a. Text -> (CString -> IO a) -> IO a
TextForeign.withCString Text
txt ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cstr ->
                    Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (CString -> IO DuckDBValue
c_duckdb_create_varchar CString
cstr)

instance ToField String where
    toField :: String -> FieldBinding
toField String
str =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (String -> String
forall a. Show a => a -> String
show String
str)
            \Statement
stmt DuckDBIdx
idx ->
                Text -> (CString -> IO ()) -> IO ()
forall a. Text -> (CString -> IO a) -> IO a
TextForeign.withCString (String -> Text
Text.pack String
str) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cstr ->
                    Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (CString -> IO DuckDBValue
c_duckdb_create_varchar CString
cstr)

instance ToField BS.ByteString where
    toField :: ByteString -> FieldBinding
toField ByteString
bs =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (String
"<blob length=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> MonthOfYear -> String
forall a. Show a => a -> String
show (ByteString -> MonthOfYear
BS.length ByteString
bs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">")
            \Statement
stmt DuckDBIdx
idx ->
                ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs \(CString
ptr, MonthOfYear
len) ->
                    Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (Ptr Word8 -> DuckDBIdx -> IO DuckDBValue
c_duckdb_create_blob (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ptr :: Ptr Word8) (MonthOfYear -> DuckDBIdx
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
len))

instance ToField Day where
    toField :: Day -> FieldBinding
toField Day
day =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (Day -> String
forall a. Show a => a -> String
show Day
day)
            \Statement
stmt DuckDBIdx
idx ->
                Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (IO DuckDBValue -> IO ()) -> IO DuckDBValue -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    DuckDBDate
duckDate <- Day -> IO DuckDBDate
encodeDay Day
day
                    DuckDBDate -> IO DuckDBValue
c_duckdb_create_date DuckDBDate
duckDate

instance ToField TimeOfDay where
    toField :: TimeOfDay -> FieldBinding
toField TimeOfDay
tod =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
tod)
            \Statement
stmt DuckDBIdx
idx ->
                Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (IO DuckDBValue -> IO ()) -> IO DuckDBValue -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    DuckDBTime
duckTime <- TimeOfDay -> IO DuckDBTime
encodeTimeOfDay TimeOfDay
tod
                    DuckDBTime -> IO DuckDBValue
c_duckdb_create_time DuckDBTime
duckTime

instance ToField LocalTime where
    toField :: LocalTime -> FieldBinding
toField LocalTime
ts =
        String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
            (LocalTime -> String
forall a. Show a => a -> String
show LocalTime
ts)
            \Statement
stmt DuckDBIdx
idx ->
                Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (IO DuckDBValue -> IO ()) -> IO DuckDBValue -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    DuckDBTimestamp
duckTimestamp <- LocalTime -> IO DuckDBTimestamp
encodeLocalTime LocalTime
ts
                    DuckDBTimestamp -> IO DuckDBValue
c_duckdb_create_timestamp DuckDBTimestamp
duckTimestamp

instance ToField UTCTime where
    toField :: UTCTime -> FieldBinding
toField UTCTime
utcTime =
        let FieldBinding{fieldBindingAction :: FieldBinding -> Statement -> DuckDBIdx -> IO ()
fieldBindingAction = Statement -> DuckDBIdx -> IO ()
action} = LocalTime -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
utcTime)
         in FieldBinding
                { fieldBindingAction :: Statement -> DuckDBIdx -> IO ()
fieldBindingAction = Statement -> DuckDBIdx -> IO ()
action
                , fieldBindingDisplay :: String
fieldBindingDisplay = UTCTime -> String
forall a. Show a => a -> String
show UTCTime
utcTime
                }

instance (ToField a) => ToField (Maybe a) where
    toField :: Maybe a -> FieldBinding
toField Maybe a
Nothing = String -> FieldBinding
nullBinding String
"Nothing"
    toField (Just a
value) =
        let binding :: FieldBinding
binding = a -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField a
value
         in FieldBinding
binding
                { fieldBindingDisplay = "Just " <> renderFieldBinding binding
                }

-- | Helper for binding 'Null' values.
nullBinding :: String -> FieldBinding
nullBinding :: String -> FieldBinding
nullBinding String
repr =
    String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
        String
repr
        \Statement
stmt DuckDBIdx
idx ->
            Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx IO DuckDBValue
c_duckdb_create_null_value

intBinding :: Int64 -> FieldBinding
intBinding :: Int64 -> FieldBinding
intBinding Int64
value =
    String -> (Statement -> DuckDBIdx -> IO ()) -> FieldBinding
mkFieldBinding
        (Int64 -> String
forall a. Show a => a -> String
show Int64
value)
        \Statement
stmt DuckDBIdx
idx ->
            Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx (Int64 -> IO DuckDBValue
c_duckdb_create_int64 Int64
value)

encodeDay :: Day -> IO DuckDBDate
encodeDay :: Day -> IO DuckDBDate
encodeDay Day
day =
    (Ptr DuckDBDateStruct -> IO DuckDBDate) -> IO DuckDBDate
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBDateStruct
ptr -> do
        Ptr DuckDBDateStruct -> DuckDBDateStruct -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBDateStruct
ptr (Day -> DuckDBDateStruct
dayToDateStruct Day
day)
        Ptr DuckDBDateStruct -> IO DuckDBDate
c_duckdb_to_date Ptr DuckDBDateStruct
ptr

encodeTimeOfDay :: TimeOfDay -> IO DuckDBTime
encodeTimeOfDay :: TimeOfDay -> IO DuckDBTime
encodeTimeOfDay TimeOfDay
tod =
    (Ptr DuckDBTimeStruct -> IO DuckDBTime) -> IO DuckDBTime
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBTimeStruct
ptr -> do
        Ptr DuckDBTimeStruct -> DuckDBTimeStruct -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBTimeStruct
ptr (TimeOfDay -> DuckDBTimeStruct
timeOfDayToStruct TimeOfDay
tod)
        Ptr DuckDBTimeStruct -> IO DuckDBTime
c_duckdb_to_time Ptr DuckDBTimeStruct
ptr

encodeLocalTime :: LocalTime -> IO DuckDBTimestamp
encodeLocalTime :: LocalTime -> IO DuckDBTimestamp
encodeLocalTime LocalTime{Day
localDay :: Day
localDay :: LocalTime -> Day
localDay, TimeOfDay
localTimeOfDay :: TimeOfDay
localTimeOfDay :: LocalTime -> TimeOfDay
localTimeOfDay} =
    (Ptr DuckDBTimestampStruct -> IO DuckDBTimestamp)
-> IO DuckDBTimestamp
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBTimestampStruct
ptr -> do
        Ptr DuckDBTimestampStruct -> DuckDBTimestampStruct -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
            Ptr DuckDBTimestampStruct
ptr
            DuckDBTimestampStruct
                { $sel:duckDBTimestampStructDate:DuckDBTimestampStruct :: DuckDBDateStruct
duckDBTimestampStructDate = Day -> DuckDBDateStruct
dayToDateStruct Day
localDay
                , $sel:duckDBTimestampStructTime:DuckDBTimestampStruct :: DuckDBTimeStruct
duckDBTimestampStructTime = TimeOfDay -> DuckDBTimeStruct
timeOfDayToStruct TimeOfDay
localTimeOfDay
                }
        Ptr DuckDBTimestampStruct -> IO DuckDBTimestamp
c_duckdb_to_timestamp Ptr DuckDBTimestampStruct
ptr

dayToDateStruct :: Day -> DuckDBDateStruct
dayToDateStruct :: Day -> DuckDBDateStruct
dayToDateStruct Day
day =
    let (Integer
year, MonthOfYear
month, MonthOfYear
dayOfMonth) = Day -> (Integer, MonthOfYear, MonthOfYear)
toGregorian Day
day
     in DuckDBDateStruct
            { $sel:duckDBDateStructYear:DuckDBDateStruct :: Int32
duckDBDateStructYear = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
year
            , $sel:duckDBDateStructMonth:DuckDBDateStruct :: Int8
duckDBDateStructMonth = MonthOfYear -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
month
            , $sel:duckDBDateStructDay:DuckDBDateStruct :: Int8
duckDBDateStructDay = MonthOfYear -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
dayOfMonth
            }

timeOfDayToStruct :: TimeOfDay -> DuckDBTimeStruct
timeOfDayToStruct :: TimeOfDay -> DuckDBTimeStruct
timeOfDayToStruct TimeOfDay
tod =
    let totalPicoseconds :: Integer
totalPicoseconds = DiffTime -> Integer
diffTimeToPicoseconds (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod)
        totalMicros :: Integer
totalMicros = Integer
totalPicoseconds Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000
        (Integer
hours, Integer
remHour) = Integer
totalMicros Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` (Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000)
        (Integer
minutes, Integer
remMinute) = Integer
remHour Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` (Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000)
        (Integer
seconds, Integer
micros) = Integer
remMinute Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
1000000
     in DuckDBTimeStruct
            { $sel:duckDBTimeStructHour:DuckDBTimeStruct :: Int8
duckDBTimeStructHour = Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
hours
            , $sel:duckDBTimeStructMinute:DuckDBTimeStruct :: Int8
duckDBTimeStructMinute = Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
minutes
            , $sel:duckDBTimeStructSecond:DuckDBTimeStruct :: Int8
duckDBTimeStructSecond = Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
seconds
            , $sel:duckDBTimeStructMicros:DuckDBTimeStruct :: Int32
duckDBTimeStructMicros = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
micros
            }

bindDuckValue :: Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue :: Statement -> DuckDBIdx -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt DuckDBIdx
idx IO DuckDBValue
makeValue =
    Statement -> (DuckDBPreparedStatement -> IO ()) -> IO ()
forall a. Statement -> (DuckDBPreparedStatement -> IO a) -> IO a
withStatementHandle Statement
stmt \DuckDBPreparedStatement
handle ->
        IO DuckDBValue
-> (DuckDBValue -> IO ()) -> (DuckDBValue -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO DuckDBValue
makeValue DuckDBValue -> IO ()
destroyValue \DuckDBValue
value -> do
            DuckDBState
rc <- DuckDBPreparedStatement
-> DuckDBIdx -> DuckDBValue -> IO DuckDBState
c_duckdb_bind_value DuckDBPreparedStatement
handle DuckDBIdx
idx DuckDBValue
value
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState
rc DuckDBState -> DuckDBState -> Bool
forall a. Eq a => a -> a -> Bool
/= DuckDBState
DuckDBSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Text
err <- DuckDBPreparedStatement -> IO Text
fetchPrepareError DuckDBPreparedStatement
handle
                Statement -> Text -> IO ()
forall a. Statement -> Text -> IO a
throwBindError Statement
stmt Text
err

destroyValue :: DuckDBValue -> IO ()
destroyValue :: DuckDBValue -> IO ()
destroyValue DuckDBValue
value =
    (Ptr DuckDBValue -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBValue
ptr -> do
        Ptr DuckDBValue -> DuckDBValue -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBValue
ptr DuckDBValue
value
        Ptr DuckDBValue -> IO ()
c_duckdb_destroy_value Ptr DuckDBValue
ptr

fetchPrepareError :: DuckDBPreparedStatement -> IO Text
fetchPrepareError :: DuckDBPreparedStatement -> IO Text
fetchPrepareError DuckDBPreparedStatement
handle = do
    CString
msgPtr <- DuckDBPreparedStatement -> IO CString
c_duckdb_prepare_error DuckDBPreparedStatement
handle
    if CString
msgPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
        then Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
Text.pack String
"duckdb-simple: parameter binding failed")
        else String -> Text
Text.pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString CString
msgPtr

throwBindError :: Statement -> Text -> IO a
throwBindError :: forall a. Statement -> Text -> IO a
throwBindError Statement{Query
statementQuery :: Query
statementQuery :: Statement -> Query
statementQuery} Text
msg =
    SQLError -> IO a
forall e a. Exception e => e -> IO a
throwIO
        SQLError
            { sqlErrorMessage :: Text
sqlErrorMessage = Text
msg
            , sqlErrorType :: Maybe DuckDBErrorType
sqlErrorType = Maybe DuckDBErrorType
forall a. Maybe a
Nothing
            , sqlErrorQuery :: Maybe Query
sqlErrorQuery = Query -> Maybe Query
forall a. a -> Maybe a
Just Query
statementQuery
            }