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

{- |
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 (..),
    DuckDBColumnType (..),
    NamedParam (..),
    duckdbColumnType,
    bindFieldBinding,
    renderFieldBinding,
) where

import Control.Exception (bracket, throwIO)
import Control.Monad (when)
import Data.Bits (complement)
import qualified Data.ByteString as BS
import Data.Int (Int16, Int32, Int64)
import Data.Proxy (Proxy (..))
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.FromField (BigNum (..), toBigNumBytes, BitString(..))
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 (fromBool)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (poke)
import Numeric.Natural (Natural)
import qualified Data.UUID as UUID

-- | 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 -> Word64 -> IO ()
fieldBindingAction :: !(Statement -> DuckDBIdx -> IO ())
    , FieldBinding -> String
fieldBindingDisplay :: !String
    }

-- | Types that map to a concrete DuckDB column type when used with 'ToField'.
class DuckDBColumnType a where
    duckdbColumnTypeFor :: Proxy a -> Text

-- | Report the DuckDB column type that best matches a given 'ToField' instance.
duckdbColumnType :: forall a. (DuckDBColumnType a) => Proxy a -> Text
duckdbColumnType :: forall a. DuckDBColumnType a => Proxy a -> Text
duckdbColumnType = Proxy a -> Text
forall a. DuckDBColumnType a => Proxy a -> Text
duckdbColumnTypeFor

-- | Apply a 'FieldBinding' to the given statement/index.
bindFieldBinding :: Statement -> DuckDBIdx -> FieldBinding -> IO ()
bindFieldBinding :: Statement -> Word64 -> FieldBinding -> IO ()
bindFieldBinding Statement
stmt Word64
idx FieldBinding{Statement -> Word64 -> IO ()
fieldBindingAction :: FieldBinding -> Statement -> Word64 -> IO ()
fieldBindingAction :: Statement -> Word64 -> IO ()
fieldBindingAction} = Statement -> Word64 -> IO ()
fieldBindingAction Statement
stmt Word64
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 -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding String
display Statement -> Word64 -> IO ()
action =
    FieldBinding
        { fieldBindingAction :: Statement -> Word64 -> IO ()
fieldBindingAction = Statement -> Word64 -> IO ()
action
        , fieldBindingDisplay :: String
fieldBindingDisplay = String
display
        }

-- | Types that can be used as positional parameters.
class (DuckDBColumnType a) => 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 -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding (Bool -> String
forall a. Show a => a -> String
show Bool
value) ((Statement -> Word64 -> IO ()) -> FieldBinding)
-> (Statement -> Word64 -> IO ()) -> FieldBinding
forall a b. (a -> b) -> a -> b
$ \Statement
stmt Word64
idx ->
            Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
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 BigNum where
    toField :: BigNum -> FieldBinding
toField = BigNum -> FieldBinding
bignumBinding

instance ToField UUID.UUID where
    toField :: UUID -> FieldBinding
toField = UUID -> FieldBinding
uuidBinding

instance ToField Integer where
    toField :: Integer -> FieldBinding
    toField :: Integer -> FieldBinding
toField = BigNum -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField (BigNum -> FieldBinding)
-> (Integer -> BigNum) -> Integer -> FieldBinding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigNum
BigNum

instance ToField Natural where
    toField :: Natural -> FieldBinding
toField = BigNum -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField (BigNum -> FieldBinding)
-> (Natural -> BigNum) -> Natural -> FieldBinding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigNum
BigNum (Integer -> BigNum) -> (Natural -> Integer) -> Natural -> BigNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger

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

instance ToField Word16 where
    toField :: Word16 -> FieldBinding
toField = Word16 -> FieldBinding
uint16Binding

instance ToField Word32 where
    toField :: Word32 -> FieldBinding
toField = Word32 -> FieldBinding
uint32Binding

instance ToField Word64 where
    toField :: Word64 -> FieldBinding
toField = Word64 -> FieldBinding
uint64Binding

instance ToField Word8 where
    toField :: Word8 -> FieldBinding
