{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# 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,
    ToDuckValue (..),
    ToField (..),
    DuckDBColumnType (..),
    NamedParam (..),
    duckdbColumnType,
    bindFieldBinding,
    renderFieldBinding,
) where

import Control.Exception (bracket, throwIO)
import Control.Monad (when, zipWithM)
import Data.Array (Array, elems)
import Data.Bits (complement, shiftL, shiftR, (.&.))
import qualified Data.ByteString as BS
import Data.Int (Int16, Int32, Int64, Int8)
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 (..), TimeZone (..), timeOfDayToTime, timeZoneMinutes, utc, utcToLocalTime)
import qualified Data.UUID as UUID
import Data.Word (Word16, Word32, Word64, Word8)
import Database.DuckDB.FFI
import Database.DuckDB.Simple.FromField (BigNum (..), BitString (..), DecimalValue (..), FieldValue (..), IntervalValue (..), TimeWithZone (..), toBigNumBytes)
import Database.DuckDB.Simple.Internal (
    SQLError (..),
    Statement (..),
    withStatementHandle,
 )
import Database.DuckDB.Simple.LogicalRep (
    LogicalTypeRep (..),
    StructField (..),
    StructValue (..),
    UnionMemberType (..),
    UnionValue (..),
    logicalTypeFromRep,
    structValueTypeRep,
    unionValueTypeRep,
 )
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.Marshal.Array (withArray)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (poke)
import Numeric.Natural (Natural)

-- | 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
    }

-- | Low-level class for values that can be marshalled directly into `DuckDBValue`s.
class (DuckDBColumnType a) => ToDuckValue a where
    -- | Convert a Haskell value into an owned DuckDB boxed value.
    toDuckValue :: a -> IO DuckDBValue

valueBinding :: String -> IO DuckDBValue -> FieldBinding
valueBinding :: String -> IO DuckDBValue -> FieldBinding
valueBinding String
display IO DuckDBValue
mkValue =
    String -> (Statement -> Word64 -> IO ()) -> FieldBinding