toField = Word8 -> FieldBinding
uint8Binding

instance ToField Double where
    toField :: Double -> FieldBinding
toField Double
value =
        String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
            (Double -> String
forall a. Show a => a -> String
show Double
value)
            \Statement
stmt Word64
idx ->
                Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
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 -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
            (Float -> String
forall a. Show a => a -> String
show Float
value)
            \Statement
stmt Word64
idx ->
                Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
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 -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
            (Text -> String
forall a. Show a => a -> String
show Text
txt)
            \Statement
stmt Word64
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 -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (CString -> IO DuckDBValue
c_duckdb_create_varchar CString
cstr)

instance ToField String where
    toField :: String -> FieldBinding
toField String
str =
        String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
            (String -> String
forall a. Show a => a -> String
show String
str)
            \Statement
stmt Word64
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 -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (CString -> IO DuckDBValue
c_duckdb_create_varchar CString
cstr)

instance DuckDBColumnType BitString where
    duckdbColumnTypeFor :: Proxy BitString -> Text
duckdbColumnTypeFor Proxy BitString
_ = Text
"BIT"

instance ToField BitString where
    toField :: BitString -> FieldBinding
toField = BitString -> FieldBinding
bitBinding

instance ToField BS.ByteString where
    toField :: ByteString -> FieldBinding
toField ByteString
bs =
        String -> (Statement -> Word64 -> 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 Word64
idx ->
                ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs \(CString
ptr, MonthOfYear
len) ->
                    Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (Ptr Word8 -> Word64 -> IO DuckDBValue
c_duckdb_create_blob (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ptr :: Ptr Word8) (MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
len))

instance ToField Day where
    toField :: Day -> FieldBinding
toField Day
day =
        String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
            (Day -> String
forall a. Show a => a -> String
show Day
day)
            \Statement
stmt Word64
idx ->
                Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
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 -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
            (TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
tod)
            \Statement
stmt Word64
idx ->
                Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
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 -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
            (LocalTime -> String
forall a. Show a => a -> String
show LocalTime
ts)
            \Statement
stmt Word64
idx ->
                Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
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 -> Word64 -> IO ()
fieldBindingAction = Statement -> Word64 -> IO ()
action} = LocalTime -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
utcTime)
         in FieldBinding
                { fieldBindingAction :: Statement -> Word64 -> IO ()
fieldBindingAction = Statement -> Word64 -> 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
                }

instance DuckDBColumnType Null where
    duckdbColumnTypeFor :: Proxy Null -> Text
duckdbColumnTypeFor Proxy Null
_ = Text
"NULL"

instance DuckDBColumnType Bool where
    duckdbColumnTypeFor :: Proxy Bool -> Text
duckdbColumnTypeFor Proxy Bool
_ = Text
"BOOLEAN"

instance DuckDBColumnType Int where
    duckdbColumnTypeFor :: Proxy MonthOfYear -> Text
duckdbColumnTypeFor Proxy MonthOfYear
_ = Text
"BIGINT"

instance DuckDBColumnType Int16 where
    duckdbColumnTypeFor :: Proxy Int16 -> Text
duckdbColumnTypeFor Proxy Int16
_ = Text
"SMALLINT"

instance DuckDBColumnType Int32 where
    duckdbColumnTypeFor :: Proxy Int32 -> Text
duckdbColumnTypeFor Proxy Int32
_ = Text
"INTEGER"

instance DuckDBColumnType Int64 where
    duckdbColumnTypeFor :: Proxy Int64 -> Text
duckdbColumnTypeFor Proxy Int64
_ = Text
"BIGINT"

instance DuckDBColumnType BigNum where
    duckdbColumnTypeFor :: Proxy BigNum -> Text
duckdbColumnTypeFor Proxy BigNum
_ = Text
"BIGNUM"

instance DuckDBColumnType UUID.UUID where
    duckdbColumnTypeFor :: Proxy UUID -> Text
duckdbColumnTypeFor Proxy UUID
_ = Text
"UUID"

instance DuckDBColumnType Integer where
    duckdbColumnTypeFor :: Proxy Integer -> Text
duckdbColumnTypeFor Proxy Integer
_ = Text
"BIGNUM"

instance DuckDBColumnType Natural where
    duckdbColumnTypeFor :: Proxy Natural -> Text
duckdbColumnTypeFor Proxy Natural
_ = Text
"BIGNUM"

instance DuckDBColumnType Word where
    duckdbColumnTypeFor :: Proxy Word -> Text
duckdbColumnTypeFor Proxy Word
_ = Text
"UBIGINT"

instance DuckDBColumnType Word8 where
    duckdbColumnTypeFor :: Proxy Word8 -> Text
duckdbColumnTypeFor Proxy Word8
_ = Text
"UTINYINT"

instance DuckDBColumnType Word16 where
    duckdbColumnTypeFor :: Proxy Word16 -> Text
duckdbColumnTypeFor Proxy Word16
_ = Text
"USMALLINT"

instance DuckDBColumnType Word32 where
    duckdbColumnTypeFor :: Proxy Word32 -> Text
duckdbColumnTypeFor Proxy Word32
_ = Text
"UINTEGER"

instance DuckDBColumnType Word64 where
    duckdbColumnTypeFor :: Proxy Word64 -> Text
duckdbColumnTypeFor Proxy Word64
_ = Text
"UBIGINT"

instance DuckDBColumnType Double where
    duckdbColumnTypeFor :: Proxy Double -> Text
duckdbColumnTypeFor Proxy Double
_ = Text
"DOUBLE"

instance DuckDBColumnType Float where
    duckdbColumnTypeFor :: Proxy Float -> Text
duckdbColumnTypeFor Proxy Float
_ = Text
"FLOAT"

instance DuckDBColumnType Text where
    duckdbColumnTypeFor :: Proxy Text -> Text
duckdbColumnTypeFor Proxy Text
_ = Text
"TEXT"

instance DuckDBColumnType String where
    duckdbColumnTypeFor :: Proxy String -> Text
duckdbColumnTypeFor Proxy String
_ = Text
"TEXT"

instance DuckDBColumnType BS.ByteString where
    duckdbColumnTypeFor :: Proxy ByteString -> Text
duckdbColumnTypeFor Proxy ByteString
_ = Text
"BLOB"

instance DuckDBColumnType Day where
    duckdbColumnTypeFor :: Proxy Day -> Text
duckdbColumnTypeFor Proxy Day
_ = Text
"DATE"

instance DuckDBColumnType TimeOfDay where
    duckdbColumnTypeFor :: Proxy TimeOfDay -> Text
duckdbColumnTypeFor Proxy TimeOfDay
_ = Text
"TIME"

instance DuckDBColumnType LocalTime where
    duckdbColumnTypeFor :: Proxy LocalTime -> Text
duckdbColumnTypeFor Proxy LocalTime
_ = Text
"TIMESTAMP"

instance DuckDBColumnType UTCTime where
    duckdbColumnTypeFor :: Proxy UTCTime -> Text
duckdbColumnTypeFor Proxy UTCTime
_ = Text
"TIMESTAMPTZ"

instance (DuckDBColumnType a) => DuckDBColumnType (Maybe a) where
    duckdbColumnTypeFor :: Proxy (Maybe a) -> Text