mkFieldBinding String
display ((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 IO DuckDBValue
mkValue

-- | 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 ToField a where
    toField :: a -> FieldBinding
    default toField :: (Show a, ToDuckValue a) => a -> FieldBinding
    toField a
value = String -> IO DuckDBValue -> FieldBinding
valueBinding (a -> String
forall a. Show a => a -> String
show a
value) (a -> IO DuckDBValue
forall a. ToDuckValue a => a -> IO DuckDBValue
toDuckValue a
value)

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

instance ToField Bool
instance ToField Int
instance ToField Int8
instance ToField Int16
instance ToField Int32
instance ToField Int64
instance ToField Integer
instance ToField Natural
instance ToField UUID.UUID
instance ToField Word
instance ToField Word8
instance ToField Word16
instance ToField Word32
instance ToField Word64
instance ToField Double
instance ToField Float
instance ToField Text
instance ToField String
instance ToField BitString
instance ToField Day
instance ToField TimeOfDay
instance ToField LocalTime
instance ToField UTCTime

instance ToField BigNum where
    toField :: BigNum -> FieldBinding
toField big :: BigNum
big@(BigNum Integer
n) = String -> IO DuckDBValue -> FieldBinding
valueBinding (Integer -> String
forall a. Show a => a -> String
show Integer
n) (BigNum -> IO DuckDBValue
bigNumDuckValue BigNum
big)

instance ToField (StructValue FieldValue) where
    toField :: StructValue FieldValue -> FieldBinding
toField StructValue FieldValue
structVal =
        String -> IO DuckDBValue -> FieldBinding
valueBinding String
"<struct>" (StructValue FieldValue -> IO DuckDBValue
structValueDuckValue StructValue FieldValue
structVal)

instance ToField (UnionValue FieldValue) where
    toField :: UnionValue FieldValue -> FieldBinding
toField UnionValue FieldValue
unionVal =
        let label :: String
label = Text -> String
Text.unpack (UnionValue FieldValue -> Text
forall a. UnionValue a -> Text
unionValueLabel UnionValue FieldValue
unionVal)
         in String -> IO DuckDBValue -> FieldBinding
valueBinding (String
"<union " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
label String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">") (UnionValue FieldValue -> IO DuckDBValue
unionValueDuckValue UnionValue FieldValue
unionVal)

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

instance ToField BS.ByteString where
    toField :: ByteString -> FieldBinding
toField ByteString
bs =
        String -> IO DuckDBValue -> FieldBinding
valueBinding
            (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
">")
            (ByteString -> IO DuckDBValue
forall a. ToDuckValue a => a -> IO DuckDBValue
toDuckValue ByteString
bs)

instance (DuckDBColumnType a, ToDuckValue a) => ToField (Array Int a) where
    toField :: Array MonthOfYear a -> FieldBinding
toField Array MonthOfYear a
arr =
        String -> IO DuckDBValue -> FieldBinding
valueBinding
            (String
"<array length=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> MonthOfYear -> String
forall a. Show a => a -> String
show ([a] -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length (Array MonthOfYear a -> [a]
forall i e. Array i e -> [e]
elems Array MonthOfYear a
arr)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">")
            (Array MonthOfYear a -> IO DuckDBValue
forall a.
(DuckDBColumnType a, ToDuckValue a) =>
Array MonthOfYear a -> IO DuckDBValue
arrayDuckValue Array MonthOfYear a
arr)

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 Int8 where
    duckdbColumnTypeFor :: Proxy Int8 -> Text
duckdbColumnTypeFor Proxy Int8
_ = Text
"TINYINT"

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 (StructValue FieldValue) where
    duckdbColumnTypeFor :: Proxy (StructValue FieldValue) -> Text
duckdbColumnTypeFor Proxy (StructValue FieldValue)
_ = Text
"STRUCT"

instance DuckDBColumnType (UnionValue FieldValue) where
    duckdbColumnTypeFor :: Proxy (UnionValue FieldValue) -> Text
duckdbColumnTypeFor Proxy (UnionValue FieldValue)
_ = Text
"UNION"

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)

instance (DuckDBColumnType a) => DuckDBColumnType (Array Int a) where
    duckdbColumnTypeFor :: Proxy (Array MonthOfYear a) -> Text
duckdbColumnTypeFor Proxy (Array MonthOfYear a)
_ = Proxy a -> Text
forall a. DuckDBColumnType a => Proxy a -> Text
duckdbColumnTypeFor (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"[]"

nullBinding :: String -> FieldBinding
nullBinding :: String -> FieldBinding
nullBinding String
repr = String -> IO DuckDBValue -> FieldBinding
valueBinding String
repr IO DuckDBValue
nullDuckValue

nullDuckValue :: IO DuckDBValue
nullDuckValue :: IO DuckDBValue
nullDuckValue = IO DuckDBValue
c_duckdb_create_null_value

boolDuckValue :: Bool -> IO DuckDBValue
boolDuckValue :: Bool -> IO DuckDBValue
boolDuckValue Bool
value = CBool -> IO DuckDBValue
c_duckdb_create_bool (if Bool
value then CBool
1 else CBool
0)

int8DuckValue :: Int8 -> IO DuckDBValue
int8DuckValue :: Int8 -> IO DuckDBValue
int8DuckValue = Int8 -> IO DuckDBValue
c_duckdb_create_int8

int16DuckValue :: Int16 -> IO DuckDBValue
int16DuckValue :: Int16 -> IO DuckDBValue
int16DuckValue = Int16 -> IO DuckDBValue
c_duckdb_create_int16

int32DuckValue :: Int32 -> IO DuckDBValue
int32DuckValue :: Int32 -> IO DuckDBValue
int32DuckValue = Int32 -> IO DuckDBValue
c_duckdb_create_int32

int64DuckValue :: Int64 -> IO DuckDBValue
int64DuckValue :: Int64 -> IO DuckDBValue
int64DuckValue = Int64 -> IO DuckDBValue
c_duckdb_create_int64

uint64DuckValue :: Word64 -> IO DuckDBValue
uint64DuckValue :: Word64 -> IO DuckDBValue
uint64DuckValue = Word64 -> IO DuckDBValue
c_duckdb_create_uint64

uint32DuckValue :: Word32 -> IO DuckDBValue
uint32DuckValue :: Word32 -> IO DuckDBValue
uint32DuckValue = Word32 -> IO DuckDBValue
c_duckdb_create_uint32

uint16DuckValue :: Word16 -> IO DuckDBValue
uint16DuckValue :: Word16 -> IO DuckDBValue
uint16DuckValue = Word16 -> IO DuckDBValue
c_duckdb_create_uint16

uint8DuckValue :: Word8 -> IO DuckDBValue
uint8DuckValue :: Word8 -> IO DuckDBValue
uint8DuckValue = Word8 -> IO DuckDBValue
c_duckdb_create_uint8

doubleDuckValue :: Double -> IO DuckDBValue
doubleDuckValue :: Double -> IO DuckDBValue
doubleDuckValue = CDouble -> IO DuckDBValue
c_duckdb_create_double (CDouble -> IO DuckDBValue)
-> (Double -> CDouble) -> Double -> IO DuckDBValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CDouble
CDouble

floatDuckValue :: Float -> IO DuckDBValue
floatDuckValue :: Float -> IO DuckDBValue
floatDuckValue = CDouble -> IO DuckDBValue
c_duckdb_create_double (CDouble -> IO DuckDBValue)
-> (Float -> CDouble) -> Float -> IO DuckDBValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CDouble
CDouble (Double -> CDouble) -> (Float -> Double) -> Float -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

textDuckValue :: Text -> IO DuckDBValue
textDuckValue :: Text -> IO DuckDBValue
textDuckValue Text
txt =
    Text -> (CString -> IO DuckDBValue) -> IO DuckDBValue
forall a. Text -> (CString -> IO a) -> IO a
TextForeign.withCString Text
txt CString -> IO DuckDBValue
c_duckdb_create_varchar

stringDuckValue :: String -> IO DuckDBValue
stringDuckValue :: String -> IO DuckDBValue
stringDuckValue = Text -> IO DuckDBValue
textDuckValue (Text -> IO DuckDBValue)
-> (String -> Text) -> String -> IO DuckDBValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

blobDuckValue :: BS.ByteString -> IO DuckDBValue
blobDuckValue :: ByteString -> IO DuckDBValue
blobDuckValue ByteString
bs =
    ByteString -> (CStringLen -> IO DuckDBValue) -> IO DuckDBValue
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs \(CString
ptr, MonthOfYear
len) ->
        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)

uuidDuckValue :: UUID.UUID -> IO DuckDBValue
uuidDuckValue :: UUID -> IO DuckDBValue
uuidDuckValue UUID
uuid =
    (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
                { duckDBUHugeIntLower :: Word64
duckDBUHugeIntLower = Word64
lower
                , duckDBUHugeIntUpper :: Word64
duckDBUHugeIntUpper = Word64
upper
                }
        Ptr DuckDBUHugeInt -> IO DuckDBValue
c_duckdb_create_uuid Ptr DuckDBUHugeInt
ptr

bitDuckValue :: BitString -> IO DuckDBValue
bitDuckValue :: BitString -> IO DuckDBValue
bitDuckValue (BitString Word8
padding ByteString
bits) =
    let withPacked :: (Ptr DuckDBBit -> IO DuckDBValue) -> IO DuckDBValue
withPacked Ptr DuckDBBit -> IO DuckDBValue
action =
            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
                            { duckDBBitData :: Ptr Word8
duckDBBitData = Ptr Word8
forall a. Ptr a
nullPtr
                            , duckDBBitSize :: Word64
duckDBBitSize = Word64
0
                            }
                    Ptr DuckDBBit -> IO DuckDBValue
action Ptr DuckDBBit
ptr
                else
                    let payload :: ByteString
payload = [Word8] -> ByteString
BS.pack ((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 ByteString -> (CStringLen -> IO DuckDBValue) -> IO DuckDBValue
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
payload \(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
                                        { duckDBBitData :: Ptr Word8
duckDBBitData = CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
rawPtr
                                        , duckDBBitSize :: Word64
duckDBBitSize = MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
len
                                        }
                                Ptr DuckDBBit -> IO DuckDBValue
action Ptr DuckDBBit
ptr
     in (Ptr DuckDBBit -> IO DuckDBValue) -> IO DuckDBValue
withPacked Ptr DuckDBBit -> IO DuckDBValue
c_duckdb_create_bit

bigNumDuckValue :: BigNum -> IO DuckDBValue
bigNumDuckValue :: BigNum -> IO DuckDBValue
bigNumDuckValue (BigNum Integer
big) =
    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)
        payload :: ByteString
payload =
            [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
        withPayload :: (Ptr DuckDBBignum -> IO DuckDBValue) -> IO DuckDBValue
withPayload Ptr DuckDBBignum -> IO DuckDBValue
action =
            if ByteString -> Bool
BS.null ByteString
payload
                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
                            { duckDBBignumData :: Ptr Word8
duckDBBignumData = Ptr Word8
forall a. Ptr a
nullPtr
                            , duckDBBignumSize :: Word64
duckDBBignumSize = Word64
0
                            , duckDBBignumIsNegative :: CBool
duckDBBignumIsNegative = CBool
neg
                            }
                    Ptr DuckDBBignum -> IO DuckDBValue
action Ptr DuckDBBignum
ptr
                else ByteString -> (CStringLen -> IO DuckDBValue) -> IO DuckDBValue
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
payload \(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
                                { duckDBBignumData :: Ptr Word8
duckDBBignumData = CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
rawPtr
                                , duckDBBignumSize :: Word64
duckDBBignumSize = MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
len
                                , duckDBBignumIsNegative :: CBool
duckDBBignumIsNegative = CBool
neg
                                }
                        Ptr DuckDBBignum -> IO DuckDBValue
action Ptr DuckDBBignum
ptr
     in (Ptr DuckDBBignum -> IO DuckDBValue) -> IO DuckDBValue
withPayload Ptr DuckDBBignum -> IO DuckDBValue
c_duckdb_create_bignum

dayDuckValue :: Day -> IO DuckDBValue
dayDuckValue :: Day -> IO DuckDBValue
dayDuckValue Day
day = do
    duckDate <- Day -> IO DuckDBDate
encodeDay Day
day
    c_duckdb_create_date duckDate

timeOfDayDuckValue :: TimeOfDay -> IO DuckDBValue
timeOfDayDuckValue :: TimeOfDay -> IO DuckDBValue
timeOfDayDuckValue TimeOfDay
tod = do
    duckTime <- TimeOfDay -> IO DuckDBTime
encodeTimeOfDay TimeOfDay
tod
    c_duckdb_create_time duckTime

localTimeDuckValue :: LocalTime -> IO DuckDBValue
localTimeDuckValue :: LocalTime -> IO DuckDBValue
localTimeDuckValue LocalTime
ts = do
    duckTimestamp <- LocalTime -> IO DuckDBTimestamp
encodeLocalTime LocalTime
ts
    c_duckdb_create_timestamp duckTimestamp

utcTimeDuckValue :: UTCTime -> IO DuckDBValue
utcTimeDuckValue :: UTCTime -> IO DuckDBValue
utcTimeDuckValue UTCTime
utcTime =
    let local :: LocalTime
local = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
utcTime
     in LocalTime -> IO DuckDBValue
localTimeDuckValue LocalTime
local

arrayDuckValue ::
    forall a.
    (DuckDBColumnType a, ToDuckValue a) =>
    Array Int a ->
    IO DuckDBValue
arrayDuckValue :: forall a.
(DuckDBColumnType a, ToDuckValue a) =>
Array MonthOfYear a -> IO DuckDBValue
arrayDuckValue Array MonthOfYear a
arr =
    IO DuckDBLogicalType
-> (DuckDBLogicalType -> IO ())
-> (DuckDBLogicalType -> IO DuckDBValue)
-> IO DuckDBValue
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Proxy a -> IO DuckDBLogicalType
forall a. DuckDBColumnType a => Proxy a -> IO DuckDBLogicalType
createElementLogicalType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) DuckDBLogicalType -> IO ()
destroyLogicalType \DuckDBLogicalType
elementType -> do
        let elemsList :: [a]
elemsList = Array MonthOfYear a -> [a]
forall i e. Array i e -> [e]
elems Array MonthOfYear a
arr
            count :: MonthOfYear
count = [a] -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length [a]
elemsList
        values <- (a -> IO DuckDBValue) -> [a] -> IO [DuckDBValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO DuckDBValue
forall a. ToDuckValue a => a -> IO DuckDBValue
toDuckValue [a]
elemsList
        result <-
            withArray values \Ptr DuckDBValue
ptr ->
                DuckDBLogicalType -> Ptr DuckDBValue -> Word64 -> IO DuckDBValue
c_duckdb_create_array_value DuckDBLogicalType
elementType Ptr DuckDBValue
ptr (MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
count)
        mapM_ destroyValue values
        pure result

structValueDuckValue :: StructValue FieldValue -> IO DuckDBValue
structValueDuckValue :: StructValue FieldValue -> IO DuckDBValue
structValueDuckValue StructValue{Array MonthOfYear (StructField FieldValue)
structValueFields :: Array MonthOfYear (StructField FieldValue)
structValueFields :: forall a. StructValue a -> Array MonthOfYear (StructField a)
structValueFields, Array MonthOfYear (StructField LogicalTypeRep)
structValueTypes :: Array MonthOfYear (StructField LogicalTypeRep)
structValueTypes :: forall a.
StructValue a -> Array MonthOfYear (StructField LogicalTypeRep)
structValueTypes, structValueIndex :: forall a. StructValue a -> Map Text MonthOfYear
structValueIndex = Map Text MonthOfYear
_} = do
    let valueFields :: [StructField FieldValue]
valueFields = Array MonthOfYear (StructField FieldValue)
-> [StructField FieldValue]
forall i e. Array i e -> [e]
elems Array MonthOfYear (StructField FieldValue)
structValueFields
        typeFields :: [StructField LogicalTypeRep]
typeFields = Array MonthOfYear (StructField LogicalTypeRep)
-> [StructField LogicalTypeRep]
forall i e. Array i e -> [e]
elems Array MonthOfYear (StructField LogicalTypeRep)
structValueTypes
        typeNames :: [Text]
typeNames = (StructField LogicalTypeRep -> Text)
-> [StructField LogicalTypeRep] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map StructField LogicalTypeRep -> Text
forall a. StructField a -> Text
structFieldName [StructField LogicalTypeRep]
typeFields
        valueNames :: [Text]
valueNames = (StructField FieldValue -> Text)
-> [StructField FieldValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map StructField FieldValue -> Text
forall a. StructField a -> Text
structFieldName [StructField FieldValue]
valueFields
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([StructField FieldValue] -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length [StructField FieldValue]
valueFields MonthOfYear -> MonthOfYear -> Bool
forall a. Eq a => a -> a -> Bool
/= [StructField LogicalTypeRep] -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length [StructField LogicalTypeRep]
typeFields) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: struct value/type arity mismatch")
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text]
typeNames [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text]
valueNames) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: struct value/type field names mismatch")
    childValues <-
        (StructField LogicalTypeRep
 -> StructField FieldValue -> IO DuckDBValue)
-> [StructField LogicalTypeRep]
-> [StructField FieldValue]
-> IO [DuckDBValue]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
            ( \StructField{structFieldValue :: forall a. StructField a -> a
structFieldValue = LogicalTypeRep
typeRep} StructField{structFieldValue :: forall a. StructField a -> a
structFieldValue = FieldValue
fieldVal} ->
                LogicalTypeRep -> FieldValue -> IO DuckDBValue
fieldValueWithTypeDuckValue LogicalTypeRep
typeRep FieldValue
fieldVal
            )
            [StructField LogicalTypeRep]
typeFields
            [StructField FieldValue]
valueFields
    structLogical <- logicalTypeFromRep (LogicalTypeStruct structValueTypes)
    result <-
        withDuckValues childValues $ c_duckdb_create_struct_value structLogical
    mapM_ destroyValue childValues
    destroyLogicalType structLogical
    pure result

unionValueDuckValue :: UnionValue FieldValue -> IO DuckDBValue
unionValueDuckValue :: UnionValue FieldValue -> IO DuckDBValue
unionValueDuckValue UnionValue{Word16
unionValueIndex :: Word16
unionValueIndex :: forall a. UnionValue a -> Word16
unionValueIndex, FieldValue
unionValuePayload :: FieldValue
unionValuePayload :: forall a. UnionValue a -> a
unionValuePayload, Array MonthOfYear UnionMemberType
unionValueMembers :: Array MonthOfYear UnionMemberType
unionValueMembers :: forall a. UnionValue a -> Array MonthOfYear UnionMemberType
unionValueMembers} = do
    let membersList :: [UnionMemberType]
membersList = Array MonthOfYear UnionMemberType -> [UnionMemberType]
forall i e. Array i e -> [e]
elems Array MonthOfYear UnionMemberType
unionValueMembers
        idx :: MonthOfYear
idx = Word16 -> MonthOfYear
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
unionValueIndex :: Int
        memberCount :: MonthOfYear
memberCount = [UnionMemberType] -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length [UnionMemberType]
membersList
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MonthOfYear
idx MonthOfYear -> MonthOfYear -> Bool
forall a. Ord a => a -> a -> Bool
< MonthOfYear
0 Bool -> Bool -> Bool
|| MonthOfYear
idx MonthOfYear -> MonthOfYear -> Bool
forall a. Ord a => a -> a -> Bool
>= MonthOfYear
memberCount) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: union value tag out of range")
    let UnionMemberType{unionMemberType :: UnionMemberType -> LogicalTypeRep
unionMemberType = LogicalTypeRep
memberType} = [UnionMemberType]
membersList [UnionMemberType] -> MonthOfYear -> UnionMemberType
forall a. HasCallStack => [a] -> MonthOfYear -> a
!! MonthOfYear
idx
    payloadValue <- LogicalTypeRep -> FieldValue -> IO DuckDBValue
fieldValueWithTypeDuckValue LogicalTypeRep
memberType FieldValue
unionValuePayload
    unionLogical <- logicalTypeFromRep (LogicalTypeUnion unionValueMembers)
    result <- c_duckdb_create_union_value unionLogical (fromIntegral unionValueIndex) payloadValue
    destroyValue payloadValue
    destroyLogicalType unionLogical
    pure result

fieldValueWithTypeDuckValue :: LogicalTypeRep -> FieldValue -> IO DuckDBValue
fieldValueWithTypeDuckValue :: LogicalTypeRep -> FieldValue -> IO DuckDBValue
fieldValueWithTypeDuckValue LogicalTypeRep
_ FieldValue
FieldNull = IO DuckDBValue
nullDuckValue
fieldValueWithTypeDuckValue LogicalTypeRep
rep FieldValue
value =
    case LogicalTypeRep
rep of
        LogicalTypeScalar DuckDBType
dtype -> DuckDBType -> FieldValue -> IO DuckDBValue
scalarFieldValueDuckValue DuckDBType
dtype FieldValue
value
        LogicalTypeDecimal Word8
width Word8
scale ->
            case FieldValue
value of
                FieldDecimal decVal :: DecimalValue
decVal@DecimalValue{Word8
decimalWidth :: Word8
decimalWidth :: DecimalValue -> Word8
decimalWidth, Word8
decimalScale :: Word8
decimalScale :: DecimalValue -> Word8
decimalScale}
                    | Word8
decimalWidth Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
width Bool -> Bool -> Bool
&& Word8
decimalScale Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
scale -> DecimalValue -> IO DuckDBValue
decimalDuckValue DecimalValue
decVal
                    | Bool
otherwise -> IOError -> IO DuckDBValue
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: decimal value metadata mismatch")
                FieldValue
other -> String -> FieldValue -> IO DuckDBValue
forall a. String -> FieldValue -> IO a
typeMismatch String
"DECIMAL" FieldValue
other
        LogicalTypeList LogicalTypeRep
elemRep ->
            case FieldValue
value of
                FieldList [FieldValue]
elemsList -> do
                    childLogical <- LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep LogicalTypeRep
elemRep
                    values <- mapM (fieldValueWithTypeDuckValue elemRep) elemsList
                    result <-
                        withDuckValues values \Ptr DuckDBValue
ptr ->
                            DuckDBLogicalType -> Ptr DuckDBValue -> Word64 -> IO DuckDBValue
c_duckdb_create_list_value DuckDBLogicalType
childLogical Ptr DuckDBValue
ptr (MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([FieldValue] -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length [FieldValue]
elemsList))
                    mapM_ destroyValue values
                    destroyLogicalType childLogical
                    pure result
                FieldValue
other -> String -> FieldValue -> IO DuckDBValue
forall a. String -> FieldValue -> IO a
typeMismatch String
"LIST" FieldValue
other
        LogicalTypeArray LogicalTypeRep
elemRep Word64
size ->
            case FieldValue
value of
                FieldArray Array MonthOfYear FieldValue
arr -> do
                    let elemsList :: [FieldValue]
elemsList = Array MonthOfYear FieldValue -> [FieldValue]
forall i e. Array i e -> [e]
elems Array MonthOfYear FieldValue
arr
                        actualCount :: MonthOfYear
actualCount = [FieldValue] -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length [FieldValue]
elemsList
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
actualCount Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
size) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                        IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: array length mismatch")
                    childLogical <- LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep LogicalTypeRep
elemRep
                    values <- mapM (fieldValueWithTypeDuckValue elemRep) elemsList
                    result <-
                        withDuckValues values \Ptr DuckDBValue
ptr ->
                            DuckDBLogicalType -> Ptr DuckDBValue -> Word64 -> IO DuckDBValue
c_duckdb_create_array_value DuckDBLogicalType
childLogical Ptr DuckDBValue
ptr (MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
actualCount)
                    mapM_ destroyValue values
                    destroyLogicalType childLogical
                    pure result
                FieldValue
other -> String -> FieldValue -> IO DuckDBValue
forall a. String -> FieldValue -> IO a
typeMismatch String
"ARRAY" FieldValue
other
        LogicalTypeMap LogicalTypeRep
keyRep LogicalTypeRep
valueRep ->
            case FieldValue
value of
                FieldMap [(FieldValue, FieldValue)]
pairs -> do
                    let count :: MonthOfYear
count = [(FieldValue, FieldValue)] -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length [(FieldValue, FieldValue)]
pairs
                    keyValues <- ((FieldValue, FieldValue) -> IO DuckDBValue)
-> [(FieldValue, FieldValue)] -> IO [DuckDBValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (LogicalTypeRep -> FieldValue -> IO DuckDBValue
fieldValueWithTypeDuckValue LogicalTypeRep
keyRep (FieldValue -> IO DuckDBValue)
-> ((FieldValue, FieldValue) -> FieldValue)
-> (FieldValue, FieldValue)
-> IO DuckDBValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldValue, FieldValue) -> FieldValue
forall a b. (a, b) -> a
fst) [(FieldValue, FieldValue)]
pairs
                    valValues <- mapM (fieldValueWithTypeDuckValue valueRep . snd) pairs
                    mapLogical <- logicalTypeFromRep (LogicalTypeMap keyRep valueRep)
                    result <-
                        withDuckValues keyValues \Ptr DuckDBValue
keyPtr ->
                            [DuckDBValue]
-> (Ptr DuckDBValue -> IO DuckDBValue) -> IO DuckDBValue
forall a. [DuckDBValue] -> (Ptr DuckDBValue -> IO a) -> IO a
withDuckValues [DuckDBValue]
valValues \Ptr DuckDBValue
valPtr ->
                                DuckDBLogicalType
-> Ptr DuckDBValue -> Ptr DuckDBValue -> Word64 -> IO DuckDBValue
c_duckdb_create_map_value DuckDBLogicalType
mapLogical Ptr DuckDBValue
keyPtr Ptr DuckDBValue
valPtr (MonthOfYear -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
count)
                    mapM_ destroyValue keyValues
                    mapM_ destroyValue valValues
                    destroyLogicalType mapLogical
                    pure result
                FieldValue
other -> String -> FieldValue -> IO DuckDBValue
forall a. String -> FieldValue -> IO a
typeMismatch String
"MAP" FieldValue
other
        LogicalTypeStruct Array MonthOfYear (StructField LogicalTypeRep)
structRep ->
            case FieldValue
value of
                FieldStruct StructValue FieldValue
structVal
                    | StructValue FieldValue -> LogicalTypeRep
forall a. StructValue a -> LogicalTypeRep
structValueTypeRep StructValue FieldValue
structVal LogicalTypeRep -> LogicalTypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Array MonthOfYear (StructField LogicalTypeRep) -> LogicalTypeRep
LogicalTypeStruct Array MonthOfYear (StructField LogicalTypeRep)
structRep -> StructValue FieldValue -> IO DuckDBValue
structValueDuckValue StructValue FieldValue
structVal
                    | Bool
otherwise -> IOError -> IO DuckDBValue
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: struct value type mismatch")
                FieldValue
other -> String -> FieldValue -> IO DuckDBValue
forall a. String -> FieldValue -> IO a
typeMismatch String
"STRUCT" FieldValue
other
        LogicalTypeUnion Array MonthOfYear UnionMemberType
unionRep ->
            case FieldValue
value of
                FieldUnion UnionValue FieldValue
unionVal
                    | UnionValue FieldValue -> LogicalTypeRep
forall a. UnionValue a -> LogicalTypeRep
unionValueTypeRep UnionValue FieldValue
unionVal LogicalTypeRep -> LogicalTypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Array MonthOfYear UnionMemberType -> LogicalTypeRep
LogicalTypeUnion Array MonthOfYear UnionMemberType
unionRep -> UnionValue FieldValue -> IO DuckDBValue
unionValueDuckValue UnionValue FieldValue
unionVal
                    | Bool
otherwise -> IOError -> IO DuckDBValue
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: union value type mismatch")
                FieldValue
other -> String -> FieldValue -> IO DuckDBValue
forall a. String -> FieldValue -> IO a
typeMismatch String
"UNION" FieldValue
other
        LogicalTypeEnum Array MonthOfYear Text
dict ->
            case FieldValue
value of
                FieldEnum Word32
enumIdx -> Array MonthOfYear Text -> Word32 -> IO DuckDBValue
enumDuckValue Array MonthOfYear Text
dict Word32
enumIdx
                FieldValue
other -> String -> FieldValue -> IO DuckDBValue
forall a. String -> FieldValue -> IO a
typeMismatch String
"ENUM" FieldValue
other

scalarFieldValueDuckValue :: DuckDBType -> FieldValue -> IO DuckDBValue
scalarFieldValueDuckValue :: DuckDBType -> FieldValue -> IO DuckDBValue
scalarFieldValueDuckValue DuckDBType
dtype FieldValue
value =
    case (DuckDBType
dtype, FieldValue
value) of
        (DuckDBType
DuckDBTypeBoolean, FieldBool Bool
b) -> Bool -> IO DuckDBValue
boolDuckValue Bool
b
        (DuckDBType
DuckDBTypeTinyInt, FieldInt8 Int8
i) -> Int8 -> IO DuckDBValue
int8DuckValue Int8
i
        (DuckDBType
DuckDBTypeSmallInt, FieldInt16 Int16
i) -> Int16 -> IO DuckDBValue
int16DuckValue Int16
i
        (DuckDBType
DuckDBTypeInteger, FieldInt32 Int32
i) -> Int32 -> IO DuckDBValue
int32DuckValue Int32
i
        (DuckDBType
DuckDBTypeBigInt, FieldInt64 Int64
i) -> Int64 -> IO DuckDBValue
int64DuckValue Int64
i
        (DuckDBType
DuckDBTypeUTinyInt, FieldWord8 Word8
w) -> Word8 -> IO DuckDBValue
uint8DuckValue Word8
w
        (DuckDBType
DuckDBTypeUSmallInt, FieldWord16 Word16
w) -> Word16 -> IO DuckDBValue
uint16DuckValue Word16
w
        (DuckDBType
DuckDBTypeUInteger, FieldWord32 Word32
w) -> Word32 -> IO DuckDBValue
uint32DuckValue Word32
w
        (DuckDBType
DuckDBTypeUBigInt, FieldWord64 Word64
w) -> Word64 -> IO DuckDBValue
uint64DuckValue Word64
w
        (DuckDBType
DuckDBTypeFloat, FieldFloat Float
f) -> Float -> IO DuckDBValue
floatDuckValue Float
f
        (DuckDBType
DuckDBTypeDouble, FieldDouble Double
d) -> Double -> IO DuckDBValue
doubleDuckValue Double
d
        (DuckDBType
DuckDBTypeVarchar, FieldText Text
t) -> Text -> IO DuckDBValue
textDuckValue Text
t
        (DuckDBType
DuckDBTypeBlob, FieldBlob ByteString
b) -> ByteString -> IO DuckDBValue
blobDuckValue ByteString
b
        (DuckDBType
DuckDBTypeUUID, FieldUUID UUID
u) -> UUID -> IO DuckDBValue
uuidDuckValue UUID
u
        (DuckDBType
DuckDBTypeBit, FieldBit BitString
bits) -> BitString -> IO DuckDBValue
bitDuckValue BitString
bits
        (DuckDBType
DuckDBTypeDate, FieldDate Day
d) -> Day -> IO DuckDBValue
dayDuckValue Day
d
        (DuckDBType
DuckDBTypeTime, FieldTime TimeOfDay
t) -> TimeOfDay -> IO DuckDBValue
timeOfDayDuckValue TimeOfDay
t
        (DuckDBType
DuckDBTypeTimeTz, FieldTimeTZ TimeWithZone
tz) -> TimeWithZone -> IO DuckDBValue
timeWithZoneDuckValue TimeWithZone
tz
        (DuckDBType
DuckDBTypeTimestamp, FieldTimestamp LocalTime
ts) -> LocalTime -> IO DuckDBValue
localTimeDuckValue LocalTime
ts
        (DuckDBType
DuckDBTypeTimestampTz, FieldTimestampTZ UTCTime
ts) -> UTCTime -> IO DuckDBValue
utcTimeDuckValue UTCTime
ts
        (DuckDBType
DuckDBTypeInterval, FieldInterval IntervalValue
iv) -> IntervalValue -> IO DuckDBValue
intervalDuckValue IntervalValue
iv
        (DuckDBType
DuckDBTypeHugeInt, FieldHugeInt Integer
i) -> Integer -> IO DuckDBValue
hugeIntDuckValue Integer
i
        (DuckDBType
DuckDBTypeUHugeInt, FieldUHugeInt Integer
i) -> Integer -> IO DuckDBValue
uhugeIntDuckValue Integer
i
        (DuckDBType
DuckDBTypeBigNum, FieldBigNum BigNum
big) -> BigNum -> IO DuckDBValue
bigNumDuckValue BigNum
big
        (DuckDBType
DuckDBTypeSQLNull, FieldValue
_) -> IO DuckDBValue
nullDuckValue
        (DuckDBType, FieldValue)
_ ->
            case FieldValue
value of
                FieldValue
FieldNull -> IO DuckDBValue
nullDuckValue
                FieldValue
other ->
                    IOError -> IO DuckDBValue
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO
                        ( String -> IOError
userError
                            ( String
"duckdb-simple: unsupported scalar conversion for "
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DuckDBType -> String
forall a. Show a => a -> String
show DuckDBType
dtype
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" from "
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FieldValue -> String
forall a. Show a => a -> String
show FieldValue
other
                            )
                        )

enumDuckValue :: Array Int Text -> Word32 -> IO DuckDBValue
enumDuckValue :: Array MonthOfYear Text -> Word32 -> IO DuckDBValue
enumDuckValue Array MonthOfYear Text
dict Word32
idx = do
    enumLogical <- LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep (Array MonthOfYear Text -> LogicalTypeRep
LogicalTypeEnum Array MonthOfYear Text
dict)
    result <- c_duckdb_create_enum_value enumLogical (fromIntegral idx)
    destroyLogicalType enumLogical
    pure result

hugeIntDuckValue :: Integer -> IO DuckDBValue
hugeIntDuckValue :: Integer -> IO DuckDBValue
hugeIntDuckValue Integer
value =
    Integer -> IO DuckDBHugeInt
integerToHugeInt Integer
value IO DuckDBHugeInt
-> (DuckDBHugeInt -> IO DuckDBValue) -> IO DuckDBValue
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DuckDBHugeInt
huge ->
        (Ptr DuckDBHugeInt -> IO DuckDBValue) -> IO DuckDBValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBHugeInt
ptr -> do
            Ptr DuckDBHugeInt -> DuckDBHugeInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBHugeInt
ptr DuckDBHugeInt
huge
            Ptr DuckDBHugeInt -> IO DuckDBValue
c_duckdb_create_hugeint Ptr DuckDBHugeInt
ptr

uhugeIntDuckValue :: Integer -> IO DuckDBValue
uhugeIntDuckValue :: Integer -> IO DuckDBValue
uhugeIntDuckValue Integer
value =
    Integer -> IO DuckDBUHugeInt
integerToUHugeInt Integer
value IO DuckDBUHugeInt
-> (DuckDBUHugeInt -> IO DuckDBValue) -> IO DuckDBValue
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DuckDBUHugeInt
uhu ->
        (Ptr DuckDBUHugeInt -> IO DuckDBValue) -> IO DuckDBValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBUHugeInt
ptr -> do
            Ptr DuckDBUHugeInt -> DuckDBUHugeInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBUHugeInt
ptr DuckDBUHugeInt
uhu
            Ptr DuckDBUHugeInt -> IO DuckDBValue
c_duckdb_create_uhugeint Ptr DuckDBUHugeInt
ptr

decimalDuckValue :: DecimalValue -> IO DuckDBValue
decimalDuckValue :: DecimalValue -> IO DuckDBValue
decimalDuckValue DecimalValue{Word8
decimalWidth :: DecimalValue -> Word8
decimalWidth :: Word8
decimalWidth, Word8
decimalScale :: DecimalValue -> Word8
decimalScale :: Word8
decimalScale, Integer
decimalInteger :: Integer
decimalInteger :: DecimalValue -> Integer
decimalInteger} = do
    huge <- Integer -> IO DuckDBHugeInt
integerToHugeInt Integer
decimalInteger
    alloca \Ptr DuckDBDecimal
ptr -> do
        Ptr DuckDBDecimal -> DuckDBDecimal -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
            Ptr DuckDBDecimal
ptr
            DuckDBDecimal
                { duckDBDecimalWidth :: Word8
duckDBDecimalWidth = Word8
decimalWidth
                , duckDBDecimalScale :: Word8
duckDBDecimalScale = Word8
decimalScale
                , duckDBDecimalValue :: DuckDBHugeInt
duckDBDecimalValue = DuckDBHugeInt
huge
                }
        Ptr DuckDBDecimal -> IO DuckDBValue
c_duckdb_create_decimal Ptr DuckDBDecimal
ptr

intervalDuckValue :: IntervalValue -> IO DuckDBValue
intervalDuckValue :: IntervalValue -> IO DuckDBValue
intervalDuckValue IntervalValue{Int32
intervalMonths :: Int32
intervalMonths :: IntervalValue -> Int32
intervalMonths, Int32
intervalDays :: Int32
intervalDays :: IntervalValue -> Int32
intervalDays, Int64
intervalMicros :: Int64
intervalMicros :: IntervalValue -> Int64
intervalMicros} =
    (Ptr DuckDBInterval -> IO DuckDBValue) -> IO DuckDBValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBInterval
ptr -> do
        Ptr DuckDBInterval -> DuckDBInterval -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBInterval
ptr (Int32 -> Int32 -> Int64 -> DuckDBInterval
DuckDBInterval Int32
intervalMonths Int32
intervalDays Int64
intervalMicros)
        Ptr DuckDBInterval -> IO DuckDBValue
c_duckdb_create_interval Ptr DuckDBInterval
ptr

timeWithZoneDuckValue :: TimeWithZone -> IO DuckDBValue
timeWithZoneDuckValue :: TimeWithZone -> IO DuckDBValue
timeWithZoneDuckValue TimeWithZone{TimeOfDay
timeWithZoneTime :: TimeOfDay
timeWithZoneTime :: TimeWithZone -> TimeOfDay
timeWithZoneTime, TimeZone
timeWithZoneZone :: TimeZone
timeWithZoneZone :: TimeWithZone -> TimeZone
timeWithZoneZone} = do
    let totalMicros :: Integer
totalMicros = DiffTime -> Integer
diffTimeToPicoseconds (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
timeWithZoneTime) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000
        offsetSeconds :: MonthOfYear
offsetSeconds = TimeZone -> MonthOfYear
timeZoneMinutes TimeZone
timeWithZoneZone MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
* MonthOfYear
60
    tzValue <- Int64 -> Int32 -> IO DuckDBTimeTz
c_duckdb_create_time_tz (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
totalMicros) (MonthOfYear -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
offsetSeconds)
    c_duckdb_create_time_tz_value tzValue

integerToHugeInt :: Integer -> IO DuckDBHugeInt
integerToHugeInt :: Integer -> IO DuckDBHugeInt
integerToHugeInt Integer
value = do
    let minVal :: Integer
minVal = Integer -> Integer
forall a. Num a => a -> a
negate (Integer
1 Integer -> MonthOfYear -> Integer
forall a. Bits a => a -> MonthOfYear -> a
`shiftL` MonthOfYear
127)
        maxVal :: Integer
maxVal = (Integer
1 Integer -> MonthOfYear -> Integer
forall a. Bits a => a -> MonthOfYear -> a
`shiftL` MonthOfYear
127) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
minVal Bool -> Bool -> Bool
|| Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxVal) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: HUGEINT value out of range")
    let lowerMask :: Integer
lowerMask = (Integer
1 Integer -> MonthOfYear -> Integer
forall a. Bits a => a -> MonthOfYear -> a
`shiftL` MonthOfYear
64) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
        lower :: Word64
lower = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
value Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
lowerMask)
        upper :: Int64
upper = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
value Integer -> MonthOfYear -> Integer
forall a. Bits a => a -> MonthOfYear -> a
`shiftR` MonthOfYear
64)
    DuckDBHugeInt -> IO DuckDBHugeInt
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DuckDBHugeInt{duckDBHugeIntLower :: Word64
duckDBHugeIntLower = Word64
lower, duckDBHugeIntUpper :: Int64
duckDBHugeIntUpper = Int64
upper}

integerToUHugeInt :: Integer -> IO DuckDBUHugeInt
integerToUHugeInt :: Integer -> IO DuckDBUHugeInt
integerToUHugeInt Integer
value = do
    let minVal :: Integer
minVal = Integer
0
        maxVal :: Integer
maxVal = (Integer
1 Integer -> MonthOfYear -> Integer
forall a. Bits a => a -> MonthOfYear -> a
`shiftL` MonthOfYear
128) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
minVal Bool -> Bool -> Bool
|| Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxVal) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> IOError
userError String
"duckdb-simple: UHUGEINT value out of range")
    let lowerMask :: Integer