duckdbColumnTypeFor Proxy (Maybe a)
_ = Proxy a -> Text
forall a. DuckDBColumnType a => Proxy a -> Text
duckdbColumnTypeFor (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

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

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

uint64Binding :: Word64 -> FieldBinding
uint64Binding :: Word64 -> FieldBinding
uint64Binding Word64
value =
    String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
        (Word64 -> String
forall a. Show a => a -> String
show Word64
value)
        \Statement
stmt Word64
idx ->
            Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (Word64 -> IO DuckDBValue
c_duckdb_create_uint64 Word64
value)

uint32Binding :: Word32 -> FieldBinding
uint32Binding :: Word32 -> FieldBinding
uint32Binding Word32
value =
    String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
        (Word32 -> String
forall a. Show a => a -> String
show Word32
value)
        \Statement
stmt Word64
idx ->
            Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (Word32 -> IO DuckDBValue
c_duckdb_create_uint32 Word32
value)

uint16Binding :: Word16 -> FieldBinding
uint16Binding :: Word16 -> FieldBinding
uint16Binding Word16
value =
    String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
        (Word16 -> String
forall a. Show a => a -> String
show Word16
value)
        \Statement
stmt Word64
idx ->
            Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (Word16 -> IO DuckDBValue
c_duckdb_create_uint16 Word16
value)

uint8Binding :: Word8 -> FieldBinding
uint8Binding :: Word8 -> FieldBinding
uint8Binding Word8
value =
    String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
        (Word8 -> String
forall a. Show a => a -> String
show Word8
value)
        \Statement
stmt Word64
idx ->
            Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (Word8 -> IO DuckDBValue
c_duckdb_create_uint8 Word8
value)

uuidBinding :: UUID.UUID -> FieldBinding
uuidBinding :: UUID -> FieldBinding
uuidBinding UUID
uuid =
    String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
        (UUID -> String
forall a. Show a => a -> String
show UUID
uuid)
        \Statement
stmt Word64
idx ->
            Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (IO DuckDBValue -> IO ()) -> IO DuckDBValue -> IO ()
forall a b. (a -> b) -> a -> b
$
              (Ptr DuckDBUHugeInt -> IO DuckDBValue) -> IO DuckDBValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr DuckDBUHugeInt -> IO DuckDBValue) -> IO DuckDBValue)
-> (Ptr DuckDBUHugeInt -> IO DuckDBValue) -> IO DuckDBValue
forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBUHugeInt
ptr -> do
                let (Word64
upper, Word64
lower) = UUID -> (Word64, Word64)
UUID.toWords64 UUID
uuid
                Ptr DuckDBUHugeInt -> DuckDBUHugeInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBUHugeInt
ptr DuckDBUHugeInt
                    { $sel:duckDBUHugeIntLower:DuckDBUHugeInt :: Word64
duckDBUHugeIntLower = Word64
lower
                    , $sel:duckDBUHugeIntUpper:DuckDBUHugeInt :: Word64
duckDBUHugeIntUpper = Word64
upper
                    }
                Ptr DuckDBUHugeInt -> IO DuckDBValue
c_duckdb_create_uuid Ptr DuckDBUHugeInt
ptr

bitBinding :: BitString -> FieldBinding
bitBinding :: BitString -> FieldBinding
bitBinding (BitString Word8
padding ByteString
bits) =
    String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
        (BitString -> String
forall a. Show a => a -> String
show (Word8 -> ByteString -> BitString
BitString Word8
padding ByteString
bits))
        \Statement
stmt Word64
idx ->
            let w_padding :: [Word8]
w_padding = (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
padding :: Word8)Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:ByteString -> [Word8]
BS.unpack ByteString
bits
            in Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (IO DuckDBValue -> IO ()) -> IO DuckDBValue -> IO ()
forall a b. (a -> b) -> a -> b
$
                  if ByteString -> Bool
BS.null ByteString
bits
                        then (Ptr DuckDBBit -> IO DuckDBValue) -> IO DuckDBValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBBit
ptr -> do
                            Ptr DuckDBBit -> DuckDBBit -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
                                Ptr DuckDBBit
ptr
                                DuckDBBit
                                    { $sel:duckDBBitData:DuckDBBit :: Ptr Word8
duckDBBitData = Ptr Word8
forall a. Ptr a
nullPtr
                                    , $sel:duckDBBitSize:DuckDBBit :: Word64
duckDBBitSize = Word64
0
                                    }
                            Ptr DuckDBBit -> IO DuckDBValue
c_duckdb_create_bit Ptr DuckDBBit
ptr
                        else
                            ByteString -> (CStringLen -> IO DuckDBValue) -> IO DuckDBValue
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ([Word8] -> ByteString
BS.pack [Word8]
w_padding) \(CString
rawPtr, MonthOfYear
len) ->
                            (Ptr DuckDBBit -> IO DuckDBValue) -> IO DuckDBValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBBit
ptr -> do
                                Ptr DuckDBBit -> DuckDBBit -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
                                    Ptr DuckDBBit
ptr
                                    DuckDBBit
                                        { $sel:duckDBBitData:DuckDBBit :: Ptr Word8
duckDBBitData = CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
rawPtr
                                        , $sel:duckDBBitSize:DuckDBBit :: Word64
duckDBBitSize = MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
len
                                        }
                                Ptr DuckDBBit -> IO DuckDBValue
c_duckdb_create_bit Ptr DuckDBBit
ptr

bignumBinding :: BigNum -> FieldBinding
bignumBinding :: BigNum -> FieldBinding
bignumBinding (BigNum Integer
big) =
    String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding
        (Integer -> String
forall a. Show a => a -> String
show Integer
big)
        \Statement
stmt Word64
idx ->
            Statement -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
idx (IO DuckDBValue -> IO ()) -> IO DuckDBValue -> IO ()
forall a b. (a -> b) -> a -> b
$
                let neg :: CBool
neg = Bool -> CBool
forall a. Num a => Bool -> a
fromBool (Integer
big Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0)
                    big_num_bytes :: ByteString
big_num_bytes =
                        [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$
                            if Integer
big Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
                                then (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word8
forall a. Bits a => a -> a
complement (MonthOfYear -> [Word8] -> [Word8]
forall a. MonthOfYear -> [a] -> [a]
drop MonthOfYear
3 ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Integer -> [Word8]
toBigNumBytes Integer
big)
                                else MonthOfYear -> [Word8] -> [Word8]
forall a. MonthOfYear -> [a] -> [a]
drop MonthOfYear
3 ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Integer -> [Word8]
toBigNumBytes Integer
big
                 in if ByteString -> Bool
BS.null ByteString
big_num_bytes
                        then (Ptr DuckDBBignum -> IO DuckDBValue) -> IO DuckDBValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBBignum
ptr -> do
                            Ptr DuckDBBignum -> DuckDBBignum -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
                                Ptr DuckDBBignum
ptr
                                DuckDBBignum
                                    { $sel:duckDBBignumData:DuckDBBignum :: Ptr Word8
duckDBBignumData = Ptr Word8
forall a. Ptr a
nullPtr
                                    , $sel:duckDBBignumSize:DuckDBBignum :: Word64
duckDBBignumSize = Word64
0
                                    , $sel:duckDBBignumIsNegative:DuckDBBignum :: CBool
duckDBBignumIsNegative = CBool
neg
                                    }
                            Ptr DuckDBBignum -> IO DuckDBValue
c_duckdb_create_bignum Ptr DuckDBBignum
ptr
                        else ByteString -> (CStringLen -> IO DuckDBValue) -> IO DuckDBValue
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
big_num_bytes \(CString
rawPtr, MonthOfYear
len) ->
                            (Ptr DuckDBBignum -> IO DuckDBValue) -> IO DuckDBValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBBignum
ptr -> do
                                Ptr DuckDBBignum -> DuckDBBignum -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
                                    Ptr DuckDBBignum
ptr
                                    DuckDBBignum
                                        { $sel:duckDBBignumData:DuckDBBignum :: Ptr Word8
duckDBBignumData = CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
rawPtr
                                        , $sel:duckDBBignumSize:DuckDBBignum :: Word64
duckDBBignumSize = MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
len
                                        , $sel:duckDBBignumIsNegative:DuckDBBignum :: CBool
duckDBBignumIsNegative = CBool
neg
                                        }
                                Ptr DuckDBBignum -> IO DuckDBValue
c_duckdb_create_bignum Ptr DuckDBBignum
ptr

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 -> Word64 -> IO DuckDBValue -> IO ()
bindDuckValue Statement
stmt Word64
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 -> Word64 -> DuckDBValue -> IO DuckDBState
c_duckdb_bind_value DuckDBPreparedStatement
handle Word64
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
            }