lowerMask = (Integer
1 Integer -> MonthOfYear -> Integer
forall a. Bits a => a -> MonthOfYear -> a
`shiftL` MonthOfYear
64) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
        lower :: Word64
lower = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
value Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
lowerMask)
        upper :: Word64
upper = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
value Integer -> MonthOfYear -> Integer
forall a. Bits a => a -> MonthOfYear -> a
`shiftR` MonthOfYear
64)
    DuckDBUHugeInt -> IO DuckDBUHugeInt
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DuckDBUHugeInt{duckDBUHugeIntLower :: Word64
duckDBUHugeIntLower = Word64
lower, duckDBUHugeIntUpper :: Word64
duckDBUHugeIntUpper = Word64
upper}

withDuckValues :: [DuckDBValue] -> (Ptr DuckDBValue -> IO a) -> IO a
withDuckValues :: forall a. [DuckDBValue] -> (Ptr DuckDBValue -> IO a) -> IO a
withDuckValues [DuckDBValue]
xs Ptr DuckDBValue -> IO a
action = [DuckDBValue] -> (Ptr DuckDBValue -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [DuckDBValue]
xs Ptr DuckDBValue -> IO a
action

typeMismatch :: String -> FieldValue -> IO a
typeMismatch :: forall a. String -> FieldValue -> IO a
typeMismatch String
expected FieldValue
actual =
    IOError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO
        ( String -> IOError
userError
            ( String
"duckdb-simple: cannot encode "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FieldValue -> String
forall a. Show a => a -> String
show FieldValue
actual
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" as "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
expected
            )
        )

createElementLogicalType :: forall a. (DuckDBColumnType a) => Proxy a -> IO DuckDBLogicalType
createElementLogicalType :: forall a. DuckDBColumnType a => Proxy a -> IO DuckDBLogicalType
createElementLogicalType Proxy a
proxy =
    let typeName :: Text
typeName = Proxy a -> Text
forall a. DuckDBColumnType a => Proxy a -> Text
duckdbColumnType Proxy a
proxy
     in case Text -> Maybe DuckDBType
duckDBTypeFromName Text
typeName of
            Just DuckDBType
dtype -> DuckDBType -> IO DuckDBLogicalType
c_duckdb_create_logical_type DuckDBType
dtype
            Maybe DuckDBType
Nothing ->
                SQLError -> IO DuckDBLogicalType
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO
                    ( SQLError
                        { sqlErrorMessage :: Text
sqlErrorMessage =
                            [Text] -> Text
Text.concat
                                [ Text
"duckdb-simple: unsupported array element type "
                                , Text
typeName
                                ]
                        , sqlErrorType :: Maybe DuckDBErrorType
sqlErrorType = Maybe DuckDBErrorType
forall a. Maybe a
Nothing
                        , sqlErrorQuery :: Maybe Query
sqlErrorQuery = Maybe Query
forall a. Maybe a
Nothing
                        }
                    )

duckDBTypeFromName :: Text -> Maybe DuckDBType
duckDBTypeFromName :: Text -> Maybe DuckDBType
duckDBTypeFromName Text
name =
    case Text
name of
        Text
"BOOLEAN" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeBoolean
        Text
"TINYINT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeTinyInt
        Text
"SMALLINT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeSmallInt
        Text
"INTEGER" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeInteger
        Text
"BIGINT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeBigInt
        Text
"UTINYINT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeUTinyInt
        Text
"USMALLINT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeUSmallInt
        Text
"UINTEGER" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeUInteger
        Text
"UBIGINT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeUBigInt
        Text
"FLOAT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeFloat
        Text
"DOUBLE" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeDouble
        Text
"DATE" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeDate
        Text
"TIME" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeTime
        Text
"TIMESTAMP" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeTimestamp
        Text
"TIMESTAMPTZ" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeTimestampTz
        Text
"TEXT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeVarchar
        Text
"BLOB" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeBlob
        Text
"UUID" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeUUID
        Text
"BIT" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeBit
        Text
"BIGNUM" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeBigNum
        -- treat NULL as SQLNULL to provide element type for Maybe values without data
        Text
"NULL" -> DuckDBType -> Maybe DuckDBType
forall a. a -> Maybe a
Just DuckDBType
DuckDBTypeSQLNull
        Text
_ -> Maybe DuckDBType
forall a. Maybe a
Nothing

destroyLogicalType :: DuckDBLogicalType -> IO ()
destroyLogicalType :: DuckDBLogicalType -> IO ()
destroyLogicalType DuckDBLogicalType
logical =
    (Ptr DuckDBLogicalType -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr DuckDBLogicalType -> IO ()) -> IO ())
-> (Ptr DuckDBLogicalType -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBLogicalType
ptr -> do
        Ptr DuckDBLogicalType -> DuckDBLogicalType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBLogicalType
ptr DuckDBLogicalType
logical
        Ptr DuckDBLogicalType -> IO ()
c_duckdb_destroy_logical_type Ptr DuckDBLogicalType
ptr

instance ToDuckValue Null where
    toDuckValue :: Null -> IO DuckDBValue
toDuckValue Null
_ = IO DuckDBValue
nullDuckValue

instance ToDuckValue Bool where
    toDuckValue :: Bool -> IO DuckDBValue
toDuckValue = Bool -> IO DuckDBValue
boolDuckValue

instance ToDuckValue Int where
    toDuckValue :: MonthOfYear -> IO DuckDBValue
toDuckValue = Int64 -> IO DuckDBValue
int64DuckValue (Int64 -> IO DuckDBValue)
-> (MonthOfYear -> Int64) -> MonthOfYear -> IO DuckDBValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthOfYear -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToDuckValue Int8 where
    toDuckValue :: Int8 -> IO DuckDBValue
toDuckValue = Int8 -> IO DuckDBValue
int8DuckValue

instance ToDuckValue Int16 where
    toDuckValue :: Int16 -> IO DuckDBValue
toDuckValue = Int16 -> IO DuckDBValue
int16DuckValue

instance ToDuckValue Int32 where
    toDuckValue :: Int32 -> IO DuckDBValue
toDuckValue = Int32 -> IO DuckDBValue
int32DuckValue

instance ToDuckValue Int64 where
    toDuckValue :: Int64 -> IO DuckDBValue
toDuckValue = Int64 -> IO DuckDBValue
int64DuckValue

instance ToDuckValue BigNum where
    toDuckValue :: BigNum -> IO DuckDBValue
toDuckValue = BigNum -> IO DuckDBValue
bigNumDuckValue

instance ToDuckValue UUID.UUID where
    toDuckValue :: UUID -> IO DuckDBValue
toDuckValue = UUID -> IO DuckDBValue
uuidDuckValue

instance ToDuckValue Integer where
    toDuckValue :: Integer -> IO DuckDBValue
toDuckValue = BigNum -> IO DuckDBValue
bigNumDuckValue (BigNum -> IO DuckDBValue)
-> (Integer -> BigNum) -> Integer -> IO DuckDBValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigNum
BigNum

instance ToDuckValue Natural where
    toDuckValue :: Natural -> IO DuckDBValue
toDuckValue = BigNum -> IO DuckDBValue
bigNumDuckValue (BigNum -> IO DuckDBValue)
-> (Natural -> BigNum) -> Natural -> IO DuckDBValue
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 ToDuckValue Word where
    toDuckValue :: Word -> IO DuckDBValue
toDuckValue = Word64 -> IO DuckDBValue
uint64DuckValue (Word64 -> IO DuckDBValue)
-> (Word -> Word64) -> Word -> IO DuckDBValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToDuckValue Word16 where
    toDuckValue :: Word16 -> IO DuckDBValue
toDuckValue = Word16 -> IO DuckDBValue
uint16DuckValue

instance ToDuckValue Word32 where
    toDuckValue :: Word32 -> IO DuckDBValue
toDuckValue = Word32 -> IO DuckDBValue
uint32DuckValue

instance ToDuckValue Word64 where
    toDuckValue :: Word64 -> IO DuckDBValue
toDuckValue = Word64 -> IO DuckDBValue
uint64DuckValue

instance ToDuckValue Word8 where
    toDuckValue :: Word8 -> IO DuckDBValue
toDuckValue = Word8 -> IO DuckDBValue
uint8DuckValue

instance ToDuckValue Double where
    toDuckValue :: Double -> IO DuckDBValue
toDuckValue = Double -> IO DuckDBValue
doubleDuckValue

instance ToDuckValue Float where
    toDuckValue :: Float -> IO DuckDBValue
toDuckValue = Float -> IO DuckDBValue
floatDuckValue

instance ToDuckValue Text where
    toDuckValue :: Text -> IO DuckDBValue
toDuckValue = Text -> IO DuckDBValue
textDuckValue

instance ToDuckValue String where
    toDuckValue :: String -> IO DuckDBValue
toDuckValue = String -> IO DuckDBValue
stringDuckValue

instance ToDuckValue BS.ByteString where
    toDuckValue :: ByteString -> IO DuckDBValue
toDuckValue = ByteString -> IO DuckDBValue
blobDuckValue

instance ToDuckValue BitString where
    toDuckValue :: BitString -> IO DuckDBValue
toDuckValue = BitString -> IO DuckDBValue
bitDuckValue

instance ToDuckValue Day where
    toDuckValue :: Day -> IO DuckDBValue
toDuckValue = Day -> IO DuckDBValue
dayDuckValue

instance ToDuckValue TimeOfDay where
    toDuckValue :: TimeOfDay -> IO DuckDBValue
toDuckValue = TimeOfDay -> IO DuckDBValue
timeOfDayDuckValue

instance ToDuckValue LocalTime where
    toDuckValue :: LocalTime -> IO DuckDBValue
toDuckValue = LocalTime -> IO DuckDBValue
localTimeDuckValue

instance ToDuckValue UTCTime where
    toDuckValue :: UTCTime -> IO DuckDBValue
toDuckValue = UTCTime -> IO DuckDBValue
utcTimeDuckValue

instance ToDuckValue (StructValue FieldValue) where
    toDuckValue :: StructValue FieldValue -> IO DuckDBValue
toDuckValue = StructValue FieldValue -> IO DuckDBValue
structValueDuckValue

instance ToDuckValue (UnionValue FieldValue) where
    toDuckValue :: UnionValue FieldValue -> IO DuckDBValue
toDuckValue = UnionValue FieldValue -> IO DuckDBValue
unionValueDuckValue

instance (ToDuckValue a) => ToDuckValue (Maybe a) where
    toDuckValue :: Maybe a -> IO DuckDBValue
toDuckValue Maybe a
Nothing = IO DuckDBValue
nullDuckValue
    toDuckValue (Just a
value) = a -> IO DuckDBValue
forall a. ToDuckValue a => a -> IO DuckDBValue
toDuckValue a
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
                { duckDBTimestampStructDate :: DuckDBDateStruct
duckDBTimestampStructDate = Day -> DuckDBDateStruct
dayToDateStruct Day
localDay
                , duckDBTimestampStructTime :: 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
            { duckDBDateStructYear :: Int32
duckDBDateStructYear = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
year
            , duckDBDateStructMonth :: Int8
duckDBDateStructMonth = MonthOfYear -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
month
            , duckDBDateStructDay :: 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
            { duckDBTimeStructHour :: Int8
duckDBTimeStructHour = Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
hours
            , duckDBTimeStructMinute :: Int8
duckDBTimeStructMinute = Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
minutes
            , duckDBTimeStructSecond :: Int8
duckDBTimeStructSecond = Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
seconds
            , duckDBTimeStructMicros :: 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
            rc <- DuckDBPreparedStatement -> Word64 -> DuckDBValue -> IO DuckDBState
c_duckdb_bind_value DuckDBPreparedStatement
handle Word64
idx DuckDBValue
value
            when (rc /= DuckDBSuccess) $ do
                err <- fetchPrepareError handle
                throwBindError stmt 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
    msgPtr <- DuckDBPreparedStatement -> IO CString
c_duckdb_prepare_error DuckDBPreparedStatement
handle
    if msgPtr == nullPtr
        then pure (Text.pack "duckdb-simple: parameter binding failed")
        else Text.pack <$> peekCString 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. (HasCallStack, 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
            }