{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

module Database.DuckDB.FFI.Types (
    -- * Enumerations
    DuckDBState (..),
    pattern DuckDBSuccess,
    pattern DuckDBError,
    DuckDBType (..),
    pattern DuckDBTypeInvalid,
    pattern DuckDBTypeBoolean,
    pattern DuckDBTypeTinyInt,
    pattern DuckDBTypeSmallInt,
    pattern DuckDBTypeInteger,
    pattern DuckDBTypeBigInt,
    pattern DuckDBTypeUTinyInt,
    pattern DuckDBTypeUSmallInt,
    pattern DuckDBTypeUInteger,
    pattern DuckDBTypeUBigInt,
    pattern DuckDBTypeFloat,
    pattern DuckDBTypeDouble,
    pattern DuckDBTypeTimestamp,
    pattern DuckDBTypeDate,
    pattern DuckDBTypeTime,
    pattern DuckDBTypeInterval,
    pattern DuckDBTypeHugeInt,
    pattern DuckDBTypeUHugeInt,
    pattern DuckDBTypeVarchar,
    pattern DuckDBTypeBlob,
    pattern DuckDBTypeDecimal,
    pattern DuckDBTypeTimestampS,
    pattern DuckDBTypeTimestampMs,
    pattern DuckDBTypeTimestampNs,
    pattern DuckDBTypeEnum,
    pattern DuckDBTypeList,
    pattern DuckDBTypeStruct,
    pattern DuckDBTypeMap,
    pattern DuckDBTypeArray,
    pattern DuckDBTypeUUID,
    pattern DuckDBTypeUnion,
    pattern DuckDBTypeBit,
    pattern DuckDBTypeTimeTz,
    pattern DuckDBTypeTimestampTz,
    pattern DuckDBTypeAny,
    pattern DuckDBTypeBigNum,
    pattern DuckDBTypeSQLNull,
    pattern DuckDBTypeStringLiteral,
    pattern DuckDBTypeIntegerLiteral,
    pattern DuckDBTypeTimeNs,
    DuckDBPendingState (..),
    pattern DuckDBPendingResultReady,
    pattern DuckDBPendingResultNotReady,
    pattern DuckDBPendingError,
    pattern DuckDBPendingNoTasksAvailable,
    DuckDBResultType (..),
    pattern DuckDBResultTypeInvalid,
    pattern DuckDBResultTypeChangedRows,
    pattern DuckDBResultTypeNothing,
    pattern DuckDBResultTypeQueryResult,
    DuckDBStatementType (..),
    pattern DuckDBStatementTypeInvalid,
    pattern DuckDBStatementTypeSelect,
    pattern DuckDBStatementTypeInsert,
    pattern DuckDBStatementTypeUpdate,
    pattern DuckDBStatementTypeExplain,
    pattern DuckDBStatementTypeDelete,
    pattern DuckDBStatementTypePrepare,
    pattern DuckDBStatementTypeCreate,
    pattern DuckDBStatementTypeExecute,
    pattern DuckDBStatementTypeAlter,
    pattern DuckDBStatementTypeTransaction,
    pattern DuckDBStatementTypeCopy,
    pattern DuckDBStatementTypeAnalyze,
    pattern DuckDBStatementTypeVariableSet,
    pattern DuckDBStatementTypeCreateFunc,
    pattern DuckDBStatementTypeDrop,
    pattern DuckDBStatementTypeExport,
    pattern DuckDBStatementTypePragma,
    pattern DuckDBStatementTypeVacuum,
    pattern DuckDBStatementTypeCall,
    pattern DuckDBStatementTypeSet,
    pattern DuckDBStatementTypeLoad,
    pattern DuckDBStatementTypeRelation,
    pattern DuckDBStatementTypeExtension,
    pattern DuckDBStatementTypeLogicalPlan,
    pattern DuckDBStatementTypeAttach,
    pattern DuckDBStatementTypeDetach,
    pattern DuckDBStatementTypeMulti,
    DuckDBErrorType (..),
    pattern DuckDBErrorInvalid,
    pattern DuckDBErrorOutOfRange,
    pattern DuckDBErrorConversion,
    pattern DuckDBErrorUnknownType,
    pattern DuckDBErrorDecimal,
    pattern DuckDBErrorMismatchType,
    pattern DuckDBErrorDivideByZero,
    pattern DuckDBErrorObjectSize,
    pattern DuckDBErrorInvalidType,
    pattern DuckDBErrorSerialization,
    pattern DuckDBErrorTransaction,
    pattern DuckDBErrorNotImplemented,
    pattern DuckDBErrorExpression,
    pattern DuckDBErrorCatalog,
    pattern DuckDBErrorParser,
    pattern DuckDBErrorPlanner,
    pattern DuckDBErrorScheduler,
    pattern DuckDBErrorExecutor,
    pattern DuckDBErrorConstraint,
    pattern DuckDBErrorIndex,
    pattern DuckDBErrorStat,
    pattern DuckDBErrorConnection,
    pattern DuckDBErrorSyntax,
    pattern DuckDBErrorSettings,
    pattern DuckDBErrorBinder,
    pattern DuckDBErrorNetwork,
    pattern DuckDBErrorOptimizer,
    pattern DuckDBErrorNullPointer,
    pattern DuckDBErrorIO,
    pattern DuckDBErrorInterrupt,
    pattern DuckDBErrorFatal,
    pattern DuckDBErrorInternal,
    pattern DuckDBErrorInvalidInput,
    pattern DuckDBErrorOutOfMemory,
    pattern DuckDBErrorPermission,
    pattern DuckDBErrorParameterNotResolved,
    pattern DuckDBErrorParameterNotAllowed,
    pattern DuckDBErrorDependency,
    pattern DuckDBErrorHTTP,
    pattern DuckDBErrorMissingExtension,
    pattern DuckDBErrorAutoload,
    pattern DuckDBErrorSequence,
    pattern DuckDBInvalidConfiguration,
    pattern DuckDBErrorInvalidConfiguration,
    DuckDBCastMode (..),
    pattern DuckDBCastNormal,
    pattern DuckDBCastTry,

    -- * Scalar Types
    DuckDBIdx,
    DuckDBSel,
    DuckDBDate (..),
    DuckDBDateStruct (..),
    DuckDBTime (..),
    DuckDBTimeStruct (..),
    DuckDBTimeNs (..),
    DuckDBTimeTz (..),
    DuckDBTimeTzStruct (..),
    DuckDBTimestamp (..),
    DuckDBTimestampStruct (..),
    DuckDBTimestampS (..),
    DuckDBTimestampMs (..),
    DuckDBTimestampNs (..),
    DuckDBInterval (..),
    DuckDBHugeInt (..),
    DuckDBUHugeInt (..),
    DuckDBDecimal (..),
    DuckDBBlob (..),
    DuckDBString (..),
    DuckDBStringT,
    DuckDBBit (..),
    DuckDBBignum (..),
    DuckDBQueryProgress (..),

    -- * Result Structures
    DuckDBResult (..),
    DuckDBColumn,

    -- * Opaque Pointer Types
    DuckDBDatabase,
    DuckDBConnection,
    DuckDBConfig,
    DuckDBInstanceCache,
    DuckDBArrowOptions,
    DuckDBArrow,
    DuckDBArrowSchema,
    DuckDBArrowArray,
    ArrowSchemaPtr (..),
    ArrowArrayPtr (..),
    ArrowStreamPtr (..),
    DuckDBArrowConvertedSchema,
    DuckDBArrowStream,
    DuckDBPreparedStatement,
    DuckDBPendingResult,
    DuckDBExtractedStatements,
    DuckDBLogicalType,
    DuckDBCreateTypeInfo,
    DuckDBVector,
    DuckDBDataChunk,
    DuckDBSelectionVector,
    DuckDBFunctionInfo,
    DuckDBBindInfo,
    DuckDBInitInfo,
    DuckDBScalarFunction,
    DuckDBScalarFunctionSet,
    DuckDBAggregateFunction,
    DuckDBAggregateFunctionSet,
    DuckDBAggregateState,
    DuckDBCastFunction,
    DuckDBExpression,
    DuckDBClientContext,
    DuckDBTableFunction,
    DuckDBValue,
    DuckDBErrorData,
    DuckDBAppender,
    DuckDBTableDescription,
    DuckDBProfilingInfo,
    DuckDBReplacementScanInfo,
    DuckDBTaskState,
    ArrowArray (..),
    ArrowSchema (..),

    -- * Opaque Struct Tags
    DuckDBDatabaseStruct,
    DuckDBConnectionStruct,
    DuckDBConfigStruct,
    DuckDBInstanceCacheStruct,
    DuckDBExtractedStatementsStruct,
    DuckDBFunctionInfoStruct,
    DuckDBBindInfoStruct,
    DuckDBScalarFunctionStruct,
    DuckDBScalarFunctionSetStruct,
    DuckDBAggregateFunctionStruct,
    DuckDBAggregateFunctionSetStruct,
    DuckDBVectorStruct,
    DuckDBDataChunkStruct,
    DuckDBSelectionVectorStruct,
    DuckDBArrowOptionsStruct,
    DuckDBArrowStruct,
    DuckDBArrowConvertedSchemaStruct,
    DuckDBArrowStreamStruct,
    DuckDBExpressionStruct,
    DuckDBClientContextStruct,
    DuckDBPreparedStatementStruct,
    DuckDBValueStruct,
    DuckDBPendingResultStruct,
    DuckDBLogicalTypeStruct,
    DuckDBCreateTypeInfoStruct,
    DuckDBErrorDataStruct,
    DuckDBInitInfoStruct,
    DuckDBCastFunctionStruct,
    DuckDBTableFunctionStruct,
    DuckDBAppenderStruct,
    DuckDBTableDescriptionStruct,
    DuckDBProfilingInfoStruct,
    DuckDBReplacementScanInfoStruct,
    DuckDBAggregateStateStruct,

    -- * Function Pointer Types
    DuckDBScalarFunctionFun,
    DuckDBScalarFunctionBindFun,
    DuckDBDeleteCallback,
    DuckDBCopyCallback,
    DuckDBCastFunctionFun,
    DuckDBAggregateStateSizeFun,
    DuckDBAggregateInitFun,
    DuckDBAggregateDestroyFun,
    DuckDBAggregateUpdateFun,
    DuckDBAggregateCombineFun,
    DuckDBAggregateFinalizeFun,
    DuckDBTableFunctionBindFun,
    DuckDBTableFunctionInitFun,
    DuckDBTableFunctionFun,
    DuckDBReplacementCallback,
) where

import Data.Int (Int32, Int64, Int8)
import Data.Word (Word32, Word64, Word8)
import Foreign.C.String (CString)
import Foreign.C.Types
import Foreign.Ptr (FunPtr, Ptr, nullPtr)
import Foreign.Storable (Storable (..), peekByteOff, pokeByteOff)

-- | Unsigned index type used by DuckDB (mirrors @idx_t@).
type DuckDBIdx = Word64

-- | Selection vector entry type (mirrors @sel_t@).
type DuckDBSel = Word32

-- | Result state returned by most DuckDB C API calls.
newtype DuckDBState = DuckDBState {DuckDBState -> CInt
unDuckDBState :: CInt}
    deriving (DuckDBState -> DuckDBState -> Bool
(DuckDBState -> DuckDBState -> Bool)
-> (DuckDBState -> DuckDBState -> Bool) -> Eq DuckDBState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBState -> DuckDBState -> Bool
== :: DuckDBState -> DuckDBState -> Bool
$c/= :: DuckDBState -> DuckDBState -> Bool
/= :: DuckDBState -> DuckDBState -> Bool
Eq, Eq DuckDBState
Eq DuckDBState =>
(DuckDBState -> DuckDBState -> Ordering)
-> (DuckDBState -> DuckDBState -> Bool)
-> (DuckDBState -> DuckDBState -> Bool)
-> (DuckDBState -> DuckDBState -> Bool)
-> (DuckDBState -> DuckDBState -> Bool)
-> (DuckDBState -> DuckDBState -> DuckDBState)
-> (DuckDBState -> DuckDBState -> DuckDBState)
-> Ord DuckDBState
DuckDBState -> DuckDBState -> Bool
DuckDBState -> DuckDBState -> Ordering
DuckDBState -> DuckDBState -> DuckDBState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBState -> DuckDBState -> Ordering
compare :: DuckDBState -> DuckDBState -> Ordering
$c< :: DuckDBState -> DuckDBState -> Bool
< :: DuckDBState -> DuckDBState -> Bool
$c<= :: DuckDBState -> DuckDBState -> Bool
<= :: DuckDBState -> DuckDBState -> Bool
$c> :: DuckDBState -> DuckDBState -> Bool
> :: DuckDBState -> DuckDBState -> Bool
$c>= :: DuckDBState -> DuckDBState -> Bool
>= :: DuckDBState -> DuckDBState -> Bool
$cmax :: DuckDBState -> DuckDBState -> DuckDBState
max :: DuckDBState -> DuckDBState -> DuckDBState
$cmin :: DuckDBState -> DuckDBState -> DuckDBState
min :: DuckDBState -> DuckDBState -> DuckDBState
Ord, Int -> DuckDBState -> ShowS
[DuckDBState] -> ShowS
DuckDBState -> String
(Int -> DuckDBState -> ShowS)
-> (DuckDBState -> String)
-> ([DuckDBState] -> ShowS)
-> Show DuckDBState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBState -> ShowS
showsPrec :: Int -> DuckDBState -> ShowS
$cshow :: DuckDBState -> String
show :: DuckDBState -> String
$cshowList :: [DuckDBState] -> ShowS
showList :: [DuckDBState] -> ShowS
Show, Ptr DuckDBState -> IO DuckDBState
Ptr DuckDBState -> Int -> IO DuckDBState
Ptr DuckDBState -> Int -> DuckDBState -> IO ()
Ptr DuckDBState -> DuckDBState -> IO ()
DuckDBState -> Int
(DuckDBState -> Int)
-> (DuckDBState -> Int)
-> (Ptr DuckDBState -> Int -> IO DuckDBState)
-> (Ptr DuckDBState -> Int -> DuckDBState -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBState)
-> (forall b. Ptr b -> Int -> DuckDBState -> IO ())
-> (Ptr DuckDBState -> IO DuckDBState)
-> (Ptr DuckDBState -> DuckDBState -> IO ())
-> Storable DuckDBState
forall b. Ptr b -> Int -> IO DuckDBState
forall b. Ptr b -> Int -> DuckDBState -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBState -> Int
sizeOf :: DuckDBState -> Int
$calignment :: DuckDBState -> Int
alignment :: DuckDBState -> Int
$cpeekElemOff :: Ptr DuckDBState -> Int -> IO DuckDBState
peekElemOff :: Ptr DuckDBState -> Int -> IO DuckDBState
$cpokeElemOff :: Ptr DuckDBState -> Int -> DuckDBState -> IO ()
pokeElemOff :: Ptr DuckDBState -> Int -> DuckDBState -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBState
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBState
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBState -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBState -> IO ()
$cpeek :: Ptr DuckDBState -> IO DuckDBState
peek :: Ptr DuckDBState -> IO DuckDBState
$cpoke :: Ptr DuckDBState -> DuckDBState -> IO ()
poke :: Ptr DuckDBState -> DuckDBState -> IO ()
Storable)

-- | Pattern synonyms for @duckdb_state@ constants.
pattern DuckDBSuccess, DuckDBError :: DuckDBState
pattern $mDuckDBSuccess :: forall {r}. DuckDBState -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBSuccess :: DuckDBState
DuckDBSuccess = DuckDBState 0
pattern $mDuckDBError :: forall {r}. DuckDBState -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBError :: DuckDBState
DuckDBError = DuckDBState 1

{-# COMPLETE DuckDBSuccess, DuckDBError #-}

-- | DuckDB primitive physical type identifiers (mirrors @duckdb_type@).
newtype DuckDBType = DuckDBType {DuckDBType -> CInt
unDuckDBType :: CInt}
    deriving (DuckDBType -> DuckDBType -> Bool
(DuckDBType -> DuckDBType -> Bool)
-> (DuckDBType -> DuckDBType -> Bool) -> Eq DuckDBType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBType -> DuckDBType -> Bool
== :: DuckDBType -> DuckDBType -> Bool
$c/= :: DuckDBType -> DuckDBType -> Bool
/= :: DuckDBType -> DuckDBType -> Bool
Eq, Eq DuckDBType
Eq DuckDBType =>
(DuckDBType -> DuckDBType -> Ordering)
-> (DuckDBType -> DuckDBType -> Bool)
-> (DuckDBType -> DuckDBType -> Bool)
-> (DuckDBType -> DuckDBType -> Bool)
-> (DuckDBType -> DuckDBType -> Bool)
-> (DuckDBType -> DuckDBType -> DuckDBType)
-> (DuckDBType -> DuckDBType -> DuckDBType)
-> Ord DuckDBType
DuckDBType -> DuckDBType -> Bool
DuckDBType -> DuckDBType -> Ordering
DuckDBType -> DuckDBType -> DuckDBType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBType -> DuckDBType -> Ordering
compare :: DuckDBType -> DuckDBType -> Ordering
$c< :: DuckDBType -> DuckDBType -> Bool
< :: DuckDBType -> DuckDBType -> Bool
$c<= :: DuckDBType -> DuckDBType -> Bool
<= :: DuckDBType -> DuckDBType -> Bool
$c> :: DuckDBType -> DuckDBType -> Bool
> :: DuckDBType -> DuckDBType -> Bool
$c>= :: DuckDBType -> DuckDBType -> Bool
>= :: DuckDBType -> DuckDBType -> Bool
$cmax :: DuckDBType -> DuckDBType -> DuckDBType
max :: DuckDBType -> DuckDBType -> DuckDBType
$cmin :: DuckDBType -> DuckDBType -> DuckDBType
min :: DuckDBType -> DuckDBType -> DuckDBType
Ord, Int -> DuckDBType -> ShowS
[DuckDBType] -> ShowS
DuckDBType -> String
(Int -> DuckDBType -> ShowS)
-> (DuckDBType -> String)
-> ([DuckDBType] -> ShowS)
-> Show DuckDBType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBType -> ShowS
showsPrec :: Int -> DuckDBType -> ShowS
$cshow :: DuckDBType -> String
show :: DuckDBType -> String
$cshowList :: [DuckDBType] -> ShowS
showList :: [DuckDBType] -> ShowS
Show, Ptr DuckDBType -> IO DuckDBType
Ptr DuckDBType -> Int -> IO DuckDBType
Ptr DuckDBType -> Int -> DuckDBType -> IO ()
Ptr DuckDBType -> DuckDBType -> IO ()
DuckDBType -> Int
(DuckDBType -> Int)
-> (DuckDBType -> Int)
-> (Ptr DuckDBType -> Int -> IO DuckDBType)
-> (Ptr DuckDBType -> Int -> DuckDBType -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBType)
-> (forall b. Ptr b -> Int -> DuckDBType -> IO ())
-> (Ptr DuckDBType -> IO DuckDBType)
-> (Ptr DuckDBType -> DuckDBType -> IO ())
-> Storable DuckDBType
forall b. Ptr b -> Int -> IO DuckDBType
forall b. Ptr b -> Int -> DuckDBType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBType -> Int
sizeOf :: DuckDBType -> Int
$calignment :: DuckDBType -> Int
alignment :: DuckDBType -> Int
$cpeekElemOff :: Ptr DuckDBType -> Int -> IO DuckDBType
peekElemOff :: Ptr DuckDBType -> Int -> IO DuckDBType
$cpokeElemOff :: Ptr DuckDBType -> Int -> DuckDBType -> IO ()
pokeElemOff :: Ptr DuckDBType -> Int -> DuckDBType -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBType
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBType
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBType -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBType -> IO ()
$cpeek :: Ptr DuckDBType -> IO DuckDBType
peek :: Ptr DuckDBType -> IO DuckDBType
$cpoke :: Ptr DuckDBType -> DuckDBType -> IO ()
poke :: Ptr DuckDBType -> DuckDBType -> IO ()
Storable)

-- | Pattern synonyms for DuckDB's physical value type tags.
pattern
    DuckDBTypeInvalid
    , DuckDBTypeBoolean
    , DuckDBTypeTinyInt
    , DuckDBTypeSmallInt
    , DuckDBTypeInteger
    , DuckDBTypeBigInt
    , DuckDBTypeUTinyInt
    , DuckDBTypeUSmallInt
    , DuckDBTypeUInteger
    , DuckDBTypeUBigInt
    , DuckDBTypeFloat
    , DuckDBTypeDouble
    , DuckDBTypeTimestamp
    , DuckDBTypeDate
    , DuckDBTypeTime
    , DuckDBTypeInterval
    , DuckDBTypeHugeInt
    , DuckDBTypeUHugeInt
    , DuckDBTypeVarchar
    , DuckDBTypeBlob
    , DuckDBTypeDecimal
    , DuckDBTypeTimestampS
    , DuckDBTypeTimestampMs
    , DuckDBTypeTimestampNs
    , DuckDBTypeEnum
    , DuckDBTypeList
    , DuckDBTypeStruct
    , DuckDBTypeMap
    , DuckDBTypeArray
    , DuckDBTypeUUID
    , DuckDBTypeUnion
    , DuckDBTypeBit
    , DuckDBTypeTimeTz
    , DuckDBTypeTimestampTz
    , DuckDBTypeAny
    , DuckDBTypeBigNum
    , DuckDBTypeSQLNull
    , DuckDBTypeStringLiteral
    , DuckDBTypeIntegerLiteral
    , DuckDBTypeTimeNs ::
        DuckDBType
pattern $mDuckDBTypeInvalid :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeInvalid :: DuckDBType
DuckDBTypeInvalid = DuckDBType 0
pattern $mDuckDBTypeBoolean :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeBoolean :: DuckDBType
DuckDBTypeBoolean = DuckDBType 1
pattern $mDuckDBTypeTinyInt :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTinyInt :: DuckDBType
DuckDBTypeTinyInt = DuckDBType 2
pattern $mDuckDBTypeSmallInt :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeSmallInt :: DuckDBType
DuckDBTypeSmallInt = DuckDBType 3
pattern $mDuckDBTypeInteger :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeInteger :: DuckDBType
DuckDBTypeInteger = DuckDBType 4
pattern $mDuckDBTypeBigInt :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeBigInt :: DuckDBType
DuckDBTypeBigInt = DuckDBType 5
pattern $mDuckDBTypeUTinyInt :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeUTinyInt :: DuckDBType
DuckDBTypeUTinyInt = DuckDBType 6
pattern $mDuckDBTypeUSmallInt :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeUSmallInt :: DuckDBType
DuckDBTypeUSmallInt = DuckDBType 7
pattern $mDuckDBTypeUInteger :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeUInteger :: DuckDBType
DuckDBTypeUInteger = DuckDBType 8
pattern $mDuckDBTypeUBigInt :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeUBigInt :: DuckDBType
DuckDBTypeUBigInt = DuckDBType 9
pattern $mDuckDBTypeFloat :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeFloat :: DuckDBType
DuckDBTypeFloat = DuckDBType 10
pattern $mDuckDBTypeDouble :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeDouble :: DuckDBType
DuckDBTypeDouble = DuckDBType 11
pattern $mDuckDBTypeTimestamp :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTimestamp :: DuckDBType
DuckDBTypeTimestamp = DuckDBType 12
pattern $mDuckDBTypeDate :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeDate :: DuckDBType
DuckDBTypeDate = DuckDBType 13
pattern $mDuckDBTypeTime :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTime :: DuckDBType
DuckDBTypeTime = DuckDBType 14
pattern $mDuckDBTypeInterval :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeInterval :: DuckDBType
DuckDBTypeInterval = DuckDBType 15
pattern $mDuckDBTypeHugeInt :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeHugeInt :: DuckDBType
DuckDBTypeHugeInt = DuckDBType 16
pattern $mDuckDBTypeUHugeInt :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeUHugeInt :: DuckDBType
DuckDBTypeUHugeInt = DuckDBType 32
pattern $mDuckDBTypeVarchar :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeVarchar :: DuckDBType
DuckDBTypeVarchar = DuckDBType 17
pattern $mDuckDBTypeBlob :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeBlob :: DuckDBType
DuckDBTypeBlob = DuckDBType 18
pattern $mDuckDBTypeDecimal :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeDecimal :: DuckDBType
DuckDBTypeDecimal = DuckDBType 19
pattern $mDuckDBTypeTimestampS :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTimestampS :: DuckDBType
DuckDBTypeTimestampS = DuckDBType 20
pattern $mDuckDBTypeTimestampMs :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTimestampMs :: DuckDBType
DuckDBTypeTimestampMs = DuckDBType 21
pattern $mDuckDBTypeTimestampNs :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTimestampNs :: DuckDBType
DuckDBTypeTimestampNs = DuckDBType 22
pattern $mDuckDBTypeEnum :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeEnum :: DuckDBType
DuckDBTypeEnum = DuckDBType 23
pattern $mDuckDBTypeList :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeList :: DuckDBType
DuckDBTypeList = DuckDBType 24
pattern $mDuckDBTypeStruct :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeStruct :: DuckDBType
DuckDBTypeStruct = DuckDBType 25
pattern $mDuckDBTypeMap :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeMap :: DuckDBType
DuckDBTypeMap = DuckDBType 26
pattern $mDuckDBTypeArray :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeArray :: DuckDBType
DuckDBTypeArray = DuckDBType 33
pattern $mDuckDBTypeUUID :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeUUID :: DuckDBType
DuckDBTypeUUID = DuckDBType 27
pattern $mDuckDBTypeUnion :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeUnion :: DuckDBType
DuckDBTypeUnion = DuckDBType 28
pattern $mDuckDBTypeBit :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeBit :: DuckDBType
DuckDBTypeBit = DuckDBType 29
pattern $mDuckDBTypeTimeTz :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTimeTz :: DuckDBType
DuckDBTypeTimeTz = DuckDBType 30
pattern $mDuckDBTypeTimestampTz :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTimestampTz :: DuckDBType
DuckDBTypeTimestampTz = DuckDBType 31
pattern $mDuckDBTypeAny :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeAny :: DuckDBType
DuckDBTypeAny = DuckDBType 34
pattern $mDuckDBTypeBigNum :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeBigNum :: DuckDBType
DuckDBTypeBigNum = DuckDBType 35
pattern $mDuckDBTypeSQLNull :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeSQLNull :: DuckDBType
DuckDBTypeSQLNull = DuckDBType 36
pattern $mDuckDBTypeStringLiteral :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeStringLiteral :: DuckDBType
DuckDBTypeStringLiteral = DuckDBType 37
pattern $mDuckDBTypeIntegerLiteral :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeIntegerLiteral :: DuckDBType
DuckDBTypeIntegerLiteral = DuckDBType 38
pattern $mDuckDBTypeTimeNs :: forall {r}. DuckDBType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBTypeTimeNs :: DuckDBType
DuckDBTypeTimeNs = DuckDBType 39

-- | Pending result state returned from @duckdb_pending_*@ APIs.
newtype DuckDBPendingState = DuckDBPendingState {DuckDBPendingState -> CInt
unDuckDBPendingState :: CInt}
    deriving (DuckDBPendingState -> DuckDBPendingState -> Bool
(DuckDBPendingState -> DuckDBPendingState -> Bool)
-> (DuckDBPendingState -> DuckDBPendingState -> Bool)
-> Eq DuckDBPendingState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBPendingState -> DuckDBPendingState -> Bool
== :: DuckDBPendingState -> DuckDBPendingState -> Bool
$c/= :: DuckDBPendingState -> DuckDBPendingState -> Bool
/= :: DuckDBPendingState -> DuckDBPendingState -> Bool
Eq, Eq DuckDBPendingState
Eq DuckDBPendingState =>
(DuckDBPendingState -> DuckDBPendingState -> Ordering)
-> (DuckDBPendingState -> DuckDBPendingState -> Bool)
-> (DuckDBPendingState -> DuckDBPendingState -> Bool)
-> (DuckDBPendingState -> DuckDBPendingState -> Bool)
-> (DuckDBPendingState -> DuckDBPendingState -> Bool)
-> (DuckDBPendingState -> DuckDBPendingState -> DuckDBPendingState)
-> (DuckDBPendingState -> DuckDBPendingState -> DuckDBPendingState)
-> Ord DuckDBPendingState
DuckDBPendingState -> DuckDBPendingState -> Bool
DuckDBPendingState -> DuckDBPendingState -> Ordering
DuckDBPendingState -> DuckDBPendingState -> DuckDBPendingState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBPendingState -> DuckDBPendingState -> Ordering
compare :: DuckDBPendingState -> DuckDBPendingState -> Ordering
$c< :: DuckDBPendingState -> DuckDBPendingState -> Bool
< :: DuckDBPendingState -> DuckDBPendingState -> Bool
$c<= :: DuckDBPendingState -> DuckDBPendingState -> Bool
<= :: DuckDBPendingState -> DuckDBPendingState -> Bool
$c> :: DuckDBPendingState -> DuckDBPendingState -> Bool
> :: DuckDBPendingState -> DuckDBPendingState -> Bool
$c>= :: DuckDBPendingState -> DuckDBPendingState -> Bool
>= :: DuckDBPendingState -> DuckDBPendingState -> Bool
$cmax :: DuckDBPendingState -> DuckDBPendingState -> DuckDBPendingState
max :: DuckDBPendingState -> DuckDBPendingState -> DuckDBPendingState
$cmin :: DuckDBPendingState -> DuckDBPendingState -> DuckDBPendingState
min :: DuckDBPendingState -> DuckDBPendingState -> DuckDBPendingState
Ord, Int -> DuckDBPendingState -> ShowS
[DuckDBPendingState] -> ShowS
DuckDBPendingState -> String
(Int -> DuckDBPendingState -> ShowS)
-> (DuckDBPendingState -> String)
-> ([DuckDBPendingState] -> ShowS)
-> Show DuckDBPendingState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBPendingState -> ShowS
showsPrec :: Int -> DuckDBPendingState -> ShowS
$cshow :: DuckDBPendingState -> String
show :: DuckDBPendingState -> String
$cshowList :: [DuckDBPendingState] -> ShowS
showList :: [DuckDBPendingState] -> ShowS
Show, Ptr DuckDBPendingState -> IO DuckDBPendingState
Ptr DuckDBPendingState -> Int -> IO DuckDBPendingState
Ptr DuckDBPendingState -> Int -> DuckDBPendingState -> IO ()
Ptr DuckDBPendingState -> DuckDBPendingState -> IO ()
DuckDBPendingState -> Int
(DuckDBPendingState -> Int)
-> (DuckDBPendingState -> Int)
-> (Ptr DuckDBPendingState -> Int -> IO DuckDBPendingState)
-> (Ptr DuckDBPendingState -> Int -> DuckDBPendingState -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBPendingState)
-> (forall b. Ptr b -> Int -> DuckDBPendingState -> IO ())
-> (Ptr DuckDBPendingState -> IO DuckDBPendingState)
-> (Ptr DuckDBPendingState -> DuckDBPendingState -> IO ())
-> Storable DuckDBPendingState
forall b. Ptr b -> Int -> IO DuckDBPendingState
forall b. Ptr b -> Int -> DuckDBPendingState -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBPendingState -> Int
sizeOf :: DuckDBPendingState -> Int
$calignment :: DuckDBPendingState -> Int
alignment :: DuckDBPendingState -> Int
$cpeekElemOff :: Ptr DuckDBPendingState -> Int -> IO DuckDBPendingState
peekElemOff :: Ptr DuckDBPendingState -> Int -> IO DuckDBPendingState
$cpokeElemOff :: Ptr DuckDBPendingState -> Int -> DuckDBPendingState -> IO ()
pokeElemOff :: Ptr DuckDBPendingState -> Int -> DuckDBPendingState -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBPendingState
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBPendingState
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBPendingState -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBPendingState -> IO ()
$cpeek :: Ptr DuckDBPendingState -> IO DuckDBPendingState
peek :: Ptr DuckDBPendingState -> IO DuckDBPendingState
$cpoke :: Ptr DuckDBPendingState -> DuckDBPendingState -> IO ()
poke :: Ptr DuckDBPendingState -> DuckDBPendingState -> IO ()
Storable)

-- | Pattern synonyms for @duckdb_pending_state@ constants.
pattern
    DuckDBPendingResultReady
    , DuckDBPendingResultNotReady
    , DuckDBPendingError
    , DuckDBPendingNoTasksAvailable ::
        DuckDBPendingState
pattern $mDuckDBPendingResultReady :: forall {r}. DuckDBPendingState -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBPendingResultReady :: DuckDBPendingState
DuckDBPendingResultReady = DuckDBPendingState 0
pattern $mDuckDBPendingResultNotReady :: forall {r}. DuckDBPendingState -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBPendingResultNotReady :: DuckDBPendingState
DuckDBPendingResultNotReady = DuckDBPendingState 1
pattern $mDuckDBPendingError :: forall {r}. DuckDBPendingState -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBPendingError :: DuckDBPendingState
DuckDBPendingError = DuckDBPendingState 2
pattern $mDuckDBPendingNoTasksAvailable :: forall {r}. DuckDBPendingState -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBPendingNoTasksAvailable :: DuckDBPendingState
DuckDBPendingNoTasksAvailable = DuckDBPendingState 3

{-# COMPLETE
    DuckDBPendingResultReady
    , DuckDBPendingResultNotReady
    , DuckDBPendingError
    , DuckDBPendingNoTasksAvailable
    #-}

-- | Result payload type returned by DuckDB queries (@duckdb_result_type@).
newtype DuckDBResultType = DuckDBResultType {DuckDBResultType -> CInt
unDuckDBResultType :: CInt}
    deriving (DuckDBResultType -> DuckDBResultType -> Bool
(DuckDBResultType -> DuckDBResultType -> Bool)
-> (DuckDBResultType -> DuckDBResultType -> Bool)
-> Eq DuckDBResultType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBResultType -> DuckDBResultType -> Bool
== :: DuckDBResultType -> DuckDBResultType -> Bool
$c/= :: DuckDBResultType -> DuckDBResultType -> Bool
/= :: DuckDBResultType -> DuckDBResultType -> Bool
Eq, Eq DuckDBResultType
Eq DuckDBResultType =>
(DuckDBResultType -> DuckDBResultType -> Ordering)
-> (DuckDBResultType -> DuckDBResultType -> Bool)
-> (DuckDBResultType -> DuckDBResultType -> Bool)
-> (DuckDBResultType -> DuckDBResultType -> Bool)
-> (DuckDBResultType -> DuckDBResultType -> Bool)
-> (DuckDBResultType -> DuckDBResultType -> DuckDBResultType)
-> (DuckDBResultType -> DuckDBResultType -> DuckDBResultType)
-> Ord DuckDBResultType
DuckDBResultType -> DuckDBResultType -> Bool
DuckDBResultType -> DuckDBResultType -> Ordering
DuckDBResultType -> DuckDBResultType -> DuckDBResultType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBResultType -> DuckDBResultType -> Ordering
compare :: DuckDBResultType -> DuckDBResultType -> Ordering
$c< :: DuckDBResultType -> DuckDBResultType -> Bool
< :: DuckDBResultType -> DuckDBResultType -> Bool
$c<= :: DuckDBResultType -> DuckDBResultType -> Bool
<= :: DuckDBResultType -> DuckDBResultType -> Bool
$c> :: DuckDBResultType -> DuckDBResultType -> Bool
> :: DuckDBResultType -> DuckDBResultType -> Bool
$c>= :: DuckDBResultType -> DuckDBResultType -> Bool
>= :: DuckDBResultType -> DuckDBResultType -> Bool
$cmax :: DuckDBResultType -> DuckDBResultType -> DuckDBResultType
max :: DuckDBResultType -> DuckDBResultType -> DuckDBResultType
$cmin :: DuckDBResultType -> DuckDBResultType -> DuckDBResultType
min :: DuckDBResultType -> DuckDBResultType -> DuckDBResultType
Ord, Int -> DuckDBResultType -> ShowS
[DuckDBResultType] -> ShowS
DuckDBResultType -> String
(Int -> DuckDBResultType -> ShowS)
-> (DuckDBResultType -> String)
-> ([DuckDBResultType] -> ShowS)
-> Show DuckDBResultType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBResultType -> ShowS
showsPrec :: Int -> DuckDBResultType -> ShowS
$cshow :: DuckDBResultType -> String
show :: DuckDBResultType -> String
$cshowList :: [DuckDBResultType] -> ShowS
showList :: [DuckDBResultType] -> ShowS
Show, Ptr DuckDBResultType -> IO DuckDBResultType
Ptr DuckDBResultType -> Int -> IO DuckDBResultType
Ptr DuckDBResultType -> Int -> DuckDBResultType -> IO ()
Ptr DuckDBResultType -> DuckDBResultType -> IO ()
DuckDBResultType -> Int
(DuckDBResultType -> Int)
-> (DuckDBResultType -> Int)
-> (Ptr DuckDBResultType -> Int -> IO DuckDBResultType)
-> (Ptr DuckDBResultType -> Int -> DuckDBResultType -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBResultType)
-> (forall b. Ptr b -> Int -> DuckDBResultType -> IO ())
-> (Ptr DuckDBResultType -> IO DuckDBResultType)
-> (Ptr DuckDBResultType -> DuckDBResultType -> IO ())
-> Storable DuckDBResultType
forall b. Ptr b -> Int -> IO DuckDBResultType
forall b. Ptr b -> Int -> DuckDBResultType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBResultType -> Int
sizeOf :: DuckDBResultType -> Int
$calignment :: DuckDBResultType -> Int
alignment :: DuckDBResultType -> Int
$cpeekElemOff :: Ptr DuckDBResultType -> Int -> IO DuckDBResultType
peekElemOff :: Ptr DuckDBResultType -> Int -> IO DuckDBResultType
$cpokeElemOff :: Ptr DuckDBResultType -> Int -> DuckDBResultType -> IO ()
pokeElemOff :: Ptr DuckDBResultType -> Int -> DuckDBResultType -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBResultType
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBResultType
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBResultType -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBResultType -> IO ()
$cpeek :: Ptr DuckDBResultType -> IO DuckDBResultType
peek :: Ptr DuckDBResultType -> IO DuckDBResultType
$cpoke :: Ptr DuckDBResultType -> DuckDBResultType -> IO ()
poke :: Ptr DuckDBResultType -> DuckDBResultType -> IO ()
Storable)

-- | Pattern synonyms for @duckdb_result_type@ constants.
pattern
    DuckDBResultTypeInvalid
    , DuckDBResultTypeChangedRows
    , DuckDBResultTypeNothing
    , DuckDBResultTypeQueryResult ::
        DuckDBResultType
pattern $mDuckDBResultTypeInvalid :: forall {r}. DuckDBResultType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBResultTypeInvalid :: DuckDBResultType
DuckDBResultTypeInvalid = DuckDBResultType 0
pattern $mDuckDBResultTypeChangedRows :: forall {r}. DuckDBResultType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBResultTypeChangedRows :: DuckDBResultType
DuckDBResultTypeChangedRows = DuckDBResultType 1
pattern $mDuckDBResultTypeNothing :: forall {r}. DuckDBResultType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBResultTypeNothing :: DuckDBResultType
DuckDBResultTypeNothing = DuckDBResultType 2
pattern $mDuckDBResultTypeQueryResult :: forall {r}. DuckDBResultType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBResultTypeQueryResult :: DuckDBResultType
DuckDBResultTypeQueryResult = DuckDBResultType 3

{-# COMPLETE
    DuckDBResultTypeInvalid
    , DuckDBResultTypeChangedRows
    , DuckDBResultTypeNothing
    , DuckDBResultTypeQueryResult
    #-}

-- | Classifies the SQL statement executed (@duckdb_statement_type@).
newtype DuckDBStatementType = DuckDBStatementType {DuckDBStatementType -> CInt
unDuckDBStatementType :: CInt}
    deriving (DuckDBStatementType -> DuckDBStatementType -> Bool
(DuckDBStatementType -> DuckDBStatementType -> Bool)
-> (DuckDBStatementType -> DuckDBStatementType -> Bool)
-> Eq DuckDBStatementType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBStatementType -> DuckDBStatementType -> Bool
== :: DuckDBStatementType -> DuckDBStatementType -> Bool
$c/= :: DuckDBStatementType -> DuckDBStatementType -> Bool
/= :: DuckDBStatementType -> DuckDBStatementType -> Bool
Eq, Eq DuckDBStatementType
Eq DuckDBStatementType =>
(DuckDBStatementType -> DuckDBStatementType -> Ordering)
-> (DuckDBStatementType -> DuckDBStatementType -> Bool)
-> (DuckDBStatementType -> DuckDBStatementType -> Bool)
-> (DuckDBStatementType -> DuckDBStatementType -> Bool)
-> (DuckDBStatementType -> DuckDBStatementType -> Bool)
-> (DuckDBStatementType
    -> DuckDBStatementType -> DuckDBStatementType)
-> (DuckDBStatementType
    -> DuckDBStatementType -> DuckDBStatementType)
-> Ord DuckDBStatementType
DuckDBStatementType -> DuckDBStatementType -> Bool
DuckDBStatementType -> DuckDBStatementType -> Ordering
DuckDBStatementType -> DuckDBStatementType -> DuckDBStatementType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBStatementType -> DuckDBStatementType -> Ordering
compare :: DuckDBStatementType -> DuckDBStatementType -> Ordering
$c< :: DuckDBStatementType -> DuckDBStatementType -> Bool
< :: DuckDBStatementType -> DuckDBStatementType -> Bool
$c<= :: DuckDBStatementType -> DuckDBStatementType -> Bool
<= :: DuckDBStatementType -> DuckDBStatementType -> Bool
$c> :: DuckDBStatementType -> DuckDBStatementType -> Bool
> :: DuckDBStatementType -> DuckDBStatementType -> Bool
$c>= :: DuckDBStatementType -> DuckDBStatementType -> Bool
>= :: DuckDBStatementType -> DuckDBStatementType -> Bool
$cmax :: DuckDBStatementType -> DuckDBStatementType -> DuckDBStatementType
max :: DuckDBStatementType -> DuckDBStatementType -> DuckDBStatementType
$cmin :: DuckDBStatementType -> DuckDBStatementType -> DuckDBStatementType
min :: DuckDBStatementType -> DuckDBStatementType -> DuckDBStatementType
Ord, Int -> DuckDBStatementType -> ShowS
[DuckDBStatementType] -> ShowS
DuckDBStatementType -> String
(Int -> DuckDBStatementType -> ShowS)
-> (DuckDBStatementType -> String)
-> ([DuckDBStatementType] -> ShowS)
-> Show DuckDBStatementType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBStatementType -> ShowS
showsPrec :: Int -> DuckDBStatementType -> ShowS
$cshow :: DuckDBStatementType -> String
show :: DuckDBStatementType -> String
$cshowList :: [DuckDBStatementType] -> ShowS
showList :: [DuckDBStatementType] -> ShowS
Show, Ptr DuckDBStatementType -> IO DuckDBStatementType
Ptr DuckDBStatementType -> Int -> IO DuckDBStatementType
Ptr DuckDBStatementType -> Int -> DuckDBStatementType -> IO ()
Ptr DuckDBStatementType -> DuckDBStatementType -> IO ()
DuckDBStatementType -> Int
(DuckDBStatementType -> Int)
-> (DuckDBStatementType -> Int)
-> (Ptr DuckDBStatementType -> Int -> IO DuckDBStatementType)
-> (Ptr DuckDBStatementType -> Int -> DuckDBStatementType -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBStatementType)
-> (forall b. Ptr b -> Int -> DuckDBStatementType -> IO ())
-> (Ptr DuckDBStatementType -> IO DuckDBStatementType)
-> (Ptr DuckDBStatementType -> DuckDBStatementType -> IO ())
-> Storable DuckDBStatementType
forall b. Ptr b -> Int -> IO DuckDBStatementType
forall b. Ptr b -> Int -> DuckDBStatementType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBStatementType -> Int
sizeOf :: DuckDBStatementType -> Int
$calignment :: DuckDBStatementType -> Int
alignment :: DuckDBStatementType -> Int
$cpeekElemOff :: Ptr DuckDBStatementType -> Int -> IO DuckDBStatementType
peekElemOff :: Ptr DuckDBStatementType -> Int -> IO DuckDBStatementType
$cpokeElemOff :: Ptr DuckDBStatementType -> Int -> DuckDBStatementType -> IO ()
pokeElemOff :: Ptr DuckDBStatementType -> Int -> DuckDBStatementType -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBStatementType
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBStatementType
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBStatementType -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBStatementType -> IO ()
$cpeek :: Ptr DuckDBStatementType -> IO DuckDBStatementType
peek :: Ptr DuckDBStatementType -> IO DuckDBStatementType
$cpoke :: Ptr DuckDBStatementType -> DuckDBStatementType -> IO ()
poke :: Ptr DuckDBStatementType -> DuckDBStatementType -> IO ()
Storable)

-- | Pattern synonyms for @duckdb_statement_type@ constants.
pattern
    DuckDBStatementTypeInvalid
    , DuckDBStatementTypeSelect
    , DuckDBStatementTypeInsert
    , DuckDBStatementTypeUpdate
    , DuckDBStatementTypeExplain
    , DuckDBStatementTypeDelete
    , DuckDBStatementTypePrepare
    , DuckDBStatementTypeCreate
    , DuckDBStatementTypeExecute
    , DuckDBStatementTypeAlter
    , DuckDBStatementTypeTransaction
    , DuckDBStatementTypeCopy
    , DuckDBStatementTypeAnalyze
    , DuckDBStatementTypeVariableSet
    , DuckDBStatementTypeCreateFunc
    , DuckDBStatementTypeDrop
    , DuckDBStatementTypeExport
    , DuckDBStatementTypePragma
    , DuckDBStatementTypeVacuum
    , DuckDBStatementTypeCall
    , DuckDBStatementTypeSet
    , DuckDBStatementTypeLoad
    , DuckDBStatementTypeRelation
    , DuckDBStatementTypeExtension
    , DuckDBStatementTypeLogicalPlan
    , DuckDBStatementTypeAttach
    , DuckDBStatementTypeDetach
    , DuckDBStatementTypeMulti ::
        DuckDBStatementType
pattern $mDuckDBStatementTypeInvalid :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeInvalid :: DuckDBStatementType
DuckDBStatementTypeInvalid = DuckDBStatementType 0
pattern $mDuckDBStatementTypeSelect :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeSelect :: DuckDBStatementType
DuckDBStatementTypeSelect = DuckDBStatementType 1
pattern $mDuckDBStatementTypeInsert :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeInsert :: DuckDBStatementType
DuckDBStatementTypeInsert = DuckDBStatementType 2
pattern $mDuckDBStatementTypeUpdate :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeUpdate :: DuckDBStatementType
DuckDBStatementTypeUpdate = DuckDBStatementType 3
pattern $mDuckDBStatementTypeExplain :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeExplain :: DuckDBStatementType
DuckDBStatementTypeExplain = DuckDBStatementType 4
pattern $mDuckDBStatementTypeDelete :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeDelete :: DuckDBStatementType
DuckDBStatementTypeDelete = DuckDBStatementType 5
pattern $mDuckDBStatementTypePrepare :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypePrepare :: DuckDBStatementType
DuckDBStatementTypePrepare = DuckDBStatementType 6
pattern $mDuckDBStatementTypeCreate :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeCreate :: DuckDBStatementType
DuckDBStatementTypeCreate = DuckDBStatementType 7
pattern $mDuckDBStatementTypeExecute :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeExecute :: DuckDBStatementType
DuckDBStatementTypeExecute = DuckDBStatementType 8
pattern $mDuckDBStatementTypeAlter :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeAlter :: DuckDBStatementType
DuckDBStatementTypeAlter = DuckDBStatementType 9
pattern $mDuckDBStatementTypeTransaction :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeTransaction :: DuckDBStatementType
DuckDBStatementTypeTransaction = DuckDBStatementType 10
pattern $mDuckDBStatementTypeCopy :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeCopy :: DuckDBStatementType
DuckDBStatementTypeCopy = DuckDBStatementType 11
pattern $mDuckDBStatementTypeAnalyze :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeAnalyze :: DuckDBStatementType
DuckDBStatementTypeAnalyze = DuckDBStatementType 12
pattern $mDuckDBStatementTypeVariableSet :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeVariableSet :: DuckDBStatementType
DuckDBStatementTypeVariableSet = DuckDBStatementType 13
pattern $mDuckDBStatementTypeCreateFunc :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeCreateFunc :: DuckDBStatementType
DuckDBStatementTypeCreateFunc = DuckDBStatementType 14
pattern $mDuckDBStatementTypeDrop :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeDrop :: DuckDBStatementType
DuckDBStatementTypeDrop = DuckDBStatementType 15
pattern $mDuckDBStatementTypeExport :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeExport :: DuckDBStatementType
DuckDBStatementTypeExport = DuckDBStatementType 16
pattern $mDuckDBStatementTypePragma :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypePragma :: DuckDBStatementType
DuckDBStatementTypePragma = DuckDBStatementType 17
pattern $mDuckDBStatementTypeVacuum :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeVacuum :: DuckDBStatementType
DuckDBStatementTypeVacuum = DuckDBStatementType 18
pattern $mDuckDBStatementTypeCall :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeCall :: DuckDBStatementType
DuckDBStatementTypeCall = DuckDBStatementType 19
pattern $mDuckDBStatementTypeSet :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeSet :: DuckDBStatementType
DuckDBStatementTypeSet = DuckDBStatementType 20
pattern $mDuckDBStatementTypeLoad :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeLoad :: DuckDBStatementType
DuckDBStatementTypeLoad = DuckDBStatementType 21
pattern $mDuckDBStatementTypeRelation :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeRelation :: DuckDBStatementType
DuckDBStatementTypeRelation = DuckDBStatementType 22
pattern $mDuckDBStatementTypeExtension :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeExtension :: DuckDBStatementType
DuckDBStatementTypeExtension = DuckDBStatementType 23
pattern $mDuckDBStatementTypeLogicalPlan :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeLogicalPlan :: DuckDBStatementType
DuckDBStatementTypeLogicalPlan = DuckDBStatementType 24
pattern $mDuckDBStatementTypeAttach :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeAttach :: DuckDBStatementType
DuckDBStatementTypeAttach = DuckDBStatementType 25
pattern $mDuckDBStatementTypeDetach :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeDetach :: DuckDBStatementType
DuckDBStatementTypeDetach = DuckDBStatementType 26
pattern $mDuckDBStatementTypeMulti :: forall {r}.
DuckDBStatementType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBStatementTypeMulti :: DuckDBStatementType
DuckDBStatementTypeMulti = DuckDBStatementType 27

{-# COMPLETE
    DuckDBStatementTypeInvalid
    , DuckDBStatementTypeSelect
    , DuckDBStatementTypeInsert
    , DuckDBStatementTypeUpdate
    , DuckDBStatementTypeExplain
    , DuckDBStatementTypeDelete
    , DuckDBStatementTypePrepare
    , DuckDBStatementTypeCreate
    , DuckDBStatementTypeExecute
    , DuckDBStatementTypeAlter
    , DuckDBStatementTypeTransaction
    , DuckDBStatementTypeCopy
    , DuckDBStatementTypeAnalyze
    , DuckDBStatementTypeVariableSet
    , DuckDBStatementTypeCreateFunc
    , DuckDBStatementTypeDrop
    , DuckDBStatementTypeExport
    , DuckDBStatementTypePragma
    , DuckDBStatementTypeVacuum
    , DuckDBStatementTypeCall
    , DuckDBStatementTypeSet
    , DuckDBStatementTypeLoad
    , DuckDBStatementTypeRelation
    , DuckDBStatementTypeExtension
    , DuckDBStatementTypeLogicalPlan
    , DuckDBStatementTypeAttach
    , DuckDBStatementTypeDetach
    , DuckDBStatementTypeMulti
    #-}

-- | DuckDB error classification codes.
newtype DuckDBErrorType = DuckDBErrorType {DuckDBErrorType -> CInt
unDuckDBErrorType :: CInt}
    deriving (DuckDBErrorType -> DuckDBErrorType -> Bool
(DuckDBErrorType -> DuckDBErrorType -> Bool)
-> (DuckDBErrorType -> DuckDBErrorType -> Bool)
-> Eq DuckDBErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBErrorType -> DuckDBErrorType -> Bool
== :: DuckDBErrorType -> DuckDBErrorType -> Bool
$c/= :: DuckDBErrorType -> DuckDBErrorType -> Bool
/= :: DuckDBErrorType -> DuckDBErrorType -> Bool
Eq, Eq DuckDBErrorType
Eq DuckDBErrorType =>
(DuckDBErrorType -> DuckDBErrorType -> Ordering)
-> (DuckDBErrorType -> DuckDBErrorType -> Bool)
-> (DuckDBErrorType -> DuckDBErrorType -> Bool)
-> (DuckDBErrorType -> DuckDBErrorType -> Bool)
-> (DuckDBErrorType -> DuckDBErrorType -> Bool)
-> (DuckDBErrorType -> DuckDBErrorType -> DuckDBErrorType)
-> (DuckDBErrorType -> DuckDBErrorType -> DuckDBErrorType)
-> Ord DuckDBErrorType
DuckDBErrorType -> DuckDBErrorType -> Bool
DuckDBErrorType -> DuckDBErrorType -> Ordering
DuckDBErrorType -> DuckDBErrorType -> DuckDBErrorType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBErrorType -> DuckDBErrorType -> Ordering
compare :: DuckDBErrorType -> DuckDBErrorType -> Ordering
$c< :: DuckDBErrorType -> DuckDBErrorType -> Bool
< :: DuckDBErrorType -> DuckDBErrorType -> Bool
$c<= :: DuckDBErrorType -> DuckDBErrorType -> Bool
<= :: DuckDBErrorType -> DuckDBErrorType -> Bool
$c> :: DuckDBErrorType -> DuckDBErrorType -> Bool
> :: DuckDBErrorType -> DuckDBErrorType -> Bool
$c>= :: DuckDBErrorType -> DuckDBErrorType -> Bool
>= :: DuckDBErrorType -> DuckDBErrorType -> Bool
$cmax :: DuckDBErrorType -> DuckDBErrorType -> DuckDBErrorType
max :: DuckDBErrorType -> DuckDBErrorType -> DuckDBErrorType
$cmin :: DuckDBErrorType -> DuckDBErrorType -> DuckDBErrorType
min :: DuckDBErrorType -> DuckDBErrorType -> DuckDBErrorType
Ord, Int -> DuckDBErrorType -> ShowS
[DuckDBErrorType] -> ShowS
DuckDBErrorType -> String
(Int -> DuckDBErrorType -> ShowS)
-> (DuckDBErrorType -> String)
-> ([DuckDBErrorType] -> ShowS)
-> Show DuckDBErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBErrorType -> ShowS
showsPrec :: Int -> DuckDBErrorType -> ShowS
$cshow :: DuckDBErrorType -> String
show :: DuckDBErrorType -> String
$cshowList :: [DuckDBErrorType] -> ShowS
showList :: [DuckDBErrorType] -> ShowS
Show, Ptr DuckDBErrorType -> IO DuckDBErrorType
Ptr DuckDBErrorType -> Int -> IO DuckDBErrorType
Ptr DuckDBErrorType -> Int -> DuckDBErrorType -> IO ()
Ptr DuckDBErrorType -> DuckDBErrorType -> IO ()
DuckDBErrorType -> Int
(DuckDBErrorType -> Int)
-> (DuckDBErrorType -> Int)
-> (Ptr DuckDBErrorType -> Int -> IO DuckDBErrorType)
-> (Ptr DuckDBErrorType -> Int -> DuckDBErrorType -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBErrorType)
-> (forall b. Ptr b -> Int -> DuckDBErrorType -> IO ())
-> (Ptr DuckDBErrorType -> IO DuckDBErrorType)
-> (Ptr DuckDBErrorType -> DuckDBErrorType -> IO ())
-> Storable DuckDBErrorType
forall b. Ptr b -> Int -> IO DuckDBErrorType
forall b. Ptr b -> Int -> DuckDBErrorType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBErrorType -> Int
sizeOf :: DuckDBErrorType -> Int
$calignment :: DuckDBErrorType -> Int
alignment :: DuckDBErrorType -> Int
$cpeekElemOff :: Ptr DuckDBErrorType -> Int -> IO DuckDBErrorType
peekElemOff :: Ptr DuckDBErrorType -> Int -> IO DuckDBErrorType
$cpokeElemOff :: Ptr DuckDBErrorType -> Int -> DuckDBErrorType -> IO ()
pokeElemOff :: Ptr DuckDBErrorType -> Int -> DuckDBErrorType -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBErrorType
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBErrorType
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBErrorType -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBErrorType -> IO ()
$cpeek :: Ptr DuckDBErrorType -> IO DuckDBErrorType
peek :: Ptr DuckDBErrorType -> IO DuckDBErrorType
$cpoke :: Ptr DuckDBErrorType -> DuckDBErrorType -> IO ()
poke :: Ptr DuckDBErrorType -> DuckDBErrorType -> IO ()
Storable)

-- | Pattern synonyms mirroring @duckdb_error_type@ values.
pattern
    DuckDBErrorInvalid
    , DuckDBErrorOutOfRange
    , DuckDBErrorConversion
    , DuckDBErrorUnknownType
    , DuckDBErrorDecimal
    , DuckDBErrorMismatchType
    , DuckDBErrorDivideByZero
    , DuckDBErrorObjectSize
    , DuckDBErrorInvalidType
    , DuckDBErrorSerialization
    , DuckDBErrorTransaction
    , DuckDBErrorNotImplemented
    , DuckDBErrorExpression
    , DuckDBErrorCatalog
    , DuckDBErrorParser
    , DuckDBErrorPlanner
    , DuckDBErrorScheduler
    , DuckDBErrorExecutor
    , DuckDBErrorConstraint
    , DuckDBErrorIndex
    , DuckDBErrorStat
    , DuckDBErrorConnection
    , DuckDBErrorSyntax
    , DuckDBErrorSettings
    , DuckDBErrorBinder
    , DuckDBErrorNetwork
    , DuckDBErrorOptimizer
    , DuckDBErrorNullPointer
    , DuckDBErrorIO
    , DuckDBErrorInterrupt
    , DuckDBErrorFatal
    , DuckDBErrorInternal
    , DuckDBErrorInvalidInput
    , DuckDBErrorOutOfMemory
    , DuckDBErrorPermission
    , DuckDBErrorParameterNotResolved
    , DuckDBErrorParameterNotAllowed
    , DuckDBErrorDependency
    , DuckDBErrorHTTP
    , DuckDBErrorMissingExtension
    , DuckDBErrorAutoload
    , DuckDBErrorSequence
    , DuckDBInvalidConfiguration ::
        DuckDBErrorType
pattern $mDuckDBErrorInvalid :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorInvalid :: DuckDBErrorType
DuckDBErrorInvalid = DuckDBErrorType 0
pattern $mDuckDBErrorOutOfRange :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorOutOfRange :: DuckDBErrorType
DuckDBErrorOutOfRange = DuckDBErrorType 1
pattern $mDuckDBErrorConversion :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorConversion :: DuckDBErrorType
DuckDBErrorConversion = DuckDBErrorType 2
pattern $mDuckDBErrorUnknownType :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorUnknownType :: DuckDBErrorType
DuckDBErrorUnknownType = DuckDBErrorType 3
pattern $mDuckDBErrorDecimal :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorDecimal :: DuckDBErrorType
DuckDBErrorDecimal = DuckDBErrorType 4
pattern $mDuckDBErrorMismatchType :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorMismatchType :: DuckDBErrorType
DuckDBErrorMismatchType = DuckDBErrorType 5
pattern $mDuckDBErrorDivideByZero :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorDivideByZero :: DuckDBErrorType
DuckDBErrorDivideByZero = DuckDBErrorType 6
pattern $mDuckDBErrorObjectSize :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorObjectSize :: DuckDBErrorType
DuckDBErrorObjectSize = DuckDBErrorType 7
pattern $mDuckDBErrorInvalidType :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorInvalidType :: DuckDBErrorType
DuckDBErrorInvalidType = DuckDBErrorType 8
pattern $mDuckDBErrorSerialization :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorSerialization :: DuckDBErrorType
DuckDBErrorSerialization = DuckDBErrorType 9
pattern $mDuckDBErrorTransaction :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorTransaction :: DuckDBErrorType
DuckDBErrorTransaction = DuckDBErrorType 10
pattern $mDuckDBErrorNotImplemented :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorNotImplemented :: DuckDBErrorType
DuckDBErrorNotImplemented = DuckDBErrorType 11
pattern $mDuckDBErrorExpression :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorExpression :: DuckDBErrorType
DuckDBErrorExpression = DuckDBErrorType 12
pattern $mDuckDBErrorCatalog :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorCatalog :: DuckDBErrorType
DuckDBErrorCatalog = DuckDBErrorType 13
pattern $mDuckDBErrorParser :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorParser :: DuckDBErrorType
DuckDBErrorParser = DuckDBErrorType 14
pattern $mDuckDBErrorPlanner :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorPlanner :: DuckDBErrorType
DuckDBErrorPlanner = DuckDBErrorType 15
pattern $mDuckDBErrorScheduler :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorScheduler :: DuckDBErrorType
DuckDBErrorScheduler = DuckDBErrorType 16
pattern $mDuckDBErrorExecutor :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorExecutor :: DuckDBErrorType
DuckDBErrorExecutor = DuckDBErrorType 17
pattern $mDuckDBErrorConstraint :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorConstraint :: DuckDBErrorType
DuckDBErrorConstraint = DuckDBErrorType 18
pattern $mDuckDBErrorIndex :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorIndex :: DuckDBErrorType
DuckDBErrorIndex = DuckDBErrorType 19
pattern $mDuckDBErrorStat :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorStat :: DuckDBErrorType
DuckDBErrorStat = DuckDBErrorType 20
pattern $mDuckDBErrorConnection :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorConnection :: DuckDBErrorType
DuckDBErrorConnection = DuckDBErrorType 21
pattern $mDuckDBErrorSyntax :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorSyntax :: DuckDBErrorType
DuckDBErrorSyntax = DuckDBErrorType 22
pattern $mDuckDBErrorSettings :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorSettings :: DuckDBErrorType
DuckDBErrorSettings = DuckDBErrorType 23
pattern $mDuckDBErrorBinder :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorBinder :: DuckDBErrorType
DuckDBErrorBinder = DuckDBErrorType 24
pattern $mDuckDBErrorNetwork :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorNetwork :: DuckDBErrorType
DuckDBErrorNetwork = DuckDBErrorType 25
pattern $mDuckDBErrorOptimizer :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorOptimizer :: DuckDBErrorType
DuckDBErrorOptimizer = DuckDBErrorType 26
pattern $mDuckDBErrorNullPointer :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorNullPointer :: DuckDBErrorType
DuckDBErrorNullPointer = DuckDBErrorType 27
pattern $mDuckDBErrorIO :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorIO :: DuckDBErrorType
DuckDBErrorIO = DuckDBErrorType 28
pattern $mDuckDBErrorInterrupt :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorInterrupt :: DuckDBErrorType
DuckDBErrorInterrupt = DuckDBErrorType 29
pattern $mDuckDBErrorFatal :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorFatal :: DuckDBErrorType
DuckDBErrorFatal = DuckDBErrorType 30
pattern $mDuckDBErrorInternal :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorInternal :: DuckDBErrorType
DuckDBErrorInternal = DuckDBErrorType 31
pattern $mDuckDBErrorInvalidInput :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorInvalidInput :: DuckDBErrorType
DuckDBErrorInvalidInput = DuckDBErrorType 32
pattern $mDuckDBErrorOutOfMemory :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorOutOfMemory :: DuckDBErrorType
DuckDBErrorOutOfMemory = DuckDBErrorType 33
pattern $mDuckDBErrorPermission :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorPermission :: DuckDBErrorType
DuckDBErrorPermission = DuckDBErrorType 34
pattern $mDuckDBErrorParameterNotResolved :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorParameterNotResolved :: DuckDBErrorType
DuckDBErrorParameterNotResolved = DuckDBErrorType 35
pattern $mDuckDBErrorParameterNotAllowed :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorParameterNotAllowed :: DuckDBErrorType
DuckDBErrorParameterNotAllowed = DuckDBErrorType 36
pattern $mDuckDBErrorDependency :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorDependency :: DuckDBErrorType
DuckDBErrorDependency = DuckDBErrorType 37
pattern $mDuckDBErrorHTTP :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorHTTP :: DuckDBErrorType
DuckDBErrorHTTP = DuckDBErrorType 38
pattern $mDuckDBErrorMissingExtension :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorMissingExtension :: DuckDBErrorType
DuckDBErrorMissingExtension = DuckDBErrorType 39
pattern $mDuckDBErrorAutoload :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorAutoload :: DuckDBErrorType
DuckDBErrorAutoload = DuckDBErrorType 40
pattern $mDuckDBErrorSequence :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorSequence :: DuckDBErrorType
DuckDBErrorSequence = DuckDBErrorType 41
pattern $mDuckDBInvalidConfiguration :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBInvalidConfiguration :: DuckDBErrorType
DuckDBInvalidConfiguration = DuckDBErrorType 42

-- | Backwards-compatible alias for 'DuckDBInvalidConfiguration'.
{-# DEPRECATED DuckDBErrorInvalidConfiguration "Use DuckDBInvalidConfiguration (matches upstream duckdb.h)" #-}
pattern DuckDBErrorInvalidConfiguration :: DuckDBErrorType
pattern $mDuckDBErrorInvalidConfiguration :: forall {r}. DuckDBErrorType -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBErrorInvalidConfiguration :: DuckDBErrorType
DuckDBErrorInvalidConfiguration = DuckDBInvalidConfiguration

{-# COMPLETE
    DuckDBErrorInvalid
    , DuckDBErrorOutOfRange
    , DuckDBErrorConversion
    , DuckDBErrorUnknownType
    , DuckDBErrorDecimal
    , DuckDBErrorMismatchType
    , DuckDBErrorDivideByZero
    , DuckDBErrorObjectSize
    , DuckDBErrorInvalidType
    , DuckDBErrorSerialization
    , DuckDBErrorTransaction
    , DuckDBErrorNotImplemented
    , DuckDBErrorExpression
    , DuckDBErrorCatalog
    , DuckDBErrorParser
    , DuckDBErrorPlanner
    , DuckDBErrorScheduler
    , DuckDBErrorExecutor
    , DuckDBErrorConstraint
    , DuckDBErrorIndex
    , DuckDBErrorStat
    , DuckDBErrorConnection
    , DuckDBErrorSyntax
    , DuckDBErrorSettings
    , DuckDBErrorBinder
    , DuckDBErrorNetwork
    , DuckDBErrorOptimizer
    , DuckDBErrorNullPointer
    , DuckDBErrorIO
    , DuckDBErrorInterrupt
    , DuckDBErrorFatal
    , DuckDBErrorInternal
    , DuckDBErrorInvalidInput
    , DuckDBErrorOutOfMemory
    , DuckDBErrorPermission
    , DuckDBErrorParameterNotResolved
    , DuckDBErrorParameterNotAllowed
    , DuckDBErrorDependency
    , DuckDBErrorHTTP
    , DuckDBErrorMissingExtension
    , DuckDBErrorAutoload
    , DuckDBErrorSequence
    , DuckDBInvalidConfiguration
    #-}

-- | Behaviour of DuckDB's casting functions (@duckdb_cast_mode@).
newtype DuckDBCastMode = DuckDBCastMode {DuckDBCastMode -> CInt
unDuckDBCastMode :: CInt}
    deriving (DuckDBCastMode -> DuckDBCastMode -> Bool
(DuckDBCastMode -> DuckDBCastMode -> Bool)
-> (DuckDBCastMode -> DuckDBCastMode -> Bool) -> Eq DuckDBCastMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBCastMode -> DuckDBCastMode -> Bool
== :: DuckDBCastMode -> DuckDBCastMode -> Bool
$c/= :: DuckDBCastMode -> DuckDBCastMode -> Bool
/= :: DuckDBCastMode -> DuckDBCastMode -> Bool
Eq, Eq DuckDBCastMode
Eq DuckDBCastMode =>
(DuckDBCastMode -> DuckDBCastMode -> Ordering)
-> (DuckDBCastMode -> DuckDBCastMode -> Bool)
-> (DuckDBCastMode -> DuckDBCastMode -> Bool)
-> (DuckDBCastMode -> DuckDBCastMode -> Bool)
-> (DuckDBCastMode -> DuckDBCastMode -> Bool)
-> (DuckDBCastMode -> DuckDBCastMode -> DuckDBCastMode)
-> (DuckDBCastMode -> DuckDBCastMode -> DuckDBCastMode)
-> Ord DuckDBCastMode
DuckDBCastMode -> DuckDBCastMode -> Bool
DuckDBCastMode -> DuckDBCastMode -> Ordering
DuckDBCastMode -> DuckDBCastMode -> DuckDBCastMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBCastMode -> DuckDBCastMode -> Ordering
compare :: DuckDBCastMode -> DuckDBCastMode -> Ordering
$c< :: DuckDBCastMode -> DuckDBCastMode -> Bool
< :: DuckDBCastMode -> DuckDBCastMode -> Bool
$c<= :: DuckDBCastMode -> DuckDBCastMode -> Bool
<= :: DuckDBCastMode -> DuckDBCastMode -> Bool
$c> :: DuckDBCastMode -> DuckDBCastMode -> Bool
> :: DuckDBCastMode -> DuckDBCastMode -> Bool
$c>= :: DuckDBCastMode -> DuckDBCastMode -> Bool
>= :: DuckDBCastMode -> DuckDBCastMode -> Bool
$cmax :: DuckDBCastMode -> DuckDBCastMode -> DuckDBCastMode
max :: DuckDBCastMode -> DuckDBCastMode -> DuckDBCastMode
$cmin :: DuckDBCastMode -> DuckDBCastMode -> DuckDBCastMode
min :: DuckDBCastMode -> DuckDBCastMode -> DuckDBCastMode
Ord, Int -> DuckDBCastMode -> ShowS
[DuckDBCastMode] -> ShowS
DuckDBCastMode -> String
(Int -> DuckDBCastMode -> ShowS)
-> (DuckDBCastMode -> String)
-> ([DuckDBCastMode] -> ShowS)
-> Show DuckDBCastMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBCastMode -> ShowS
showsPrec :: Int -> DuckDBCastMode -> ShowS
$cshow :: DuckDBCastMode -> String
show :: DuckDBCastMode -> String
$cshowList :: [DuckDBCastMode] -> ShowS
showList :: [DuckDBCastMode] -> ShowS
Show, Ptr DuckDBCastMode -> IO DuckDBCastMode
Ptr DuckDBCastMode -> Int -> IO DuckDBCastMode
Ptr DuckDBCastMode -> Int -> DuckDBCastMode -> IO ()
Ptr DuckDBCastMode -> DuckDBCastMode -> IO ()
DuckDBCastMode -> Int
(DuckDBCastMode -> Int)
-> (DuckDBCastMode -> Int)
-> (Ptr DuckDBCastMode -> Int -> IO DuckDBCastMode)
-> (Ptr DuckDBCastMode -> Int -> DuckDBCastMode -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBCastMode)
-> (forall b. Ptr b -> Int -> DuckDBCastMode -> IO ())
-> (Ptr DuckDBCastMode -> IO DuckDBCastMode)
-> (Ptr DuckDBCastMode -> DuckDBCastMode -> IO ())
-> Storable DuckDBCastMode
forall b. Ptr b -> Int -> IO DuckDBCastMode
forall b. Ptr b -> Int -> DuckDBCastMode -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBCastMode -> Int
sizeOf :: DuckDBCastMode -> Int
$calignment :: DuckDBCastMode -> Int
alignment :: DuckDBCastMode -> Int
$cpeekElemOff :: Ptr DuckDBCastMode -> Int -> IO DuckDBCastMode
peekElemOff :: Ptr DuckDBCastMode -> Int -> IO DuckDBCastMode
$cpokeElemOff :: Ptr DuckDBCastMode -> Int -> DuckDBCastMode -> IO ()
pokeElemOff :: Ptr DuckDBCastMode -> Int -> DuckDBCastMode -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBCastMode
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBCastMode
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBCastMode -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBCastMode -> IO ()
$cpeek :: Ptr DuckDBCastMode -> IO DuckDBCastMode
peek :: Ptr DuckDBCastMode -> IO DuckDBCastMode
$cpoke :: Ptr DuckDBCastMode -> DuckDBCastMode -> IO ()
poke :: Ptr DuckDBCastMode -> DuckDBCastMode -> IO ()
Storable)

-- | Pattern synonyms for @duckdb_cast_mode@ values.
pattern DuckDBCastNormal, DuckDBCastTry :: DuckDBCastMode
pattern $mDuckDBCastNormal :: forall {r}. DuckDBCastMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBCastNormal :: DuckDBCastMode
DuckDBCastNormal = DuckDBCastMode 0
pattern $mDuckDBCastTry :: forall {r}. DuckDBCastMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bDuckDBCastTry :: DuckDBCastMode
DuckDBCastTry = DuckDBCastMode 1

{-# COMPLETE DuckDBCastNormal, DuckDBCastTry #-}

-- | Represents DuckDB's @duckdb_date@.
newtype DuckDBDate = DuckDBDate {DuckDBDate -> Int32
unDuckDBDate :: Int32}
    deriving (DuckDBDate -> DuckDBDate -> Bool
(DuckDBDate -> DuckDBDate -> Bool)
-> (DuckDBDate -> DuckDBDate -> Bool) -> Eq DuckDBDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBDate -> DuckDBDate -> Bool
== :: DuckDBDate -> DuckDBDate -> Bool
$c/= :: DuckDBDate -> DuckDBDate -> Bool
/= :: DuckDBDate -> DuckDBDate -> Bool
Eq, Eq DuckDBDate
Eq DuckDBDate =>
(DuckDBDate -> DuckDBDate -> Ordering)
-> (DuckDBDate -> DuckDBDate -> Bool)
-> (DuckDBDate -> DuckDBDate -> Bool)
-> (DuckDBDate -> DuckDBDate -> Bool)
-> (DuckDBDate -> DuckDBDate -> Bool)
-> (DuckDBDate -> DuckDBDate -> DuckDBDate)
-> (DuckDBDate -> DuckDBDate -> DuckDBDate)
-> Ord DuckDBDate
DuckDBDate -> DuckDBDate -> Bool
DuckDBDate -> DuckDBDate -> Ordering
DuckDBDate -> DuckDBDate -> DuckDBDate
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBDate -> DuckDBDate -> Ordering
compare :: DuckDBDate -> DuckDBDate -> Ordering
$c< :: DuckDBDate -> DuckDBDate -> Bool
< :: DuckDBDate -> DuckDBDate -> Bool
$c<= :: DuckDBDate -> DuckDBDate -> Bool
<= :: DuckDBDate -> DuckDBDate -> Bool
$c> :: DuckDBDate -> DuckDBDate -> Bool
> :: DuckDBDate -> DuckDBDate -> Bool
$c>= :: DuckDBDate -> DuckDBDate -> Bool
>= :: DuckDBDate -> DuckDBDate -> Bool
$cmax :: DuckDBDate -> DuckDBDate -> DuckDBDate
max :: DuckDBDate -> DuckDBDate -> DuckDBDate
$cmin :: DuckDBDate -> DuckDBDate -> DuckDBDate
min :: DuckDBDate -> DuckDBDate -> DuckDBDate
Ord, Int -> DuckDBDate -> ShowS
[DuckDBDate] -> ShowS
DuckDBDate -> String
(Int -> DuckDBDate -> ShowS)
-> (DuckDBDate -> String)
-> ([DuckDBDate] -> ShowS)
-> Show DuckDBDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBDate -> ShowS
showsPrec :: Int -> DuckDBDate -> ShowS
$cshow :: DuckDBDate -> String
show :: DuckDBDate -> String
$cshowList :: [DuckDBDate] -> ShowS
showList :: [DuckDBDate] -> ShowS
Show, Ptr DuckDBDate -> IO DuckDBDate
Ptr DuckDBDate -> Int -> IO DuckDBDate
Ptr DuckDBDate -> Int -> DuckDBDate -> IO ()
Ptr DuckDBDate -> DuckDBDate -> IO ()
DuckDBDate -> Int
(DuckDBDate -> Int)
-> (DuckDBDate -> Int)
-> (Ptr DuckDBDate -> Int -> IO DuckDBDate)
-> (Ptr DuckDBDate -> Int -> DuckDBDate -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBDate)
-> (forall b. Ptr b -> Int -> DuckDBDate -> IO ())
-> (Ptr DuckDBDate -> IO DuckDBDate)
-> (Ptr DuckDBDate -> DuckDBDate -> IO ())
-> Storable DuckDBDate
forall b. Ptr b -> Int -> IO DuckDBDate
forall b. Ptr b -> Int -> DuckDBDate -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBDate -> Int
sizeOf :: DuckDBDate -> Int
$calignment :: DuckDBDate -> Int
alignment :: DuckDBDate -> Int
$cpeekElemOff :: Ptr DuckDBDate -> Int -> IO DuckDBDate
peekElemOff :: Ptr DuckDBDate -> Int -> IO DuckDBDate
$cpokeElemOff :: Ptr DuckDBDate -> Int -> DuckDBDate -> IO ()
pokeElemOff :: Ptr DuckDBDate -> Int -> DuckDBDate -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBDate
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBDate
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBDate -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBDate -> IO ()
$cpeek :: Ptr DuckDBDate -> IO DuckDBDate
peek :: Ptr DuckDBDate -> IO DuckDBDate
$cpoke :: Ptr DuckDBDate -> DuckDBDate -> IO ()
poke :: Ptr DuckDBDate -> DuckDBDate -> IO ()
Storable)

-- | Decomposed representation of a @duckdb_date@.
data DuckDBDateStruct = DuckDBDateStruct
    { DuckDBDateStruct -> Int32
duckDBDateStructYear :: !Int32
    , DuckDBDateStruct -> Int8
duckDBDateStructMonth :: !Int8
    , DuckDBDateStruct -> Int8
duckDBDateStructDay :: !Int8
    }
    deriving (DuckDBDateStruct -> DuckDBDateStruct -> Bool
(DuckDBDateStruct -> DuckDBDateStruct -> Bool)
-> (DuckDBDateStruct -> DuckDBDateStruct -> Bool)
-> Eq DuckDBDateStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBDateStruct -> DuckDBDateStruct -> Bool
== :: DuckDBDateStruct -> DuckDBDateStruct -> Bool
$c/= :: DuckDBDateStruct -> DuckDBDateStruct -> Bool
/= :: DuckDBDateStruct -> DuckDBDateStruct -> Bool
Eq, Int -> DuckDBDateStruct -> ShowS
[DuckDBDateStruct] -> ShowS
DuckDBDateStruct -> String
(Int -> DuckDBDateStruct -> ShowS)
-> (DuckDBDateStruct -> String)
-> ([DuckDBDateStruct] -> ShowS)
-> Show DuckDBDateStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBDateStruct -> ShowS
showsPrec :: Int -> DuckDBDateStruct -> ShowS
$cshow :: DuckDBDateStruct -> String
show :: DuckDBDateStruct -> String
$cshowList :: [DuckDBDateStruct] -> ShowS
showList :: [DuckDBDateStruct] -> ShowS
Show)

instance Storable DuckDBDateStruct where
    sizeOf :: DuckDBDateStruct -> Int
sizeOf DuckDBDateStruct
_ = Int
alignedSize
      where
        rawSize :: Int
rawSize = Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int8 -> Int
forall a. Storable a => a -> Int
sizeOf (Int8
forall a. HasCallStack => a
undefined :: Int8)
        align :: Int
align = Int32 -> Int
forall a. Storable a => a -> Int
alignment (Int32
forall a. HasCallStack => a
undefined :: Int32)
        alignedSize :: Int
alignedSize = ((Int
rawSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
align Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
align) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
align
    alignment :: DuckDBDateStruct -> Int
alignment DuckDBDateStruct
_ = Int32 -> Int
forall a. Storable a => a -> Int
alignment (Int32
forall a. HasCallStack => a
undefined :: Int32)
    peek :: Ptr DuckDBDateStruct -> IO DuckDBDateStruct
peek Ptr DuckDBDateStruct
ptr = do
        Int32
year <- Ptr DuckDBDateStruct -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBDateStruct
ptr Int
0
        Int8
month <- Ptr DuckDBDateStruct -> Int -> IO Int8
forall b. Ptr b -> Int -> IO Int8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBDateStruct
ptr (Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32))
        Int8
day <- Ptr DuckDBDateStruct -> Int -> IO Int8
forall b. Ptr b -> Int -> IO Int8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBDateStruct
ptr (Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int8 -> Int
forall a. Storable a => a -> Int
sizeOf (Int8
forall a. HasCallStack => a
undefined :: Int8))
        DuckDBDateStruct -> IO DuckDBDateStruct
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Int8 -> Int8 -> DuckDBDateStruct
DuckDBDateStruct Int32
year Int8
month Int8
day)
    poke :: Ptr DuckDBDateStruct -> DuckDBDateStruct -> IO ()
poke Ptr DuckDBDateStruct
ptr DuckDBDateStruct{$sel:duckDBDateStructYear:DuckDBDateStruct :: DuckDBDateStruct -> Int32
duckDBDateStructYear = Int32
year, $sel:duckDBDateStructMonth:DuckDBDateStruct :: DuckDBDateStruct -> Int8
duckDBDateStructMonth = Int8
month, $sel:duckDBDateStructDay:DuckDBDateStruct :: DuckDBDateStruct -> Int8
duckDBDateStructDay = Int8
day} = do
        Ptr DuckDBDateStruct -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBDateStruct
ptr Int
0 Int32
year
        Ptr DuckDBDateStruct -> Int -> Int8 -> IO ()
forall b. Ptr b -> Int -> Int8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBDateStruct
ptr (Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32)) Int8
month
        Ptr DuckDBDateStruct -> Int -> Int8 -> IO ()
forall b. Ptr b -> Int -> Int8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBDateStruct
ptr (Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int8 -> Int
forall a. Storable a => a -> Int
sizeOf (Int8
forall a. HasCallStack => a
undefined :: Int8)) Int8
day

-- | Represents DuckDB's @duckdb_time@.
newtype DuckDBTime = DuckDBTime {DuckDBTime -> Int64
unDuckDBTime :: Int64}
    deriving (DuckDBTime -> DuckDBTime -> Bool
(DuckDBTime -> DuckDBTime -> Bool)
-> (DuckDBTime -> DuckDBTime -> Bool) -> Eq DuckDBTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTime -> DuckDBTime -> Bool
== :: DuckDBTime -> DuckDBTime -> Bool
$c/= :: DuckDBTime -> DuckDBTime -> Bool
/= :: DuckDBTime -> DuckDBTime -> Bool
Eq, Eq DuckDBTime
Eq DuckDBTime =>
(DuckDBTime -> DuckDBTime -> Ordering)
-> (DuckDBTime -> DuckDBTime -> Bool)
-> (DuckDBTime -> DuckDBTime -> Bool)
-> (DuckDBTime -> DuckDBTime -> Bool)
-> (DuckDBTime -> DuckDBTime -> Bool)
-> (DuckDBTime -> DuckDBTime -> DuckDBTime)
-> (DuckDBTime -> DuckDBTime -> DuckDBTime)
-> Ord DuckDBTime
DuckDBTime -> DuckDBTime -> Bool
DuckDBTime -> DuckDBTime -> Ordering
DuckDBTime -> DuckDBTime -> DuckDBTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBTime -> DuckDBTime -> Ordering
compare :: DuckDBTime -> DuckDBTime -> Ordering
$c< :: DuckDBTime -> DuckDBTime -> Bool
< :: DuckDBTime -> DuckDBTime -> Bool
$c<= :: DuckDBTime -> DuckDBTime -> Bool
<= :: DuckDBTime -> DuckDBTime -> Bool
$c> :: DuckDBTime -> DuckDBTime -> Bool
> :: DuckDBTime -> DuckDBTime -> Bool
$c>= :: DuckDBTime -> DuckDBTime -> Bool
>= :: DuckDBTime -> DuckDBTime -> Bool
$cmax :: DuckDBTime -> DuckDBTime -> DuckDBTime
max :: DuckDBTime -> DuckDBTime -> DuckDBTime
$cmin :: DuckDBTime -> DuckDBTime -> DuckDBTime
min :: DuckDBTime -> DuckDBTime -> DuckDBTime
Ord, Int -> DuckDBTime -> ShowS
[DuckDBTime] -> ShowS
DuckDBTime -> String
(Int -> DuckDBTime -> ShowS)
-> (DuckDBTime -> String)
-> ([DuckDBTime] -> ShowS)
-> Show DuckDBTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTime -> ShowS
showsPrec :: Int -> DuckDBTime -> ShowS
$cshow :: DuckDBTime -> String
show :: DuckDBTime -> String
$cshowList :: [DuckDBTime] -> ShowS
showList :: [DuckDBTime] -> ShowS
Show, Ptr DuckDBTime -> IO DuckDBTime
Ptr DuckDBTime -> Int -> IO DuckDBTime
Ptr DuckDBTime -> Int -> DuckDBTime -> IO ()
Ptr DuckDBTime -> DuckDBTime -> IO ()
DuckDBTime -> Int
(DuckDBTime -> Int)
-> (DuckDBTime -> Int)
-> (Ptr DuckDBTime -> Int -> IO DuckDBTime)
-> (Ptr DuckDBTime -> Int -> DuckDBTime -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBTime)
-> (forall b. Ptr b -> Int -> DuckDBTime -> IO ())
-> (Ptr DuckDBTime -> IO DuckDBTime)
-> (Ptr DuckDBTime -> DuckDBTime -> IO ())
-> Storable DuckDBTime
forall b. Ptr b -> Int -> IO DuckDBTime
forall b. Ptr b -> Int -> DuckDBTime -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBTime -> Int
sizeOf :: DuckDBTime -> Int
$calignment :: DuckDBTime -> Int
alignment :: DuckDBTime -> Int
$cpeekElemOff :: Ptr DuckDBTime -> Int -> IO DuckDBTime
peekElemOff :: Ptr DuckDBTime -> Int -> IO DuckDBTime
$cpokeElemOff :: Ptr DuckDBTime -> Int -> DuckDBTime -> IO ()
pokeElemOff :: Ptr DuckDBTime -> Int -> DuckDBTime -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTime
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTime
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBTime -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBTime -> IO ()
$cpeek :: Ptr DuckDBTime -> IO DuckDBTime
peek :: Ptr DuckDBTime -> IO DuckDBTime
$cpoke :: Ptr DuckDBTime -> DuckDBTime -> IO ()
poke :: Ptr DuckDBTime -> DuckDBTime -> IO ()
Storable)

-- | Decomposed representation of a @duckdb_time@.
data DuckDBTimeStruct = DuckDBTimeStruct
    { DuckDBTimeStruct -> Int8
duckDBTimeStructHour :: !Int8
    , DuckDBTimeStruct -> Int8
duckDBTimeStructMinute :: !Int8
    , DuckDBTimeStruct -> Int8
duckDBTimeStructSecond :: !Int8
    , DuckDBTimeStruct -> Int32
duckDBTimeStructMicros :: !Int32
    }
    deriving (DuckDBTimeStruct -> DuckDBTimeStruct -> Bool
(DuckDBTimeStruct -> DuckDBTimeStruct -> Bool)
-> (DuckDBTimeStruct -> DuckDBTimeStruct -> Bool)
-> Eq DuckDBTimeStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimeStruct -> DuckDBTimeStruct -> Bool
== :: DuckDBTimeStruct -> DuckDBTimeStruct -> Bool
$c/= :: DuckDBTimeStruct -> DuckDBTimeStruct -> Bool
/= :: DuckDBTimeStruct -> DuckDBTimeStruct -> Bool
Eq, Int -> DuckDBTimeStruct -> ShowS
[DuckDBTimeStruct] -> ShowS
DuckDBTimeStruct -> String
(Int -> DuckDBTimeStruct -> ShowS)
-> (DuckDBTimeStruct -> String)
-> ([DuckDBTimeStruct] -> ShowS)
-> Show DuckDBTimeStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimeStruct -> ShowS
showsPrec :: Int -> DuckDBTimeStruct -> ShowS
$cshow :: DuckDBTimeStruct -> String
show :: DuckDBTimeStruct -> String
$cshowList :: [DuckDBTimeStruct] -> ShowS
showList :: [DuckDBTimeStruct] -> ShowS
Show)

instance Storable DuckDBTimeStruct where
    sizeOf :: DuckDBTimeStruct -> Int
sizeOf DuckDBTimeStruct
_ = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int32 -> Int
forall a. Storable a => a -> Int
alignment (Int32
forall a. HasCallStack => a
undefined :: Int32)
    alignment :: DuckDBTimeStruct -> Int
alignment DuckDBTimeStruct
_ = Int32 -> Int
forall a. Storable a => a -> Int
alignment (Int32
forall a. HasCallStack => a
undefined :: Int32)
    peek :: Ptr DuckDBTimeStruct -> IO DuckDBTimeStruct
peek Ptr DuckDBTimeStruct
ptr = do
        Int8
hour <- Ptr DuckDBTimeStruct -> Int -> IO Int8
forall b. Ptr b -> Int -> IO Int8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBTimeStruct
ptr Int
0
        Int8
minute <- Ptr DuckDBTimeStruct -> Int -> IO Int8
forall b. Ptr b -> Int -> IO Int8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBTimeStruct
ptr Int
1
        Int8
second <- Ptr DuckDBTimeStruct -> Int -> IO Int8
forall b. Ptr b -> Int -> IO Int8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBTimeStruct
ptr Int
2
        Int32
micros <- Ptr DuckDBTimeStruct -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBTimeStruct
ptr Int
4
        DuckDBTimeStruct -> IO DuckDBTimeStruct
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int8 -> Int8 -> Int8 -> Int32 -> DuckDBTimeStruct
DuckDBTimeStruct Int8
hour Int8
minute Int8
second Int32
micros)
    poke :: Ptr DuckDBTimeStruct -> DuckDBTimeStruct -> IO ()
poke Ptr DuckDBTimeStruct
ptr DuckDBTimeStruct{$sel:duckDBTimeStructHour:DuckDBTimeStruct :: DuckDBTimeStruct -> Int8
duckDBTimeStructHour = Int8
hour, $sel:duckDBTimeStructMinute:DuckDBTimeStruct :: DuckDBTimeStruct -> Int8
duckDBTimeStructMinute = Int8
minute, $sel:duckDBTimeStructSecond:DuckDBTimeStruct :: DuckDBTimeStruct -> Int8
duckDBTimeStructSecond = Int8
second, $sel:duckDBTimeStructMicros:DuckDBTimeStruct :: DuckDBTimeStruct -> Int32
duckDBTimeStructMicros = Int32
micros} = do
        Ptr DuckDBTimeStruct -> Int -> Int8 -> IO ()
forall b. Ptr b -> Int -> Int8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBTimeStruct
ptr Int
0 Int8
hour
        Ptr DuckDBTimeStruct -> Int -> Int8 -> IO ()
forall b. Ptr b -> Int -> Int8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBTimeStruct
ptr Int
1 Int8
minute
        Ptr DuckDBTimeStruct -> Int -> Int8 -> IO ()
forall b. Ptr b -> Int -> Int8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBTimeStruct
ptr Int
2 Int8
second
        Ptr DuckDBTimeStruct -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBTimeStruct
ptr Int
4 Int32
micros

-- | Represents DuckDB's @duckdb_time_ns@.
newtype DuckDBTimeNs = DuckDBTimeNs {DuckDBTimeNs -> Int64
unDuckDBTimeNs :: Int64}
    deriving (DuckDBTimeNs -> DuckDBTimeNs -> Bool
(DuckDBTimeNs -> DuckDBTimeNs -> Bool)
-> (DuckDBTimeNs -> DuckDBTimeNs -> Bool) -> Eq DuckDBTimeNs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
== :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
$c/= :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
/= :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
Eq, Eq DuckDBTimeNs
Eq DuckDBTimeNs =>
(DuckDBTimeNs -> DuckDBTimeNs -> Ordering)
-> (DuckDBTimeNs -> DuckDBTimeNs -> Bool)
-> (DuckDBTimeNs -> DuckDBTimeNs -> Bool)
-> (DuckDBTimeNs -> DuckDBTimeNs -> Bool)
-> (DuckDBTimeNs -> DuckDBTimeNs -> Bool)
-> (DuckDBTimeNs -> DuckDBTimeNs -> DuckDBTimeNs)
-> (DuckDBTimeNs -> DuckDBTimeNs -> DuckDBTimeNs)
-> Ord DuckDBTimeNs
DuckDBTimeNs -> DuckDBTimeNs -> Bool
DuckDBTimeNs -> DuckDBTimeNs -> Ordering
DuckDBTimeNs -> DuckDBTimeNs -> DuckDBTimeNs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBTimeNs -> DuckDBTimeNs -> Ordering
compare :: DuckDBTimeNs -> DuckDBTimeNs -> Ordering
$c< :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
< :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
$c<= :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
<= :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
$c> :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
> :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
$c>= :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
>= :: DuckDBTimeNs -> DuckDBTimeNs -> Bool
$cmax :: DuckDBTimeNs -> DuckDBTimeNs -> DuckDBTimeNs
max :: DuckDBTimeNs -> DuckDBTimeNs -> DuckDBTimeNs
$cmin :: DuckDBTimeNs -> DuckDBTimeNs -> DuckDBTimeNs
min :: DuckDBTimeNs -> DuckDBTimeNs -> DuckDBTimeNs
Ord, Int -> DuckDBTimeNs -> ShowS
[DuckDBTimeNs] -> ShowS
DuckDBTimeNs -> String
(Int -> DuckDBTimeNs -> ShowS)
-> (DuckDBTimeNs -> String)
-> ([DuckDBTimeNs] -> ShowS)
-> Show DuckDBTimeNs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimeNs -> ShowS
showsPrec :: Int -> DuckDBTimeNs -> ShowS
$cshow :: DuckDBTimeNs -> String
show :: DuckDBTimeNs -> String
$cshowList :: [DuckDBTimeNs] -> ShowS
showList :: [DuckDBTimeNs] -> ShowS
Show, Ptr DuckDBTimeNs -> IO DuckDBTimeNs
Ptr DuckDBTimeNs -> Int -> IO DuckDBTimeNs
Ptr DuckDBTimeNs -> Int -> DuckDBTimeNs -> IO ()
Ptr DuckDBTimeNs -> DuckDBTimeNs -> IO ()
DuckDBTimeNs -> Int
(DuckDBTimeNs -> Int)
-> (DuckDBTimeNs -> Int)
-> (Ptr DuckDBTimeNs -> Int -> IO DuckDBTimeNs)
-> (Ptr DuckDBTimeNs -> Int -> DuckDBTimeNs -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBTimeNs)
-> (forall b. Ptr b -> Int -> DuckDBTimeNs -> IO ())
-> (Ptr DuckDBTimeNs -> IO DuckDBTimeNs)
-> (Ptr DuckDBTimeNs -> DuckDBTimeNs -> IO ())
-> Storable DuckDBTimeNs
forall b. Ptr b -> Int -> IO DuckDBTimeNs
forall b. Ptr b -> Int -> DuckDBTimeNs -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBTimeNs -> Int
sizeOf :: DuckDBTimeNs -> Int
$calignment :: DuckDBTimeNs -> Int
alignment :: DuckDBTimeNs -> Int
$cpeekElemOff :: Ptr DuckDBTimeNs -> Int -> IO DuckDBTimeNs
peekElemOff :: Ptr DuckDBTimeNs -> Int -> IO DuckDBTimeNs
$cpokeElemOff :: Ptr DuckDBTimeNs -> Int -> DuckDBTimeNs -> IO ()
pokeElemOff :: Ptr DuckDBTimeNs -> Int -> DuckDBTimeNs -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimeNs
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimeNs
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimeNs -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimeNs -> IO ()
$cpeek :: Ptr DuckDBTimeNs -> IO DuckDBTimeNs
peek :: Ptr DuckDBTimeNs -> IO DuckDBTimeNs
$cpoke :: Ptr DuckDBTimeNs -> DuckDBTimeNs -> IO ()
poke :: Ptr DuckDBTimeNs -> DuckDBTimeNs -> IO ()
Storable)

-- | Represents DuckDB's @duckdb_time_tz@.
newtype DuckDBTimeTz = DuckDBTimeTz {DuckDBTimeTz -> Word64
unDuckDBTimeTz :: Word64}
    deriving (DuckDBTimeTz -> DuckDBTimeTz -> Bool
(DuckDBTimeTz -> DuckDBTimeTz -> Bool)
-> (DuckDBTimeTz -> DuckDBTimeTz -> Bool) -> Eq DuckDBTimeTz
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
== :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
$c/= :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
/= :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
Eq, Eq DuckDBTimeTz
Eq DuckDBTimeTz =>
(DuckDBTimeTz -> DuckDBTimeTz -> Ordering)
-> (DuckDBTimeTz -> DuckDBTimeTz -> Bool)
-> (DuckDBTimeTz -> DuckDBTimeTz -> Bool)
-> (DuckDBTimeTz -> DuckDBTimeTz -> Bool)
-> (DuckDBTimeTz -> DuckDBTimeTz -> Bool)
-> (DuckDBTimeTz -> DuckDBTimeTz -> DuckDBTimeTz)
-> (DuckDBTimeTz -> DuckDBTimeTz -> DuckDBTimeTz)
-> Ord DuckDBTimeTz
DuckDBTimeTz -> DuckDBTimeTz -> Bool
DuckDBTimeTz -> DuckDBTimeTz -> Ordering
DuckDBTimeTz -> DuckDBTimeTz -> DuckDBTimeTz
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBTimeTz -> DuckDBTimeTz -> Ordering
compare :: DuckDBTimeTz -> DuckDBTimeTz -> Ordering
$c< :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
< :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
$c<= :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
<= :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
$c> :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
> :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
$c>= :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
>= :: DuckDBTimeTz -> DuckDBTimeTz -> Bool
$cmax :: DuckDBTimeTz -> DuckDBTimeTz -> DuckDBTimeTz
max :: DuckDBTimeTz -> DuckDBTimeTz -> DuckDBTimeTz
$cmin :: DuckDBTimeTz -> DuckDBTimeTz -> DuckDBTimeTz
min :: DuckDBTimeTz -> DuckDBTimeTz -> DuckDBTimeTz
Ord, Int -> DuckDBTimeTz -> ShowS
[DuckDBTimeTz] -> ShowS
DuckDBTimeTz -> String
(Int -> DuckDBTimeTz -> ShowS)
-> (DuckDBTimeTz -> String)
-> ([DuckDBTimeTz] -> ShowS)
-> Show DuckDBTimeTz
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimeTz -> ShowS
showsPrec :: Int -> DuckDBTimeTz -> ShowS
$cshow :: DuckDBTimeTz -> String
show :: DuckDBTimeTz -> String
$cshowList :: [DuckDBTimeTz] -> ShowS
showList :: [DuckDBTimeTz] -> ShowS
Show, Ptr DuckDBTimeTz -> IO DuckDBTimeTz
Ptr DuckDBTimeTz -> Int -> IO DuckDBTimeTz
Ptr DuckDBTimeTz -> Int -> DuckDBTimeTz -> IO ()
Ptr DuckDBTimeTz -> DuckDBTimeTz -> IO ()
DuckDBTimeTz -> Int
(DuckDBTimeTz -> Int)
-> (DuckDBTimeTz -> Int)
-> (Ptr DuckDBTimeTz -> Int -> IO DuckDBTimeTz)
-> (Ptr DuckDBTimeTz -> Int -> DuckDBTimeTz -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBTimeTz)
-> (forall b. Ptr b -> Int -> DuckDBTimeTz -> IO ())
-> (Ptr DuckDBTimeTz -> IO DuckDBTimeTz)
-> (Ptr DuckDBTimeTz -> DuckDBTimeTz -> IO ())
-> Storable DuckDBTimeTz
forall b. Ptr b -> Int -> IO DuckDBTimeTz
forall b. Ptr b -> Int -> DuckDBTimeTz -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBTimeTz -> Int
sizeOf :: DuckDBTimeTz -> Int
$calignment :: DuckDBTimeTz -> Int
alignment :: DuckDBTimeTz -> Int
$cpeekElemOff :: Ptr DuckDBTimeTz -> Int -> IO DuckDBTimeTz
peekElemOff :: Ptr DuckDBTimeTz -> Int -> IO DuckDBTimeTz
$cpokeElemOff :: Ptr DuckDBTimeTz -> Int -> DuckDBTimeTz -> IO ()
pokeElemOff :: Ptr DuckDBTimeTz -> Int -> DuckDBTimeTz -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimeTz
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimeTz
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimeTz -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimeTz -> IO ()
$cpeek :: Ptr DuckDBTimeTz -> IO DuckDBTimeTz
peek :: Ptr DuckDBTimeTz -> IO DuckDBTimeTz
$cpoke :: Ptr DuckDBTimeTz -> DuckDBTimeTz -> IO ()
poke :: Ptr DuckDBTimeTz -> DuckDBTimeTz -> IO ()
Storable)

-- | Decomposed representation of a @duckdb_time_tz@.
data DuckDBTimeTzStruct = DuckDBTimeTzStruct
    { DuckDBTimeTzStruct -> DuckDBTimeStruct
duckDBTimeTzStructTime :: !DuckDBTimeStruct
    , DuckDBTimeTzStruct -> Int32
duckDBTimeTzStructOffset :: !Int32
    }
    deriving (DuckDBTimeTzStruct -> DuckDBTimeTzStruct -> Bool
(DuckDBTimeTzStruct -> DuckDBTimeTzStruct -> Bool)
-> (DuckDBTimeTzStruct -> DuckDBTimeTzStruct -> Bool)
-> Eq DuckDBTimeTzStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimeTzStruct -> DuckDBTimeTzStruct -> Bool
== :: DuckDBTimeTzStruct -> DuckDBTimeTzStruct -> Bool
$c/= :: DuckDBTimeTzStruct -> DuckDBTimeTzStruct -> Bool
/= :: DuckDBTimeTzStruct -> DuckDBTimeTzStruct -> Bool
Eq, Int -> DuckDBTimeTzStruct -> ShowS
[DuckDBTimeTzStruct] -> ShowS
DuckDBTimeTzStruct -> String
(Int -> DuckDBTimeTzStruct -> ShowS)
-> (DuckDBTimeTzStruct -> String)
-> ([DuckDBTimeTzStruct] -> ShowS)
-> Show DuckDBTimeTzStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimeTzStruct -> ShowS
showsPrec :: Int -> DuckDBTimeTzStruct -> ShowS
$cshow :: DuckDBTimeTzStruct -> String
show :: DuckDBTimeTzStruct -> String
$cshowList :: [DuckDBTimeTzStruct] -> ShowS
showList :: [DuckDBTimeTzStruct] -> ShowS
Show)

instance Storable DuckDBTimeTzStruct where
    sizeOf :: DuckDBTimeTzStruct -> Int
sizeOf DuckDBTimeTzStruct
_ = DuckDBTimeStruct -> Int
forall a. Storable a => a -> Int
sizeOf (DuckDBTimeStruct
forall a. HasCallStack => a
undefined :: DuckDBTimeStruct) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32)
    alignment :: DuckDBTimeTzStruct -> Int
alignment DuckDBTimeTzStruct
_ = Int32 -> Int
forall a. Storable a => a -> Int
alignment (Int32
forall a. HasCallStack => a
undefined :: Int32)
    peek :: Ptr DuckDBTimeTzStruct -> IO DuckDBTimeTzStruct
peek Ptr DuckDBTimeTzStruct
ptr = do
        DuckDBTimeStruct
time <- Ptr DuckDBTimeTzStruct -> Int -> IO DuckDBTimeStruct
forall b. Ptr b -> Int -> IO DuckDBTimeStruct
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBTimeTzStruct
ptr Int
0
        Int32
offset <- Ptr DuckDBTimeTzStruct -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBTimeTzStruct
ptr (DuckDBTimeStruct -> Int
forall a. Storable a => a -> Int
sizeOf (DuckDBTimeStruct
forall a. HasCallStack => a
undefined :: DuckDBTimeStruct))
        DuckDBTimeTzStruct -> IO DuckDBTimeTzStruct
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DuckDBTimeStruct -> Int32 -> DuckDBTimeTzStruct
DuckDBTimeTzStruct DuckDBTimeStruct
time Int32
offset)
    poke :: Ptr DuckDBTimeTzStruct -> DuckDBTimeTzStruct -> IO ()
poke Ptr DuckDBTimeTzStruct
ptr DuckDBTimeTzStruct{$sel:duckDBTimeTzStructTime:DuckDBTimeTzStruct :: DuckDBTimeTzStruct -> DuckDBTimeStruct
duckDBTimeTzStructTime = DuckDBTimeStruct
time, $sel:duckDBTimeTzStructOffset:DuckDBTimeTzStruct :: DuckDBTimeTzStruct -> Int32
duckDBTimeTzStructOffset = Int32
offset} = do
        Ptr DuckDBTimeTzStruct -> Int -> DuckDBTimeStruct -> IO ()
forall b. Ptr b -> Int -> DuckDBTimeStruct -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBTimeTzStruct
ptr Int
0 DuckDBTimeStruct
time
        Ptr DuckDBTimeTzStruct -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBTimeTzStruct
ptr (DuckDBTimeStruct -> Int
forall a. Storable a => a -> Int
sizeOf (DuckDBTimeStruct
forall a. HasCallStack => a
undefined :: DuckDBTimeStruct)) Int32
offset

-- | Represents DuckDB's @duckdb_timestamp@.
newtype DuckDBTimestamp = DuckDBTimestamp {DuckDBTimestamp -> Int64
unDuckDBTimestamp :: Int64}
    deriving (DuckDBTimestamp -> DuckDBTimestamp -> Bool
(DuckDBTimestamp -> DuckDBTimestamp -> Bool)
-> (DuckDBTimestamp -> DuckDBTimestamp -> Bool)
-> Eq DuckDBTimestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
== :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
$c/= :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
/= :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
Eq, Eq DuckDBTimestamp
Eq DuckDBTimestamp =>
(DuckDBTimestamp -> DuckDBTimestamp -> Ordering)
-> (DuckDBTimestamp -> DuckDBTimestamp -> Bool)
-> (DuckDBTimestamp -> DuckDBTimestamp -> Bool)
-> (DuckDBTimestamp -> DuckDBTimestamp -> Bool)
-> (DuckDBTimestamp -> DuckDBTimestamp -> Bool)
-> (DuckDBTimestamp -> DuckDBTimestamp -> DuckDBTimestamp)
-> (DuckDBTimestamp -> DuckDBTimestamp -> DuckDBTimestamp)
-> Ord DuckDBTimestamp
DuckDBTimestamp -> DuckDBTimestamp -> Bool
DuckDBTimestamp -> DuckDBTimestamp -> Ordering
DuckDBTimestamp -> DuckDBTimestamp -> DuckDBTimestamp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBTimestamp -> DuckDBTimestamp -> Ordering
compare :: DuckDBTimestamp -> DuckDBTimestamp -> Ordering
$c< :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
< :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
$c<= :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
<= :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
$c> :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
> :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
$c>= :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
>= :: DuckDBTimestamp -> DuckDBTimestamp -> Bool
$cmax :: DuckDBTimestamp -> DuckDBTimestamp -> DuckDBTimestamp
max :: DuckDBTimestamp -> DuckDBTimestamp -> DuckDBTimestamp
$cmin :: DuckDBTimestamp -> DuckDBTimestamp -> DuckDBTimestamp
min :: DuckDBTimestamp -> DuckDBTimestamp -> DuckDBTimestamp
Ord, Int -> DuckDBTimestamp -> ShowS
[DuckDBTimestamp] -> ShowS
DuckDBTimestamp -> String
(Int -> DuckDBTimestamp -> ShowS)
-> (DuckDBTimestamp -> String)
-> ([DuckDBTimestamp] -> ShowS)
-> Show DuckDBTimestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimestamp -> ShowS
showsPrec :: Int -> DuckDBTimestamp -> ShowS
$cshow :: DuckDBTimestamp -> String
show :: DuckDBTimestamp -> String
$cshowList :: [DuckDBTimestamp] -> ShowS
showList :: [DuckDBTimestamp] -> ShowS
Show, Ptr DuckDBTimestamp -> IO DuckDBTimestamp
Ptr DuckDBTimestamp -> Int -> IO DuckDBTimestamp
Ptr DuckDBTimestamp -> Int -> DuckDBTimestamp -> IO ()
Ptr DuckDBTimestamp -> DuckDBTimestamp -> IO ()
DuckDBTimestamp -> Int
(DuckDBTimestamp -> Int)
-> (DuckDBTimestamp -> Int)
-> (Ptr DuckDBTimestamp -> Int -> IO DuckDBTimestamp)
-> (Ptr DuckDBTimestamp -> Int -> DuckDBTimestamp -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBTimestamp)
-> (forall b. Ptr b -> Int -> DuckDBTimestamp -> IO ())
-> (Ptr DuckDBTimestamp -> IO DuckDBTimestamp)
-> (Ptr DuckDBTimestamp -> DuckDBTimestamp -> IO ())
-> Storable DuckDBTimestamp
forall b. Ptr b -> Int -> IO DuckDBTimestamp
forall b. Ptr b -> Int -> DuckDBTimestamp -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBTimestamp -> Int
sizeOf :: DuckDBTimestamp -> Int
$calignment :: DuckDBTimestamp -> Int
alignment :: DuckDBTimestamp -> Int
$cpeekElemOff :: Ptr DuckDBTimestamp -> Int -> IO DuckDBTimestamp
peekElemOff :: Ptr DuckDBTimestamp -> Int -> IO DuckDBTimestamp
$cpokeElemOff :: Ptr DuckDBTimestamp -> Int -> DuckDBTimestamp -> IO ()
pokeElemOff :: Ptr DuckDBTimestamp -> Int -> DuckDBTimestamp -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimestamp
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimestamp
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimestamp -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimestamp -> IO ()
$cpeek :: Ptr DuckDBTimestamp -> IO DuckDBTimestamp
peek :: Ptr DuckDBTimestamp -> IO DuckDBTimestamp
$cpoke :: Ptr DuckDBTimestamp -> DuckDBTimestamp -> IO ()
poke :: Ptr DuckDBTimestamp -> DuckDBTimestamp -> IO ()
Storable)

-- | Decomposed representation of a @duckdb_timestamp@.
data DuckDBTimestampStruct = DuckDBTimestampStruct
    { DuckDBTimestampStruct -> DuckDBDateStruct
duckDBTimestampStructDate :: !DuckDBDateStruct
    , DuckDBTimestampStruct -> DuckDBTimeStruct
duckDBTimestampStructTime :: !DuckDBTimeStruct
    }
    deriving (DuckDBTimestampStruct -> DuckDBTimestampStruct -> Bool
(DuckDBTimestampStruct -> DuckDBTimestampStruct -> Bool)
-> (DuckDBTimestampStruct -> DuckDBTimestampStruct -> Bool)
-> Eq DuckDBTimestampStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimestampStruct -> DuckDBTimestampStruct -> Bool
== :: DuckDBTimestampStruct -> DuckDBTimestampStruct -> Bool
$c/= :: DuckDBTimestampStruct -> DuckDBTimestampStruct -> Bool
/= :: DuckDBTimestampStruct -> DuckDBTimestampStruct -> Bool
Eq, Int -> DuckDBTimestampStruct -> ShowS
[DuckDBTimestampStruct] -> ShowS
DuckDBTimestampStruct -> String
(Int -> DuckDBTimestampStruct -> ShowS)
-> (DuckDBTimestampStruct -> String)
-> ([DuckDBTimestampStruct] -> ShowS)
-> Show DuckDBTimestampStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimestampStruct -> ShowS
showsPrec :: Int -> DuckDBTimestampStruct -> ShowS
$cshow :: DuckDBTimestampStruct -> String
show :: DuckDBTimestampStruct -> String
$cshowList :: [DuckDBTimestampStruct] -> ShowS
showList :: [DuckDBTimestampStruct] -> ShowS
Show)

instance Storable DuckDBTimestampStruct where
    sizeOf :: DuckDBTimestampStruct -> Int
sizeOf DuckDBTimestampStruct
_ = DuckDBDateStruct -> Int
forall a. Storable a => a -> Int
sizeOf (DuckDBDateStruct
forall a. HasCallStack => a
undefined :: DuckDBDateStruct) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DuckDBTimeStruct -> Int
forall a. Storable a => a -> Int
sizeOf (DuckDBTimeStruct
forall a. HasCallStack => a
undefined :: DuckDBTimeStruct)
    alignment :: DuckDBTimestampStruct -> Int
alignment DuckDBTimestampStruct
_ = DuckDBTimeStruct -> Int
forall a. Storable a => a -> Int
alignment (DuckDBTimeStruct
forall a. HasCallStack => a
undefined :: DuckDBTimeStruct)
    peek :: Ptr DuckDBTimestampStruct -> IO DuckDBTimestampStruct
peek Ptr DuckDBTimestampStruct
ptr = do
        DuckDBDateStruct
date <- Ptr DuckDBTimestampStruct -> Int -> IO DuckDBDateStruct
forall b. Ptr b -> Int -> IO DuckDBDateStruct
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBTimestampStruct
ptr Int
0
        DuckDBTimeStruct
time <- Ptr DuckDBTimestampStruct -> Int -> IO DuckDBTimeStruct
forall b. Ptr b -> Int -> IO DuckDBTimeStruct
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBTimestampStruct
ptr (DuckDBDateStruct -> Int
forall a. Storable a => a -> Int
sizeOf (DuckDBDateStruct
forall a. HasCallStack => a
undefined :: DuckDBDateStruct))
        DuckDBTimestampStruct -> IO DuckDBTimestampStruct
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DuckDBDateStruct -> DuckDBTimeStruct -> DuckDBTimestampStruct
DuckDBTimestampStruct DuckDBDateStruct
date DuckDBTimeStruct
time)
    poke :: Ptr DuckDBTimestampStruct -> DuckDBTimestampStruct -> IO ()
poke Ptr DuckDBTimestampStruct
ptr DuckDBTimestampStruct{$sel:duckDBTimestampStructDate:DuckDBTimestampStruct :: DuckDBTimestampStruct -> DuckDBDateStruct
duckDBTimestampStructDate = DuckDBDateStruct
date, $sel:duckDBTimestampStructTime:DuckDBTimestampStruct :: DuckDBTimestampStruct -> DuckDBTimeStruct
duckDBTimestampStructTime = DuckDBTimeStruct
time} = do
        Ptr DuckDBTimestampStruct -> Int -> DuckDBDateStruct -> IO ()
forall b. Ptr b -> Int -> DuckDBDateStruct -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBTimestampStruct
ptr Int
0 DuckDBDateStruct
date
        Ptr DuckDBTimestampStruct -> Int -> DuckDBTimeStruct -> IO ()
forall b. Ptr b -> Int -> DuckDBTimeStruct -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBTimestampStruct
ptr (DuckDBDateStruct -> Int
forall a. Storable a => a -> Int
sizeOf (DuckDBDateStruct
forall a. HasCallStack => a
undefined :: DuckDBDateStruct)) DuckDBTimeStruct
time

-- | Represents DuckDB's @duckdb_timestamp_s@.
newtype DuckDBTimestampS = DuckDBTimestampS {DuckDBTimestampS -> Int64
unDuckDBTimestampS :: Int64}
    deriving (DuckDBTimestampS -> DuckDBTimestampS -> Bool
(DuckDBTimestampS -> DuckDBTimestampS -> Bool)
-> (DuckDBTimestampS -> DuckDBTimestampS -> Bool)
-> Eq DuckDBTimestampS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
== :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
$c/= :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
/= :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
Eq, Eq DuckDBTimestampS
Eq DuckDBTimestampS =>
(DuckDBTimestampS -> DuckDBTimestampS -> Ordering)
-> (DuckDBTimestampS -> DuckDBTimestampS -> Bool)
-> (DuckDBTimestampS -> DuckDBTimestampS -> Bool)
-> (DuckDBTimestampS -> DuckDBTimestampS -> Bool)
-> (DuckDBTimestampS -> DuckDBTimestampS -> Bool)
-> (DuckDBTimestampS -> DuckDBTimestampS -> DuckDBTimestampS)
-> (DuckDBTimestampS -> DuckDBTimestampS -> DuckDBTimestampS)
-> Ord DuckDBTimestampS
DuckDBTimestampS -> DuckDBTimestampS -> Bool
DuckDBTimestampS -> DuckDBTimestampS -> Ordering
DuckDBTimestampS -> DuckDBTimestampS -> DuckDBTimestampS
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBTimestampS -> DuckDBTimestampS -> Ordering
compare :: DuckDBTimestampS -> DuckDBTimestampS -> Ordering
$c< :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
< :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
$c<= :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
<= :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
$c> :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
> :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
$c>= :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
>= :: DuckDBTimestampS -> DuckDBTimestampS -> Bool
$cmax :: DuckDBTimestampS -> DuckDBTimestampS -> DuckDBTimestampS
max :: DuckDBTimestampS -> DuckDBTimestampS -> DuckDBTimestampS
$cmin :: DuckDBTimestampS -> DuckDBTimestampS -> DuckDBTimestampS
min :: DuckDBTimestampS -> DuckDBTimestampS -> DuckDBTimestampS
Ord, Int -> DuckDBTimestampS -> ShowS
[DuckDBTimestampS] -> ShowS
DuckDBTimestampS -> String
(Int -> DuckDBTimestampS -> ShowS)
-> (DuckDBTimestampS -> String)
-> ([DuckDBTimestampS] -> ShowS)
-> Show DuckDBTimestampS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimestampS -> ShowS
showsPrec :: Int -> DuckDBTimestampS -> ShowS
$cshow :: DuckDBTimestampS -> String
show :: DuckDBTimestampS -> String
$cshowList :: [DuckDBTimestampS] -> ShowS
showList :: [DuckDBTimestampS] -> ShowS
Show, Ptr DuckDBTimestampS -> IO DuckDBTimestampS
Ptr DuckDBTimestampS -> Int -> IO DuckDBTimestampS
Ptr DuckDBTimestampS -> Int -> DuckDBTimestampS -> IO ()
Ptr DuckDBTimestampS -> DuckDBTimestampS -> IO ()
DuckDBTimestampS -> Int
(DuckDBTimestampS -> Int)
-> (DuckDBTimestampS -> Int)
-> (Ptr DuckDBTimestampS -> Int -> IO DuckDBTimestampS)
-> (Ptr DuckDBTimestampS -> Int -> DuckDBTimestampS -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBTimestampS)
-> (forall b. Ptr b -> Int -> DuckDBTimestampS -> IO ())
-> (Ptr DuckDBTimestampS -> IO DuckDBTimestampS)
-> (Ptr DuckDBTimestampS -> DuckDBTimestampS -> IO ())
-> Storable DuckDBTimestampS
forall b. Ptr b -> Int -> IO DuckDBTimestampS
forall b. Ptr b -> Int -> DuckDBTimestampS -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBTimestampS -> Int
sizeOf :: DuckDBTimestampS -> Int
$calignment :: DuckDBTimestampS -> Int
alignment :: DuckDBTimestampS -> Int
$cpeekElemOff :: Ptr DuckDBTimestampS -> Int -> IO DuckDBTimestampS
peekElemOff :: Ptr DuckDBTimestampS -> Int -> IO DuckDBTimestampS
$cpokeElemOff :: Ptr DuckDBTimestampS -> Int -> DuckDBTimestampS -> IO ()
pokeElemOff :: Ptr DuckDBTimestampS -> Int -> DuckDBTimestampS -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimestampS
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimestampS
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimestampS -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimestampS -> IO ()
$cpeek :: Ptr DuckDBTimestampS -> IO DuckDBTimestampS
peek :: Ptr DuckDBTimestampS -> IO DuckDBTimestampS
$cpoke :: Ptr DuckDBTimestampS -> DuckDBTimestampS -> IO ()
poke :: Ptr DuckDBTimestampS -> DuckDBTimestampS -> IO ()
Storable)

-- | Represents DuckDB's @duckdb_timestamp_ms@.
newtype DuckDBTimestampMs = DuckDBTimestampMs {DuckDBTimestampMs -> Int64
unDuckDBTimestampMs :: Int64}
    deriving (DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
(DuckDBTimestampMs -> DuckDBTimestampMs -> Bool)
-> (DuckDBTimestampMs -> DuckDBTimestampMs -> Bool)
-> Eq DuckDBTimestampMs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
== :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
$c/= :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
/= :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
Eq, Eq DuckDBTimestampMs
Eq DuckDBTimestampMs =>
(DuckDBTimestampMs -> DuckDBTimestampMs -> Ordering)
-> (DuckDBTimestampMs -> DuckDBTimestampMs -> Bool)
-> (DuckDBTimestampMs -> DuckDBTimestampMs -> Bool)
-> (DuckDBTimestampMs -> DuckDBTimestampMs -> Bool)
-> (DuckDBTimestampMs -> DuckDBTimestampMs -> Bool)
-> (DuckDBTimestampMs -> DuckDBTimestampMs -> DuckDBTimestampMs)
-> (DuckDBTimestampMs -> DuckDBTimestampMs -> DuckDBTimestampMs)
-> Ord DuckDBTimestampMs
DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
DuckDBTimestampMs -> DuckDBTimestampMs -> Ordering
DuckDBTimestampMs -> DuckDBTimestampMs -> DuckDBTimestampMs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBTimestampMs -> DuckDBTimestampMs -> Ordering
compare :: DuckDBTimestampMs -> DuckDBTimestampMs -> Ordering
$c< :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
< :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
$c<= :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
<= :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
$c> :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
> :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
$c>= :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
>= :: DuckDBTimestampMs -> DuckDBTimestampMs -> Bool
$cmax :: DuckDBTimestampMs -> DuckDBTimestampMs -> DuckDBTimestampMs
max :: DuckDBTimestampMs -> DuckDBTimestampMs -> DuckDBTimestampMs
$cmin :: DuckDBTimestampMs -> DuckDBTimestampMs -> DuckDBTimestampMs
min :: DuckDBTimestampMs -> DuckDBTimestampMs -> DuckDBTimestampMs
Ord, Int -> DuckDBTimestampMs -> ShowS
[DuckDBTimestampMs] -> ShowS
DuckDBTimestampMs -> String
(Int -> DuckDBTimestampMs -> ShowS)
-> (DuckDBTimestampMs -> String)
-> ([DuckDBTimestampMs] -> ShowS)
-> Show DuckDBTimestampMs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimestampMs -> ShowS
showsPrec :: Int -> DuckDBTimestampMs -> ShowS
$cshow :: DuckDBTimestampMs -> String
show :: DuckDBTimestampMs -> String
$cshowList :: [DuckDBTimestampMs] -> ShowS
showList :: [DuckDBTimestampMs] -> ShowS
Show, Ptr DuckDBTimestampMs -> IO DuckDBTimestampMs
Ptr DuckDBTimestampMs -> Int -> IO DuckDBTimestampMs
Ptr DuckDBTimestampMs -> Int -> DuckDBTimestampMs -> IO ()
Ptr DuckDBTimestampMs -> DuckDBTimestampMs -> IO ()
DuckDBTimestampMs -> Int
(DuckDBTimestampMs -> Int)
-> (DuckDBTimestampMs -> Int)
-> (Ptr DuckDBTimestampMs -> Int -> IO DuckDBTimestampMs)
-> (Ptr DuckDBTimestampMs -> Int -> DuckDBTimestampMs -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBTimestampMs)
-> (forall b. Ptr b -> Int -> DuckDBTimestampMs -> IO ())
-> (Ptr DuckDBTimestampMs -> IO DuckDBTimestampMs)
-> (Ptr DuckDBTimestampMs -> DuckDBTimestampMs -> IO ())
-> Storable DuckDBTimestampMs
forall b. Ptr b -> Int -> IO DuckDBTimestampMs
forall b. Ptr b -> Int -> DuckDBTimestampMs -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBTimestampMs -> Int
sizeOf :: DuckDBTimestampMs -> Int
$calignment :: DuckDBTimestampMs -> Int
alignment :: DuckDBTimestampMs -> Int
$cpeekElemOff :: Ptr DuckDBTimestampMs -> Int -> IO DuckDBTimestampMs
peekElemOff :: Ptr DuckDBTimestampMs -> Int -> IO DuckDBTimestampMs
$cpokeElemOff :: Ptr DuckDBTimestampMs -> Int -> DuckDBTimestampMs -> IO ()
pokeElemOff :: Ptr DuckDBTimestampMs -> Int -> DuckDBTimestampMs -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimestampMs
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimestampMs
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimestampMs -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimestampMs -> IO ()
$cpeek :: Ptr DuckDBTimestampMs -> IO DuckDBTimestampMs
peek :: Ptr DuckDBTimestampMs -> IO DuckDBTimestampMs
$cpoke :: Ptr DuckDBTimestampMs -> DuckDBTimestampMs -> IO ()
poke :: Ptr DuckDBTimestampMs -> DuckDBTimestampMs -> IO ()
Storable)

-- | Represents DuckDB's @duckdb_timestamp_ns@.
newtype DuckDBTimestampNs = DuckDBTimestampNs {DuckDBTimestampNs -> Int64
unDuckDBTimestampNs :: Int64}
    deriving (DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
(DuckDBTimestampNs -> DuckDBTimestampNs -> Bool)
-> (DuckDBTimestampNs -> DuckDBTimestampNs -> Bool)
-> Eq DuckDBTimestampNs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
== :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
$c/= :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
/= :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
Eq, Eq DuckDBTimestampNs
Eq DuckDBTimestampNs =>
(DuckDBTimestampNs -> DuckDBTimestampNs -> Ordering)
-> (DuckDBTimestampNs -> DuckDBTimestampNs -> Bool)
-> (DuckDBTimestampNs -> DuckDBTimestampNs -> Bool)
-> (DuckDBTimestampNs -> DuckDBTimestampNs -> Bool)
-> (DuckDBTimestampNs -> DuckDBTimestampNs -> Bool)
-> (DuckDBTimestampNs -> DuckDBTimestampNs -> DuckDBTimestampNs)
-> (DuckDBTimestampNs -> DuckDBTimestampNs -> DuckDBTimestampNs)
-> Ord DuckDBTimestampNs
DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
DuckDBTimestampNs -> DuckDBTimestampNs -> Ordering
DuckDBTimestampNs -> DuckDBTimestampNs -> DuckDBTimestampNs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DuckDBTimestampNs -> DuckDBTimestampNs -> Ordering
compare :: DuckDBTimestampNs -> DuckDBTimestampNs -> Ordering
$c< :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
< :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
$c<= :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
<= :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
$c> :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
> :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
$c>= :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
>= :: DuckDBTimestampNs -> DuckDBTimestampNs -> Bool
$cmax :: DuckDBTimestampNs -> DuckDBTimestampNs -> DuckDBTimestampNs
max :: DuckDBTimestampNs -> DuckDBTimestampNs -> DuckDBTimestampNs
$cmin :: DuckDBTimestampNs -> DuckDBTimestampNs -> DuckDBTimestampNs
min :: DuckDBTimestampNs -> DuckDBTimestampNs -> DuckDBTimestampNs
Ord, Int -> DuckDBTimestampNs -> ShowS
[DuckDBTimestampNs] -> ShowS
DuckDBTimestampNs -> String
(Int -> DuckDBTimestampNs -> ShowS)
-> (DuckDBTimestampNs -> String)
-> ([DuckDBTimestampNs] -> ShowS)
-> Show DuckDBTimestampNs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBTimestampNs -> ShowS
showsPrec :: Int -> DuckDBTimestampNs -> ShowS
$cshow :: DuckDBTimestampNs -> String
show :: DuckDBTimestampNs -> String
$cshowList :: [DuckDBTimestampNs] -> ShowS
showList :: [DuckDBTimestampNs] -> ShowS
Show, Ptr DuckDBTimestampNs -> IO DuckDBTimestampNs
Ptr DuckDBTimestampNs -> Int -> IO DuckDBTimestampNs
Ptr DuckDBTimestampNs -> Int -> DuckDBTimestampNs -> IO ()
Ptr DuckDBTimestampNs -> DuckDBTimestampNs -> IO ()
DuckDBTimestampNs -> Int
(DuckDBTimestampNs -> Int)
-> (DuckDBTimestampNs -> Int)
-> (Ptr DuckDBTimestampNs -> Int -> IO DuckDBTimestampNs)
-> (Ptr DuckDBTimestampNs -> Int -> DuckDBTimestampNs -> IO ())
-> (forall b. Ptr b -> Int -> IO DuckDBTimestampNs)
-> (forall b. Ptr b -> Int -> DuckDBTimestampNs -> IO ())
-> (Ptr DuckDBTimestampNs -> IO DuckDBTimestampNs)
-> (Ptr DuckDBTimestampNs -> DuckDBTimestampNs -> IO ())
-> Storable DuckDBTimestampNs
forall b. Ptr b -> Int -> IO DuckDBTimestampNs
forall b. Ptr b -> Int -> DuckDBTimestampNs -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: DuckDBTimestampNs -> Int
sizeOf :: DuckDBTimestampNs -> Int
$calignment :: DuckDBTimestampNs -> Int
alignment :: DuckDBTimestampNs -> Int
$cpeekElemOff :: Ptr DuckDBTimestampNs -> Int -> IO DuckDBTimestampNs
peekElemOff :: Ptr DuckDBTimestampNs -> Int -> IO DuckDBTimestampNs
$cpokeElemOff :: Ptr DuckDBTimestampNs -> Int -> DuckDBTimestampNs -> IO ()
pokeElemOff :: Ptr DuckDBTimestampNs -> Int -> DuckDBTimestampNs -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimestampNs
peekByteOff :: forall b. Ptr b -> Int -> IO DuckDBTimestampNs
$cpokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimestampNs -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DuckDBTimestampNs -> IO ()
$cpeek :: Ptr DuckDBTimestampNs -> IO DuckDBTimestampNs
peek :: Ptr DuckDBTimestampNs -> IO DuckDBTimestampNs
$cpoke :: Ptr DuckDBTimestampNs -> DuckDBTimestampNs -> IO ()
poke :: Ptr DuckDBTimestampNs -> DuckDBTimestampNs -> IO ()
Storable)

-- | Represents DuckDB's @duckdb_interval@.
data DuckDBInterval = DuckDBInterval
    { DuckDBInterval -> Int32
duckDBIntervalMonths :: !Int32
    , DuckDBInterval -> Int32
duckDBIntervalDays :: !Int32
    , DuckDBInterval -> Int64
duckDBIntervalMicros :: !Int64
    }
    deriving (DuckDBInterval -> DuckDBInterval -> Bool
(DuckDBInterval -> DuckDBInterval -> Bool)
-> (DuckDBInterval -> DuckDBInterval -> Bool) -> Eq DuckDBInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBInterval -> DuckDBInterval -> Bool
== :: DuckDBInterval -> DuckDBInterval -> Bool
$c/= :: DuckDBInterval -> DuckDBInterval -> Bool
/= :: DuckDBInterval -> DuckDBInterval -> Bool
Eq, Int -> DuckDBInterval -> ShowS
[DuckDBInterval] -> ShowS
DuckDBInterval -> String
(Int -> DuckDBInterval -> ShowS)
-> (DuckDBInterval -> String)
-> ([DuckDBInterval] -> ShowS)
-> Show DuckDBInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBInterval -> ShowS
showsPrec :: Int -> DuckDBInterval -> ShowS
$cshow :: DuckDBInterval -> String
show :: DuckDBInterval -> String
$cshowList :: [DuckDBInterval] -> ShowS
showList :: [DuckDBInterval] -> ShowS
Show)

instance Storable DuckDBInterval where
    sizeOf :: DuckDBInterval -> Int
sizeOf DuckDBInterval
_ = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int64 -> Int
forall a. Storable a => a -> Int
sizeOf (Int64
forall a. HasCallStack => a
undefined :: Int64)
    alignment :: DuckDBInterval -> Int
alignment DuckDBInterval
_ = Int64 -> Int
forall a. Storable a => a -> Int
alignment (Int64
forall a. HasCallStack => a
undefined :: Int64)
    peek :: Ptr DuckDBInterval -> IO DuckDBInterval
peek Ptr DuckDBInterval
ptr = do
        Int32
months <- Ptr DuckDBInterval -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBInterval
ptr Int
0
        Int32
days <- Ptr DuckDBInterval -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBInterval
ptr (Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32))
        Int64
micros <- Ptr DuckDBInterval -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBInterval
ptr (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32))
        DuckDBInterval -> IO DuckDBInterval
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Int32 -> Int64 -> DuckDBInterval
DuckDBInterval Int32
months Int32
days Int64
micros)
    poke :: Ptr DuckDBInterval -> DuckDBInterval -> IO ()
poke Ptr DuckDBInterval
ptr (DuckDBInterval Int32
months Int32
days Int64
micros) = do
        Ptr DuckDBInterval -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBInterval
ptr Int
0 Int32
months
        Ptr DuckDBInterval -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBInterval
ptr (Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32)) Int32
days
        Ptr DuckDBInterval -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBInterval
ptr (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32)) Int64
micros

-- | Represents DuckDB's @duckdb_hugeint@.
data DuckDBHugeInt = DuckDBHugeInt
    { DuckDBHugeInt -> Word64
duckDBHugeIntLower :: !Word64
    , DuckDBHugeInt -> Int64
duckDBHugeIntUpper :: !Int64
    }
    deriving (DuckDBHugeInt -> DuckDBHugeInt -> Bool
(DuckDBHugeInt -> DuckDBHugeInt -> Bool)
-> (DuckDBHugeInt -> DuckDBHugeInt -> Bool) -> Eq DuckDBHugeInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBHugeInt -> DuckDBHugeInt -> Bool
== :: DuckDBHugeInt -> DuckDBHugeInt -> Bool
$c/= :: DuckDBHugeInt -> DuckDBHugeInt -> Bool
/= :: DuckDBHugeInt -> DuckDBHugeInt -> Bool
Eq, Int -> DuckDBHugeInt -> ShowS
[DuckDBHugeInt] -> ShowS
DuckDBHugeInt -> String
(Int -> DuckDBHugeInt -> ShowS)
-> (DuckDBHugeInt -> String)
-> ([DuckDBHugeInt] -> ShowS)
-> Show DuckDBHugeInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBHugeInt -> ShowS
showsPrec :: Int -> DuckDBHugeInt -> ShowS
$cshow :: DuckDBHugeInt -> String
show :: DuckDBHugeInt -> String
$cshowList :: [DuckDBHugeInt] -> ShowS
showList :: [DuckDBHugeInt] -> ShowS
Show)

instance Storable DuckDBHugeInt where
    sizeOf :: DuckDBHugeInt -> Int
sizeOf DuckDBHugeInt
_ = Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int64 -> Int
forall a. Storable a => a -> Int
sizeOf (Int64
forall a. HasCallStack => a
undefined :: Int64)
    alignment :: DuckDBHugeInt -> Int
alignment DuckDBHugeInt
_ = Word64 -> Int
forall a. Storable a => a -> Int
alignment (Word64
forall a. HasCallStack => a
undefined :: Word64)
    peek :: Ptr DuckDBHugeInt -> IO DuckDBHugeInt
peek Ptr DuckDBHugeInt
ptr = do
        Word64
lower <- Ptr DuckDBHugeInt -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBHugeInt
ptr Int
0
        Int64
upper <- Ptr DuckDBHugeInt -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBHugeInt
ptr (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64))
        DuckDBHugeInt -> IO DuckDBHugeInt
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Int64 -> DuckDBHugeInt
DuckDBHugeInt Word64
lower Int64
upper)
    poke :: Ptr DuckDBHugeInt -> DuckDBHugeInt -> IO ()
poke Ptr DuckDBHugeInt
ptr (DuckDBHugeInt Word64
lower Int64
upper) = do
        Ptr DuckDBHugeInt -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBHugeInt
ptr Int
0 Word64
lower
        Ptr DuckDBHugeInt -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBHugeInt
ptr (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64)) Int64
upper

-- | Represents DuckDB's @duckdb_uhugeint@.
data DuckDBUHugeInt = DuckDBUHugeInt
    { DuckDBUHugeInt -> Word64
duckDBUHugeIntLower :: !Word64
    , DuckDBUHugeInt -> Word64
duckDBUHugeIntUpper :: !Word64
    }
    deriving (DuckDBUHugeInt -> DuckDBUHugeInt -> Bool
(DuckDBUHugeInt -> DuckDBUHugeInt -> Bool)
-> (DuckDBUHugeInt -> DuckDBUHugeInt -> Bool) -> Eq DuckDBUHugeInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBUHugeInt -> DuckDBUHugeInt -> Bool
== :: DuckDBUHugeInt -> DuckDBUHugeInt -> Bool
$c/= :: DuckDBUHugeInt -> DuckDBUHugeInt -> Bool
/= :: DuckDBUHugeInt -> DuckDBUHugeInt -> Bool
Eq, Int -> DuckDBUHugeInt -> ShowS
[DuckDBUHugeInt] -> ShowS
DuckDBUHugeInt -> String
(Int -> DuckDBUHugeInt -> ShowS)
-> (DuckDBUHugeInt -> String)
-> ([DuckDBUHugeInt] -> ShowS)
-> Show DuckDBUHugeInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBUHugeInt -> ShowS
showsPrec :: Int -> DuckDBUHugeInt -> ShowS
$cshow :: DuckDBUHugeInt -> String
show :: DuckDBUHugeInt -> String
$cshowList :: [DuckDBUHugeInt] -> ShowS
showList :: [DuckDBUHugeInt] -> ShowS
Show)

instance Storable DuckDBUHugeInt where
    sizeOf :: DuckDBUHugeInt -> Int
sizeOf DuckDBUHugeInt
_ = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64)
    alignment :: DuckDBUHugeInt -> Int
alignment DuckDBUHugeInt
_ = Word64 -> Int
forall a. Storable a => a -> Int
alignment (Word64
forall a. HasCallStack => a
undefined :: Word64)
    peek :: Ptr DuckDBUHugeInt -> IO DuckDBUHugeInt
peek Ptr DuckDBUHugeInt
ptr = do
        Word64
lower <- Ptr DuckDBUHugeInt -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBUHugeInt
ptr Int
0
        Word64
upper <- Ptr DuckDBUHugeInt -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBUHugeInt
ptr (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64))
        DuckDBUHugeInt -> IO DuckDBUHugeInt
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Word64 -> DuckDBUHugeInt
DuckDBUHugeInt Word64
lower Word64
upper)
    poke :: Ptr DuckDBUHugeInt -> DuckDBUHugeInt -> IO ()
poke Ptr DuckDBUHugeInt
ptr (DuckDBUHugeInt Word64
lower Word64
upper) = do
        Ptr DuckDBUHugeInt -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBUHugeInt
ptr Int
0 Word64
lower
        Ptr DuckDBUHugeInt -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBUHugeInt
ptr (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64)) Word64
upper

-- | Represents DuckDB's @duckdb_decimal@.
data DuckDBDecimal = DuckDBDecimal
    { DuckDBDecimal -> Word8
duckDBDecimalWidth :: !Word8
    , DuckDBDecimal -> Word8
duckDBDecimalScale :: !Word8
    , DuckDBDecimal -> DuckDBHugeInt
duckDBDecimalValue :: !DuckDBHugeInt
    }
    deriving (DuckDBDecimal -> DuckDBDecimal -> Bool
(DuckDBDecimal -> DuckDBDecimal -> Bool)
-> (DuckDBDecimal -> DuckDBDecimal -> Bool) -> Eq DuckDBDecimal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBDecimal -> DuckDBDecimal -> Bool
== :: DuckDBDecimal -> DuckDBDecimal -> Bool
$c/= :: DuckDBDecimal -> DuckDBDecimal -> Bool
/= :: DuckDBDecimal -> DuckDBDecimal -> Bool
Eq, Int -> DuckDBDecimal -> ShowS
[DuckDBDecimal] -> ShowS
DuckDBDecimal -> String
(Int -> DuckDBDecimal -> ShowS)
-> (DuckDBDecimal -> String)
-> ([DuckDBDecimal] -> ShowS)
-> Show DuckDBDecimal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBDecimal -> ShowS
showsPrec :: Int -> DuckDBDecimal -> ShowS
$cshow :: DuckDBDecimal -> String
show :: DuckDBDecimal -> String
$cshowList :: [DuckDBDecimal] -> ShowS
showList :: [DuckDBDecimal] -> ShowS
Show)

instance Storable DuckDBDecimal where
    sizeOf :: DuckDBDecimal -> Int
sizeOf DuckDBDecimal
_ = Int
valueOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DuckDBHugeInt -> Int
forall a. Storable a => a -> Int
sizeOf (DuckDBHugeInt
forall a. HasCallStack => a
undefined :: DuckDBHugeInt)
      where
        alignHuge :: Int
alignHuge = DuckDBHugeInt -> Int
forall a. Storable a => a -> Int
alignment (DuckDBHugeInt
forall a. HasCallStack => a
undefined :: DuckDBHugeInt)
        valueOffset :: Int
valueOffset = ((Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alignHuge Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
alignHuge) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
alignHuge
    alignment :: DuckDBDecimal -> Int
alignment DuckDBDecimal
_ = DuckDBHugeInt -> Int
forall a. Storable a => a -> Int
alignment (DuckDBHugeInt
forall a. HasCallStack => a
undefined :: DuckDBHugeInt)
    peek :: Ptr DuckDBDecimal -> IO DuckDBDecimal
peek Ptr DuckDBDecimal
ptr = do
        Word8
width <- Ptr DuckDBDecimal -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBDecimal
ptr Int
0
        Word8
scale <- Ptr DuckDBDecimal -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBDecimal
ptr Int
1
        let alignHuge :: Int
alignHuge = DuckDBHugeInt -> Int
forall a. Storable a => a -> Int
alignment (DuckDBHugeInt
forall a. HasCallStack => a
undefined :: DuckDBHugeInt)
            valueOffset :: Int
valueOffset = ((Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alignHuge Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
alignHuge) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
alignHuge
        DuckDBHugeInt
value <- Ptr DuckDBDecimal -> Int -> IO DuckDBHugeInt
forall b. Ptr b -> Int -> IO DuckDBHugeInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBDecimal
ptr Int
valueOffset
        DuckDBDecimal -> IO DuckDBDecimal
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Word8 -> DuckDBHugeInt -> DuckDBDecimal
DuckDBDecimal Word8
width Word8
scale DuckDBHugeInt
value)
    poke :: Ptr DuckDBDecimal -> DuckDBDecimal -> IO ()
poke Ptr DuckDBDecimal
ptr (DuckDBDecimal Word8
width Word8
scale DuckDBHugeInt
value) = do
        Ptr DuckDBDecimal -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBDecimal
ptr Int
0 Word8
width
        Ptr DuckDBDecimal -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBDecimal
ptr Int
1 Word8
scale
        let alignHuge :: Int
alignHuge = DuckDBHugeInt -> Int
forall a. Storable a => a -> Int
alignment (DuckDBHugeInt
forall a. HasCallStack => a
undefined :: DuckDBHugeInt)
            valueOffset :: Int
valueOffset = ((Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alignHuge Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
alignHuge) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
alignHuge
        Ptr DuckDBDecimal -> Int -> DuckDBHugeInt -> IO ()
forall b. Ptr b -> Int -> DuckDBHugeInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBDecimal
ptr Int
valueOffset DuckDBHugeInt
value

-- | Represents DuckDB's @duckdb_blob@.
data DuckDBBlob = DuckDBBlob
    { DuckDBBlob -> Ptr ()
duckDBBlobData :: !(Ptr ())
    , DuckDBBlob -> Word64
duckDBBlobSize :: !DuckDBIdx
    }
    deriving (DuckDBBlob -> DuckDBBlob -> Bool
(DuckDBBlob -> DuckDBBlob -> Bool)
-> (DuckDBBlob -> DuckDBBlob -> Bool) -> Eq DuckDBBlob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBBlob -> DuckDBBlob -> Bool
== :: DuckDBBlob -> DuckDBBlob -> Bool
$c/= :: DuckDBBlob -> DuckDBBlob -> Bool
/= :: DuckDBBlob -> DuckDBBlob -> Bool
Eq, Int -> DuckDBBlob -> ShowS
[DuckDBBlob] -> ShowS
DuckDBBlob -> String
(Int -> DuckDBBlob -> ShowS)
-> (DuckDBBlob -> String)
-> ([DuckDBBlob] -> ShowS)
-> Show DuckDBBlob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBBlob -> ShowS
showsPrec :: Int -> DuckDBBlob -> ShowS
$cshow :: DuckDBBlob -> String
show :: DuckDBBlob -> String
$cshowList :: [DuckDBBlob] -> ShowS
showList :: [DuckDBBlob] -> ShowS
Show)

instance Storable DuckDBBlob where
    sizeOf :: DuckDBBlob -> Int
sizeOf DuckDBBlob
_ = Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ()) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)
    alignment :: DuckDBBlob -> Int
alignment DuckDBBlob
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())
    peek :: Ptr DuckDBBlob -> IO DuckDBBlob
peek Ptr DuckDBBlob
ptr = do
        Ptr ()
dat <- Ptr DuckDBBlob -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBBlob
ptr Int
0
        Word64
len <- Ptr DuckDBBlob -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBBlob
ptr (Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ()))
        DuckDBBlob -> IO DuckDBBlob
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr () -> Word64 -> DuckDBBlob
DuckDBBlob Ptr ()
dat Word64
len)
    poke :: Ptr DuckDBBlob -> DuckDBBlob -> IO ()
poke Ptr DuckDBBlob
ptr (DuckDBBlob Ptr ()
dat Word64
len) = do
        Ptr DuckDBBlob -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBBlob
ptr Int
0 Ptr ()
dat
        Ptr DuckDBBlob -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBBlob
ptr (Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())) Word64
len

-- | Represents DuckDB's @duckdb_string@.
data DuckDBString = DuckDBString
    { DuckDBString -> Ptr CChar
duckDBStringData :: !(Ptr CChar)
    , DuckDBString -> Word64
duckDBStringSize :: !DuckDBIdx
    }
    deriving (DuckDBString -> DuckDBString -> Bool
(DuckDBString -> DuckDBString -> Bool)
-> (DuckDBString -> DuckDBString -> Bool) -> Eq DuckDBString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBString -> DuckDBString -> Bool
== :: DuckDBString -> DuckDBString -> Bool
$c/= :: DuckDBString -> DuckDBString -> Bool
/= :: DuckDBString -> DuckDBString -> Bool
Eq, Int -> DuckDBString -> ShowS
[DuckDBString] -> ShowS
DuckDBString -> String
(Int -> DuckDBString -> ShowS)
-> (DuckDBString -> String)
-> ([DuckDBString] -> ShowS)
-> Show DuckDBString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBString -> ShowS
showsPrec :: Int -> DuckDBString -> ShowS
$cshow :: DuckDBString -> String
show :: DuckDBString -> String
$cshowList :: [DuckDBString] -> ShowS
showList :: [DuckDBString] -> ShowS
Show)

instance Storable DuckDBString where
    sizeOf :: DuckDBString -> Int
sizeOf DuckDBString
_ = Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CChar
forall a. HasCallStack => a
undefined :: Ptr CChar) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)
    alignment :: DuckDBString -> Int
alignment DuckDBString
_ = Ptr CChar -> Int
forall a. Storable a => a -> Int
alignment (Ptr CChar
forall a. HasCallStack => a
undefined :: Ptr CChar)
    peek :: Ptr DuckDBString -> IO DuckDBString
peek Ptr DuckDBString
ptr = do
        Ptr CChar
dat <- Ptr DuckDBString -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBString
ptr Int
0
        Word64
len <- Ptr DuckDBString -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBString
ptr (Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CChar
forall a. HasCallStack => a
undefined :: Ptr CChar))
        DuckDBString -> IO DuckDBString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr CChar -> Word64 -> DuckDBString
DuckDBString Ptr CChar
dat Word64
len)
    poke :: Ptr DuckDBString -> DuckDBString -> IO ()
poke Ptr DuckDBString
ptr (DuckDBString Ptr CChar
dat Word64
len) = do
        Ptr DuckDBString -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBString
ptr Int
0 Ptr CChar
dat
        Ptr DuckDBString -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBString
ptr (Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CChar
forall a. HasCallStack => a
undefined :: Ptr CChar)) Word64
len

-- | Represents DuckDB's @duckdb_string_t@.
data DuckDBStringT

-- | Represents DuckDB's @duckdb_bit@.
data DuckDBBit = DuckDBBit
    { DuckDBBit -> Ptr Word8
duckDBBitData :: !(Ptr Word8)
    , DuckDBBit -> Word64
duckDBBitSize :: !DuckDBIdx
    }
    deriving (DuckDBBit -> DuckDBBit -> Bool
(DuckDBBit -> DuckDBBit -> Bool)
-> (DuckDBBit -> DuckDBBit -> Bool) -> Eq DuckDBBit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBBit -> DuckDBBit -> Bool
== :: DuckDBBit -> DuckDBBit -> Bool
$c/= :: DuckDBBit -> DuckDBBit -> Bool
/= :: DuckDBBit -> DuckDBBit -> Bool
Eq, Int -> DuckDBBit -> ShowS
[DuckDBBit] -> ShowS
DuckDBBit -> String
(Int -> DuckDBBit -> ShowS)
-> (DuckDBBit -> String)
-> ([DuckDBBit] -> ShowS)
-> Show DuckDBBit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBBit -> ShowS
showsPrec :: Int -> DuckDBBit -> ShowS
$cshow :: DuckDBBit -> String
show :: DuckDBBit -> String
$cshowList :: [DuckDBBit] -> ShowS
showList :: [DuckDBBit] -> ShowS
Show)

instance Storable DuckDBBit where
    sizeOf :: DuckDBBit -> Int
sizeOf DuckDBBit
_ = Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)
    alignment :: DuckDBBit -> Int
alignment DuckDBBit
_ = Ptr Word8 -> Int
forall a. Storable a => a -> Int
alignment (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8)
    peek :: Ptr DuckDBBit -> IO DuckDBBit
peek Ptr DuckDBBit
ptr = do
        Ptr Word8
dat <- Ptr DuckDBBit -> Int -> IO (Ptr Word8)
forall b. Ptr b -> Int -> IO (Ptr Word8)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBBit
ptr Int
0
        Word64
len <- Ptr DuckDBBit -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBBit
ptr (Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8))
        DuckDBBit -> IO DuckDBBit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> Word64 -> DuckDBBit
DuckDBBit Ptr Word8
dat Word64
len)
    poke :: Ptr DuckDBBit -> DuckDBBit -> IO ()
poke Ptr DuckDBBit
ptr (DuckDBBit Ptr Word8
dat Word64
len) = do
        Ptr DuckDBBit -> Int -> Ptr Word8 -> IO ()
forall b. Ptr b -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBBit
ptr Int
0 Ptr Word8
dat
        Ptr DuckDBBit -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBBit
ptr (Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8)) Word64
len

-- | Represents DuckDB's @duckdb_bignum@.
data DuckDBBignum = DuckDBBignum
    { DuckDBBignum -> Ptr Word8
duckDBBignumData :: !(Ptr Word8)
    , DuckDBBignum -> Word64
duckDBBignumSize :: !DuckDBIdx
    , DuckDBBignum -> CBool
duckDBBignumIsNegative :: !CBool
    }
    deriving (DuckDBBignum -> DuckDBBignum -> Bool
(DuckDBBignum -> DuckDBBignum -> Bool)
-> (DuckDBBignum -> DuckDBBignum -> Bool) -> Eq DuckDBBignum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBBignum -> DuckDBBignum -> Bool
== :: DuckDBBignum -> DuckDBBignum -> Bool
$c/= :: DuckDBBignum -> DuckDBBignum -> Bool
/= :: DuckDBBignum -> DuckDBBignum -> Bool
Eq, Int -> DuckDBBignum -> ShowS
[DuckDBBignum] -> ShowS
DuckDBBignum -> String
(Int -> DuckDBBignum -> ShowS)
-> (DuckDBBignum -> String)
-> ([DuckDBBignum] -> ShowS)
-> Show DuckDBBignum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBBignum -> ShowS
showsPrec :: Int -> DuckDBBignum -> ShowS
$cshow :: DuckDBBignum -> String
show :: DuckDBBignum -> String
$cshowList :: [DuckDBBignum] -> ShowS
showList :: [DuckDBBignum] -> ShowS
Show)

instance Storable DuckDBBignum where
    sizeOf :: DuckDBBignum -> Int
sizeOf DuckDBBignum
_ = Int
alignedSize
      where
        baseSize :: Int
baseSize = Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CBool -> Int
forall a. Storable a => a -> Int
sizeOf (CBool
forall a. HasCallStack => a
undefined :: CBool)
        align :: Int
align = Ptr Word8 -> Int
forall a. Storable a => a -> Int
alignment (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8)
        alignedSize :: Int
alignedSize = ((Int
baseSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
align Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
align) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
align
    alignment :: DuckDBBignum -> Int
alignment DuckDBBignum
_ = Ptr Word8 -> Int
forall a. Storable a => a -> Int
alignment (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8)
    peek :: Ptr DuckDBBignum -> IO DuckDBBignum
peek Ptr DuckDBBignum
ptr = do
        Ptr Word8
dat <- Ptr DuckDBBignum -> Int -> IO (Ptr Word8)
forall b. Ptr b -> Int -> IO (Ptr Word8)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBBignum
ptr Int
0
        Word64
len <- Ptr DuckDBBignum -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBBignum
ptr (Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8))
        CBool
isNeg <- Ptr DuckDBBignum -> Int -> IO CBool
forall b. Ptr b -> Int -> IO CBool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBBignum
ptr (Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx))
        DuckDBBignum -> IO DuckDBBignum
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> Word64 -> CBool -> DuckDBBignum
DuckDBBignum Ptr Word8
dat Word64
len CBool
isNeg)
    poke :: Ptr DuckDBBignum -> DuckDBBignum -> IO ()
poke Ptr DuckDBBignum
ptr (DuckDBBignum Ptr Word8
dat Word64
len CBool
isNeg) = do
        Ptr DuckDBBignum -> Int -> Ptr Word8 -> IO ()
forall b. Ptr b -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBBignum
ptr Int
0 Ptr Word8
dat
        Ptr DuckDBBignum -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBBignum
ptr (Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8)) Word64
len
        Ptr DuckDBBignum -> Int -> CBool -> IO ()
forall b. Ptr b -> Int -> CBool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBBignum
ptr (Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)) CBool
isNeg

-- | Represents DuckDB's @duckdb_query_progress_type@.
data DuckDBQueryProgress = DuckDBQueryProgress
    { DuckDBQueryProgress -> Double
duckDBQueryProgressPercentage :: !Double
    , DuckDBQueryProgress -> Word64
duckDBQueryProgressRowsProcessed :: !Word64
    , DuckDBQueryProgress -> Word64
duckDBQueryProgressTotalRows :: !Word64
    }
    deriving (DuckDBQueryProgress -> DuckDBQueryProgress -> Bool
(DuckDBQueryProgress -> DuckDBQueryProgress -> Bool)
-> (DuckDBQueryProgress -> DuckDBQueryProgress -> Bool)
-> Eq DuckDBQueryProgress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuckDBQueryProgress -> DuckDBQueryProgress -> Bool
== :: DuckDBQueryProgress -> DuckDBQueryProgress -> Bool
$c/= :: DuckDBQueryProgress -> DuckDBQueryProgress -> Bool
/= :: DuckDBQueryProgress -> DuckDBQueryProgress -> Bool
Eq, Int -> DuckDBQueryProgress -> ShowS
[DuckDBQueryProgress] -> ShowS
DuckDBQueryProgress -> String
(Int -> DuckDBQueryProgress -> ShowS)
-> (DuckDBQueryProgress -> String)
-> ([DuckDBQueryProgress] -> ShowS)
-> Show DuckDBQueryProgress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuckDBQueryProgress -> ShowS
showsPrec :: Int -> DuckDBQueryProgress -> ShowS
$cshow :: DuckDBQueryProgress -> String
show :: DuckDBQueryProgress -> String
$cshowList :: [DuckDBQueryProgress] -> ShowS
showList :: [DuckDBQueryProgress] -> ShowS
Show)

instance Storable DuckDBQueryProgress where
    sizeOf :: DuckDBQueryProgress -> Int
sizeOf DuckDBQueryProgress
_ = CDouble -> Int
forall a. Storable a => a -> Int
sizeOf (CDouble
forall a. HasCallStack => a
undefined :: CDouble) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64)
    alignment :: DuckDBQueryProgress -> Int
alignment DuckDBQueryProgress
_ = CDouble -> Int
forall a. Storable a => a -> Int
alignment (CDouble
forall a. HasCallStack => a
undefined :: CDouble)
    peek :: Ptr DuckDBQueryProgress -> IO DuckDBQueryProgress
peek Ptr DuckDBQueryProgress
ptr = do
        Double
percentage <- CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr DuckDBQueryProgress -> Int -> IO CDouble
forall b. Ptr b -> Int -> IO CDouble
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBQueryProgress
ptr Int
0 :: IO CDouble)
        let offset1 :: Int
offset1 = CDouble -> Int
forall a. Storable a => a -> Int
sizeOf (CDouble
forall a. HasCallStack => a
undefined :: CDouble)
            offset2 :: Int
offset2 = Int
offset1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64)
        Word64
processed <- Ptr DuckDBQueryProgress -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBQueryProgress
ptr Int
offset1
        Word64
total <- Ptr DuckDBQueryProgress -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBQueryProgress
ptr Int
offset2
        DuckDBQueryProgress -> IO DuckDBQueryProgress
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Word64 -> Word64 -> DuckDBQueryProgress
DuckDBQueryProgress Double
percentage Word64
processed Word64
total)
    poke :: Ptr DuckDBQueryProgress -> DuckDBQueryProgress -> IO ()
poke Ptr DuckDBQueryProgress
ptr (DuckDBQueryProgress Double
percentage Word64
processed Word64
total) = do
        Ptr DuckDBQueryProgress -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBQueryProgress
ptr Int
0 (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
percentage :: CDouble)
        let offset1 :: Int
offset1 = CDouble -> Int
forall a. Storable a => a -> Int
sizeOf (CDouble
forall a. HasCallStack => a
undefined :: CDouble)
            offset2 :: Int
offset2 = Int
offset1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64)
        Ptr DuckDBQueryProgress -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBQueryProgress
ptr Int
offset1 Word64
processed
        Ptr DuckDBQueryProgress -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBQueryProgress
ptr Int
offset2 Word64
total

-- | Opaque DuckDB column handle.
data DuckDBColumn

-- | DuckDB result structure (opaque to callers, but required for FFI marshalling).
data DuckDBResult = DuckDBResult
    { DuckDBResult -> Word64
duckDBResultDeprecatedColumnCount :: !DuckDBIdx
    , DuckDBResult -> Word64
duckDBResultDeprecatedRowCount :: !DuckDBIdx
    , DuckDBResult -> Word64
duckDBResultDeprecatedRowsChanged :: !DuckDBIdx
    , DuckDBResult -> Ptr DuckDBColumn
duckDBResultDeprecatedColumns :: !(Ptr DuckDBColumn)
    , DuckDBResult -> Ptr CChar
duckDBResultDeprecatedErrorMessage :: !CString
    , DuckDBResult -> Ptr ()
duckDBResultInternalData :: !(Ptr ())
    }

instance Storable DuckDBResult where
    sizeOf :: DuckDBResult -> Int
sizeOf DuckDBResult
_ = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())
    alignment :: DuckDBResult -> Int
alignment DuckDBResult
_ = Word64 -> Int
forall a. Storable a => a -> Int
alignment (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)
    peek :: Ptr DuckDBResult -> IO DuckDBResult
peek Ptr DuckDBResult
ptr = do
        Word64
colCount <- Ptr DuckDBResult -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBResult
ptr Int
0
        Word64
rowCount <- Ptr DuckDBResult -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBResult
ptr (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx))
        Word64
rowsChanged <- Ptr DuckDBResult -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBResult
ptr (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx))
        let basePtr :: Int
basePtr = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)
        Ptr DuckDBColumn
columns <- Ptr DuckDBResult -> Int -> IO (Ptr DuckDBColumn)
forall b. Ptr b -> Int -> IO (Ptr DuckDBColumn)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBResult
ptr Int
basePtr
        Ptr CChar
errMsg <- Ptr DuckDBResult -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBResult
ptr (Int
basePtr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ()))
        Ptr ()
internal <- Ptr DuckDBResult -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBResult
ptr (Int
basePtr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ()))
        DuckDBResult -> IO DuckDBResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            DuckDBResult
                { $sel:duckDBResultDeprecatedColumnCount:DuckDBResult :: Word64
duckDBResultDeprecatedColumnCount = Word64
colCount
                , $sel:duckDBResultDeprecatedRowCount:DuckDBResult :: Word64
duckDBResultDeprecatedRowCount = Word64
rowCount
                , $sel:duckDBResultDeprecatedRowsChanged:DuckDBResult :: Word64
duckDBResultDeprecatedRowsChanged = Word64
rowsChanged
                , $sel:duckDBResultDeprecatedColumns:DuckDBResult :: Ptr DuckDBColumn
duckDBResultDeprecatedColumns = Ptr DuckDBColumn
columns
                , $sel:duckDBResultDeprecatedErrorMessage:DuckDBResult :: Ptr CChar
duckDBResultDeprecatedErrorMessage = Ptr CChar
errMsg
                , $sel:duckDBResultInternalData:DuckDBResult :: Ptr ()
duckDBResultInternalData = Ptr ()
internal
                }
    poke :: Ptr DuckDBResult -> DuckDBResult -> IO ()
poke Ptr DuckDBResult
ptr DuckDBResult
result = do
        let columnCount :: Word64
columnCount = DuckDBResult -> Word64
duckDBResultDeprecatedColumnCount DuckDBResult
result
            rowCount :: Word64
rowCount = DuckDBResult -> Word64
duckDBResultDeprecatedRowCount DuckDBResult
result
            rowsChanged :: Word64
rowsChanged = DuckDBResult -> Word64
duckDBResultDeprecatedRowsChanged DuckDBResult
result
            columns :: Ptr DuckDBColumn
columns = DuckDBResult -> Ptr DuckDBColumn
duckDBResultDeprecatedColumns DuckDBResult
result
            errorMessage :: Ptr CChar
errorMessage = DuckDBResult -> Ptr CChar
duckDBResultDeprecatedErrorMessage DuckDBResult
result
            internalData :: Ptr ()
internalData = DuckDBResult -> Ptr ()
duckDBResultInternalData DuckDBResult
result
            basePtr :: Int
basePtr = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)
        Ptr DuckDBResult -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBResult
ptr Int
0 Word64
columnCount
        Ptr DuckDBResult -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBResult
ptr (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)) Word64
rowCount
        Ptr DuckDBResult -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBResult
ptr (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: DuckDBIdx)) Word64
rowsChanged
        Ptr DuckDBResult -> Int -> Ptr DuckDBColumn -> IO ()
forall b. Ptr b -> Int -> Ptr DuckDBColumn -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBResult
ptr Int
basePtr Ptr DuckDBColumn
columns
        Ptr DuckDBResult -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBResult
ptr (Int
basePtr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())) Ptr CChar
errorMessage
        Ptr DuckDBResult -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBResult
ptr (Int
basePtr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())) Ptr ()
internalData

-- | Tag type backing @duckdb_database@ pointers.
data DuckDBDatabaseStruct

-- | Handle to a DuckDB database instance.
type DuckDBDatabase = Ptr DuckDBDatabaseStruct

-- | Tag type backing @duckdb_connection@ pointers.
data DuckDBConnectionStruct

-- | Handle to a DuckDB connection.
type DuckDBConnection = Ptr DuckDBConnectionStruct

-- | Tag type backing @duckdb_config@ pointers.
data DuckDBConfigStruct

-- | Handle to a DuckDB configuration object.
type DuckDBConfig = Ptr DuckDBConfigStruct

-- | Tag type backing @duckdb_instance_cache@ pointers.
data DuckDBInstanceCacheStruct

-- | Handle to a DuckDB instance cache.
type DuckDBInstanceCache = Ptr DuckDBInstanceCacheStruct

-- | Tag type backing @duckdb_extracted_statements@ pointers.
data DuckDBExtractedStatementsStruct

-- | Handle to extracted SQL statements.
type DuckDBExtractedStatements = Ptr DuckDBExtractedStatementsStruct

-- | Tag type backing @duckdb_function_info@ pointers.
data DuckDBFunctionInfoStruct

-- | Handle to function execution context.
type DuckDBFunctionInfo = Ptr DuckDBFunctionInfoStruct

-- | Tag type backing @duckdb_bind_info@ pointers.
data DuckDBBindInfoStruct

-- | Handle to scalar function bind context.
type DuckDBBindInfo = Ptr DuckDBBindInfoStruct

-- | Tag type backing @duckdb_scalar_function@ pointers.
data DuckDBScalarFunctionStruct

-- | Handle to a scalar function definition.
type DuckDBScalarFunction = Ptr DuckDBScalarFunctionStruct

-- | Tag type backing @duckdb_scalar_function_set@ pointers.
data DuckDBScalarFunctionSetStruct

-- | Handle to a set of scalar function overloads.
type DuckDBScalarFunctionSet = Ptr DuckDBScalarFunctionSetStruct

-- | Tag type backing @duckdb_aggregate_function@ pointers.
data DuckDBAggregateFunctionStruct

-- | Handle to an aggregate function definition.
type DuckDBAggregateFunction = Ptr DuckDBAggregateFunctionStruct

-- | Tag type backing @duckdb_aggregate_function_set@ pointers.
data DuckDBAggregateFunctionSetStruct

-- | Handle to an aggregate function set.
type DuckDBAggregateFunctionSet = Ptr DuckDBAggregateFunctionSetStruct

-- | Tag type backing @duckdb_vector@ pointers.
data DuckDBVectorStruct

-- | Handle to a DuckDB vector.
type DuckDBVector = Ptr DuckDBVectorStruct

-- | Tag type backing @duckdb_data_chunk@ pointers.
data DuckDBDataChunkStruct

-- | Handle to a DuckDB data chunk.
type DuckDBDataChunk = Ptr DuckDBDataChunkStruct

-- | Tag type backing @duckdb_selection_vector@ pointers.
data DuckDBSelectionVectorStruct

-- | Handle to a DuckDB selection vector.
type DuckDBSelectionVector = Ptr DuckDBSelectionVectorStruct

-- | Tag type backing @duckdb_arrow_options@ pointers.
data DuckDBArrowOptionsStruct

-- | Handle to DuckDB Arrow options.
type DuckDBArrowOptions = Ptr DuckDBArrowOptionsStruct

-- | Tag type backing @duckdb_arrow@ pointers.
newtype DuckDBArrowStruct = DuckDBArrowStruct
    { DuckDBArrowStruct -> Ptr ()
duckdbArrowInternalPtr :: Ptr ()
    }

-- | Handle to an Arrow query result.
type DuckDBArrow = Ptr DuckDBArrowStruct

-- | Tag type backing @duckdb_arrow_schema@ pointers.
newtype DuckDBArrowSchemaStruct = DuckDBArrowSchemaStruct
    { DuckDBArrowSchemaStruct -> Ptr ()
duckdbArrowSchemaInternalPtr :: Ptr ()
    }

-- | Handle to an Arrow schema.
type DuckDBArrowSchema = Ptr DuckDBArrowSchemaStruct

-- | Tag type backing @duckdb_arrow_array@ pointers.
newtype DuckDBArrowArrayStruct = DuckDBArrowArrayStruct
    { DuckDBArrowArrayStruct -> Ptr ()
duckdbArrowArrayInternalPtr :: Ptr ()
    }

-- | Handle to an Arrow array.
type DuckDBArrowArray = Ptr DuckDBArrowArrayStruct

instance Storable DuckDBArrowStruct where
    sizeOf :: DuckDBArrowStruct -> Int
sizeOf DuckDBArrowStruct
_ = Int
pointerSize
    alignment :: DuckDBArrowStruct -> Int
alignment DuckDBArrowStruct
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())
    peek :: Ptr DuckDBArrowStruct -> IO DuckDBArrowStruct
peek Ptr DuckDBArrowStruct
ptr =
        Ptr () -> DuckDBArrowStruct
DuckDBArrowStruct
            (Ptr () -> DuckDBArrowStruct)
-> IO (Ptr ()) -> IO DuckDBArrowStruct
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr DuckDBArrowStruct -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBArrowStruct
ptr Int
0
    poke :: Ptr DuckDBArrowStruct -> DuckDBArrowStruct -> IO ()
poke Ptr DuckDBArrowStruct
ptr DuckDBArrowStruct{Ptr ()
$sel:duckdbArrowInternalPtr:DuckDBArrowStruct :: DuckDBArrowStruct -> Ptr ()
duckdbArrowInternalPtr :: Ptr ()
..} =
        Ptr DuckDBArrowStruct -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBArrowStruct
ptr Int
0 Ptr ()
duckdbArrowInternalPtr

instance Storable DuckDBArrowSchemaStruct where
    sizeOf :: DuckDBArrowSchemaStruct -> Int
sizeOf DuckDBArrowSchemaStruct
_ = Int
pointerSize
    alignment :: DuckDBArrowSchemaStruct -> Int
alignment DuckDBArrowSchemaStruct
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())
    peek :: Ptr DuckDBArrowSchemaStruct -> IO DuckDBArrowSchemaStruct
peek Ptr DuckDBArrowSchemaStruct
ptr =
        Ptr () -> DuckDBArrowSchemaStruct
DuckDBArrowSchemaStruct
            (Ptr () -> DuckDBArrowSchemaStruct)
-> IO (Ptr ()) -> IO DuckDBArrowSchemaStruct
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr DuckDBArrowSchemaStruct -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBArrowSchemaStruct
ptr Int
0
    poke :: Ptr DuckDBArrowSchemaStruct -> DuckDBArrowSchemaStruct -> IO ()
poke Ptr DuckDBArrowSchemaStruct
ptr DuckDBArrowSchemaStruct{Ptr ()
$sel:duckdbArrowSchemaInternalPtr:DuckDBArrowSchemaStruct :: DuckDBArrowSchemaStruct -> Ptr ()
duckdbArrowSchemaInternalPtr :: Ptr ()
..} =
        Ptr DuckDBArrowSchemaStruct -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBArrowSchemaStruct
ptr Int
0 Ptr ()
duckdbArrowSchemaInternalPtr

instance Storable DuckDBArrowArrayStruct where
    sizeOf :: DuckDBArrowArrayStruct -> Int
sizeOf DuckDBArrowArrayStruct
_ = Int
pointerSize
    alignment :: DuckDBArrowArrayStruct -> Int
alignment DuckDBArrowArrayStruct
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())
    peek :: Ptr DuckDBArrowArrayStruct -> IO DuckDBArrowArrayStruct
peek Ptr DuckDBArrowArrayStruct
ptr =
        Ptr () -> DuckDBArrowArrayStruct
DuckDBArrowArrayStruct
            (Ptr () -> DuckDBArrowArrayStruct)
-> IO (Ptr ()) -> IO DuckDBArrowArrayStruct
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr DuckDBArrowArrayStruct -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBArrowArrayStruct
ptr Int
0
    poke :: Ptr DuckDBArrowArrayStruct -> DuckDBArrowArrayStruct -> IO ()
poke Ptr DuckDBArrowArrayStruct
ptr DuckDBArrowArrayStruct{Ptr ()
$sel:duckdbArrowArrayInternalPtr:DuckDBArrowArrayStruct :: DuckDBArrowArrayStruct -> Ptr ()
duckdbArrowArrayInternalPtr :: Ptr ()
..} =
        Ptr DuckDBArrowArrayStruct -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBArrowArrayStruct
ptr Int
0 Ptr ()
duckdbArrowArrayInternalPtr

-- | Tag type backing @duckdb_arrow_converted_schema@ pointers.
data DuckDBArrowConvertedSchemaStruct

-- | Handle to a converted Arrow schema.
type DuckDBArrowConvertedSchema = Ptr DuckDBArrowConvertedSchemaStruct

-- | Tag type backing @duckdb_arrow_stream@ pointers.
newtype DuckDBArrowStreamStruct = DuckDBArrowStreamStruct
    { DuckDBArrowStreamStruct -> Ptr ()
duckdbArrowStreamInternalPtr :: Ptr ()
    }

-- | Handle to an Arrow stream.
type DuckDBArrowStream = Ptr DuckDBArrowStreamStruct

instance Storable DuckDBArrowStreamStruct where
    sizeOf :: DuckDBArrowStreamStruct -> Int
sizeOf DuckDBArrowStreamStruct
_ = Int
pointerSize
    alignment :: DuckDBArrowStreamStruct -> Int
alignment DuckDBArrowStreamStruct
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())
    peek :: Ptr DuckDBArrowStreamStruct -> IO DuckDBArrowStreamStruct
peek Ptr DuckDBArrowStreamStruct
ptr =
        Ptr () -> DuckDBArrowStreamStruct
DuckDBArrowStreamStruct
            (Ptr () -> DuckDBArrowStreamStruct)
-> IO (Ptr ()) -> IO DuckDBArrowStreamStruct
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr DuckDBArrowStreamStruct -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DuckDBArrowStreamStruct
ptr Int
0
    poke :: Ptr DuckDBArrowStreamStruct -> DuckDBArrowStreamStruct -> IO ()
poke Ptr DuckDBArrowStreamStruct
ptr DuckDBArrowStreamStruct{Ptr ()
$sel:duckdbArrowStreamInternalPtr:DuckDBArrowStreamStruct :: DuckDBArrowStreamStruct -> Ptr ()
duckdbArrowStreamInternalPtr :: Ptr ()
..} =
        Ptr DuckDBArrowStreamStruct -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr DuckDBArrowStreamStruct
ptr Int
0 Ptr ()
duckdbArrowStreamInternalPtr

-- | Tag type backing @duckdb_expression@ pointers.
data DuckDBExpressionStruct

-- | Handle to a DuckDB expression.
type DuckDBExpression = Ptr DuckDBExpressionStruct

-- | Tag type backing @duckdb_client_context@ pointers.
data DuckDBClientContextStruct

-- | Handle to a DuckDB client context.
type DuckDBClientContext = Ptr DuckDBClientContextStruct

-- | Tag type backing @duckdb_prepared_statement@ pointers.
data DuckDBPreparedStatementStruct

-- | Handle to a prepared statement.
type DuckDBPreparedStatement = Ptr DuckDBPreparedStatementStruct

-- | Tag type backing @duckdb_value@ pointers.
data DuckDBValueStruct

-- | Handle to a scalar DuckDB value.
type DuckDBValue = Ptr DuckDBValueStruct

-- | Tag type backing @duckdb_pending_result@ pointers.
data DuckDBPendingResultStruct

-- | Handle to a pending (incremental) query result.
type DuckDBPendingResult = Ptr DuckDBPendingResultStruct

-- | Tag type backing @duckdb_logical_type@ pointers.
data DuckDBLogicalTypeStruct

-- | Handle to a DuckDB logical type value.
type DuckDBLogicalType = Ptr DuckDBLogicalTypeStruct

-- | Tag type backing @duckdb_create_type_info@ pointers.
data DuckDBCreateTypeInfoStruct

-- | Handle to logical type registration details.
type DuckDBCreateTypeInfo = Ptr DuckDBCreateTypeInfoStruct

-- | Tag type backing @duckdb_error_data@ pointers.
data DuckDBErrorDataStruct

-- | Handle to DuckDB error data.
type DuckDBErrorData = Ptr DuckDBErrorDataStruct

-- | Tag type backing @duckdb_init_info@ pointers.
data DuckDBInitInfoStruct

-- | Handle to table function initialization state.
type DuckDBInitInfo = Ptr DuckDBInitInfoStruct

-- | Tag type backing @duckdb_cast_function@ pointers.
data DuckDBCastFunctionStruct

-- | Handle to a cast function definition.
type DuckDBCastFunction = Ptr DuckDBCastFunctionStruct

-- | Tag type backing @duckdb_table_function@ pointers.
data DuckDBTableFunctionStruct

-- | Handle to a table function definition.
type DuckDBTableFunction = Ptr DuckDBTableFunctionStruct

-- | Tag type backing @duckdb_appender@ pointers.
data DuckDBAppenderStruct

-- | Handle to an appender.
type DuckDBAppender = Ptr DuckDBAppenderStruct

-- | Tag type backing @duckdb_table_description@ pointers.
data DuckDBTableDescriptionStruct

-- | Handle to a table description.
type DuckDBTableDescription = Ptr DuckDBTableDescriptionStruct

-- | Tag type backing @duckdb_profiling_info@ pointers.
data DuckDBProfilingInfoStruct

-- | Handle to profiling information.
type DuckDBProfilingInfo = Ptr DuckDBProfilingInfoStruct

-- | Tag type backing @duckdb_replacement_scan_info@ pointers.
data DuckDBReplacementScanInfoStruct

-- | Handle to replacement scan context.
type DuckDBReplacementScanInfo = Ptr DuckDBReplacementScanInfoStruct

-- | Handle to a DuckDB aggregate state.
data DuckDBAggregateStateStruct

-- | Opaque pointer to the aggregate-function state handed to user callbacks.
type DuckDBAggregateState = Ptr DuckDBAggregateStateStruct

-- | Handle to a DuckDB task state.
type DuckDBTaskState = Ptr ()

-- | Function pointer used to represent scalar function execution callbacks.
type DuckDBScalarFunctionFun = FunPtr (DuckDBFunctionInfo -> DuckDBDataChunk -> DuckDBVector -> IO ())

-- | Function pointer used to represent scalar function bind callbacks.
type DuckDBScalarFunctionBindFun = FunPtr (DuckDBBindInfo -> IO ())

-- | Function pointer used to destroy user-provided data blobs.
type DuckDBDeleteCallback = FunPtr (Ptr () -> IO ())

-- | Function pointer used to copy user-provided data blobs.
type DuckDBCopyCallback = FunPtr (Ptr () -> IO (Ptr ()))

-- | Function pointer implementing cast functions.
type DuckDBCastFunctionFun =
    FunPtr (DuckDBFunctionInfo -> DuckDBIdx -> DuckDBVector -> DuckDBVector -> IO CBool)

-- | Function pointer returning aggregate state size.
type DuckDBAggregateStateSizeFun = FunPtr (DuckDBFunctionInfo -> IO DuckDBIdx)

-- | Function pointer initializing aggregate state.
type DuckDBAggregateInitFun = FunPtr (DuckDBFunctionInfo -> DuckDBAggregateState -> IO ())

-- | Function pointer destroying aggregate state batches.
type DuckDBAggregateDestroyFun = FunPtr (Ptr DuckDBAggregateState -> DuckDBIdx -> IO ())

-- | Function pointer updating aggregate states.
type DuckDBAggregateUpdateFun =
    FunPtr (DuckDBFunctionInfo -> DuckDBDataChunk -> Ptr DuckDBAggregateState -> IO ())

-- | Function pointer combining aggregate states.
type DuckDBAggregateCombineFun =
    FunPtr
        ( DuckDBFunctionInfo ->
          Ptr DuckDBAggregateState ->
          Ptr DuckDBAggregateState ->
          DuckDBIdx ->
          IO ()
        )

-- | Function pointer finalising aggregate states.
type DuckDBAggregateFinalizeFun =
    FunPtr
        ( DuckDBFunctionInfo ->
          Ptr DuckDBAggregateState ->
          DuckDBVector ->
          DuckDBIdx ->
          DuckDBIdx ->
          IO ()
        )

-- | Function pointer for table function bind callbacks.
type DuckDBTableFunctionBindFun = FunPtr (DuckDBBindInfo -> IO ())

-- | Function pointer for table function init callbacks.
type DuckDBTableFunctionInitFun = FunPtr (DuckDBInitInfo -> IO ())

-- | Function pointer for table function execution callbacks.
type DuckDBTableFunctionFun = FunPtr (DuckDBFunctionInfo -> DuckDBDataChunk -> IO ())

-- | Function pointer for replacement scan callbacks.
type DuckDBReplacementCallback =
    FunPtr (DuckDBReplacementScanInfo -> CString -> Ptr () -> IO ())

-- The full Arrow C Data Interface definitions are not included here to avoid
-- introducing a dependency on the Arrow C headers. Instead, we define only the
-- parts we need for testing DuckDB's Arrow integration.
-- See https://arrow.apache.org/docs/format/CDataInterface.html for the full
-- specification.
-- #ifndef ARROW_C_DATA_INTERFACE
-- #define ARROW_C_DATA_INTERFACE

-- #define ARROW_FLAG_DICTIONARY_ORDERED 1
-- #define ARROW_FLAG_NULLABLE 2
-- #define ARROW_FLAG_MAP_KEYS_SORTED 4

-- struct ArrowSchema {
--   // Array type description
--   const char* format;
--   const char* name;
--   const char* metadata;
--   int64_t flags;
--   int64_t n_children;
--   struct ArrowSchema** children;
--   struct ArrowSchema* dictionary;

--   // Release callback
--   void (*release)(struct ArrowSchema*);
--   // Opaque producer-specific data
--   void* private_data;
-- };

-- struct ArrowArray {
--   // Array data description
--   int64_t length;
--   int64_t null_count;
--   int64_t offset;
--   int64_t n_buffers;
--   int64_t n_children;
--   const void** buffers;
--   struct ArrowArray** children;
--   struct ArrowArray* dictionary;

--   // Release callback
--   void (*release)(struct ArrowArray*);
--   // Opaque producer-specific data
--   void* private_data;
-- };

-- #endif  // ARROW_C_DATA_INTERFACE

{- | Partial Arrow schema view used for tests that require inspecting DuckDB's
Arrow wrappers without depending on the full Arrow C Data Interface
definitions.
-}
data ArrowSchema = ArrowSchema
    { ArrowSchema -> Ptr CChar
arrowSchemaFormat :: CString
    , ArrowSchema -> Ptr CChar
arrowSchemaName :: CString
    , ArrowSchema -> Ptr CChar
arrowSchemaMetadata :: CString
    , ArrowSchema -> Int64
arrowSchemaFlags :: Int64
    , ArrowSchema -> Int64
arrowSchemaChildCount :: Int64
    , ArrowSchema -> Ptr (Ptr ArrowSchema)
arrowSchemaChildren :: Ptr (Ptr ArrowSchema)
    , ArrowSchema -> Ptr ArrowSchema
arrowSchemaDictionary :: Ptr ArrowSchema
    , ArrowSchema -> FunPtr (Ptr ArrowSchema -> IO ())
arrowSchemaRelease :: FunPtr (Ptr ArrowSchema -> IO ())
    , ArrowSchema -> Ptr ()
arrowSchemaPrivateData :: Ptr ()
    }

instance Storable ArrowSchema where
    sizeOf :: ArrowSchema -> Int
sizeOf ArrowSchema
_ = Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
9
    alignment :: ArrowSchema -> Int
alignment ArrowSchema
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())
    peek :: Ptr ArrowSchema -> IO ArrowSchema
peek Ptr ArrowSchema
ptr =
        Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Int64
-> Int64
-> Ptr (Ptr ArrowSchema)
-> Ptr ArrowSchema
-> FunPtr (Ptr ArrowSchema -> IO ())
-> Ptr ()
-> ArrowSchema
ArrowSchema
            (Ptr CChar
 -> Ptr CChar
 -> Ptr CChar
 -> Int64
 -> Int64
 -> Ptr (Ptr ArrowSchema)
 -> Ptr ArrowSchema
 -> FunPtr (Ptr ArrowSchema -> IO ())
 -> Ptr ()
 -> ArrowSchema)
-> IO (Ptr CChar)
-> IO
     (Ptr CChar
      -> Ptr CChar
      -> Int64
      -> Int64
      -> Ptr (Ptr ArrowSchema)
      -> Ptr ArrowSchema
      -> FunPtr (Ptr ArrowSchema -> IO ())
      -> Ptr ()
      -> ArrowSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ArrowSchema -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr Int
0
            IO
  (Ptr CChar
   -> Ptr CChar
   -> Int64
   -> Int64
   -> Ptr (Ptr ArrowSchema)
   -> Ptr ArrowSchema
   -> FunPtr (Ptr ArrowSchema -> IO ())
   -> Ptr ()
   -> ArrowSchema)
-> IO (Ptr CChar)
-> IO
     (Ptr CChar
      -> Int64
      -> Int64
      -> Ptr (Ptr ArrowSchema)
      -> Ptr ArrowSchema
      -> FunPtr (Ptr ArrowSchema -> IO ())
      -> Ptr ()
      -> ArrowSchema)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowSchema -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr Int
pointerSize
            IO
  (Ptr CChar
   -> Int64
   -> Int64
   -> Ptr (Ptr ArrowSchema)
   -> Ptr ArrowSchema
   -> FunPtr (Ptr ArrowSchema -> IO ())
   -> Ptr ()
   -> ArrowSchema)
-> IO (Ptr CChar)
-> IO
     (Int64
      -> Int64
      -> Ptr (Ptr ArrowSchema)
      -> Ptr ArrowSchema
      -> FunPtr (Ptr ArrowSchema -> IO ())
      -> Ptr ()
      -> ArrowSchema)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowSchema -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
            IO
  (Int64
   -> Int64
   -> Ptr (Ptr ArrowSchema)
   -> Ptr ArrowSchema
   -> FunPtr (Ptr ArrowSchema -> IO ())
   -> Ptr ()
   -> ArrowSchema)
-> IO Int64
-> IO
     (Int64
      -> Ptr (Ptr ArrowSchema)
      -> Ptr ArrowSchema
      -> FunPtr (Ptr ArrowSchema -> IO ())
      -> Ptr ()
      -> ArrowSchema)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowSchema -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3)
            IO
  (Int64
   -> Ptr (Ptr ArrowSchema)
   -> Ptr ArrowSchema
   -> FunPtr (Ptr ArrowSchema -> IO ())
   -> Ptr ()
   -> ArrowSchema)
-> IO Int64
-> IO
     (Ptr (Ptr ArrowSchema)
      -> Ptr ArrowSchema
      -> FunPtr (Ptr ArrowSchema -> IO ())
      -> Ptr ()
      -> ArrowSchema)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowSchema -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
            IO
  (Ptr (Ptr ArrowSchema)
   -> Ptr ArrowSchema
   -> FunPtr (Ptr ArrowSchema -> IO ())
   -> Ptr ()
   -> ArrowSchema)
-> IO (Ptr (Ptr ArrowSchema))
-> IO
     (Ptr ArrowSchema
      -> FunPtr (Ptr ArrowSchema -> IO ()) -> Ptr () -> ArrowSchema)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowSchema -> Int -> IO (Ptr (Ptr ArrowSchema))
forall b. Ptr b -> Int -> IO (Ptr (Ptr ArrowSchema))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5)
            IO
  (Ptr ArrowSchema
   -> FunPtr (Ptr ArrowSchema -> IO ()) -> Ptr () -> ArrowSchema)
-> IO (Ptr ArrowSchema)
-> IO (FunPtr (Ptr ArrowSchema -> IO ()) -> Ptr () -> ArrowSchema)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowSchema -> Int -> IO (Ptr ArrowSchema)
forall b. Ptr b -> Int -> IO (Ptr ArrowSchema)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
6)
            IO (FunPtr (Ptr ArrowSchema -> IO ()) -> Ptr () -> ArrowSchema)
-> IO (FunPtr (Ptr ArrowSchema -> IO ()))
-> IO (Ptr () -> ArrowSchema)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowSchema -> Int -> IO (FunPtr (Ptr ArrowSchema -> IO ()))
forall b. Ptr b -> Int -> IO (FunPtr (Ptr ArrowSchema -> IO ()))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7)
            IO (Ptr () -> ArrowSchema) -> IO (Ptr ()) -> IO ArrowSchema
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowSchema -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    poke :: Ptr ArrowSchema -> ArrowSchema -> IO ()
poke Ptr ArrowSchema
ptr ArrowSchema{Int64
Ptr (Ptr ArrowSchema)
Ptr ()
Ptr CChar
Ptr ArrowSchema
FunPtr (Ptr ArrowSchema -> IO ())
$sel:arrowSchemaFormat:ArrowSchema :: ArrowSchema -> Ptr CChar
$sel:arrowSchemaName:ArrowSchema :: ArrowSchema -> Ptr CChar
$sel:arrowSchemaMetadata:ArrowSchema :: ArrowSchema -> Ptr CChar
$sel:arrowSchemaFlags:ArrowSchema :: ArrowSchema -> Int64
$sel:arrowSchemaChildCount:ArrowSchema :: ArrowSchema -> Int64
$sel:arrowSchemaChildren:ArrowSchema :: ArrowSchema -> Ptr (Ptr ArrowSchema)
$sel:arrowSchemaDictionary:ArrowSchema :: ArrowSchema -> Ptr ArrowSchema
$sel:arrowSchemaRelease:ArrowSchema :: ArrowSchema -> FunPtr (Ptr ArrowSchema -> IO ())
$sel:arrowSchemaPrivateData:ArrowSchema :: ArrowSchema -> Ptr ()
arrowSchemaFormat :: Ptr CChar
arrowSchemaName :: Ptr CChar
arrowSchemaMetadata :: Ptr CChar
arrowSchemaFlags :: Int64
arrowSchemaChildCount :: Int64
arrowSchemaChildren :: Ptr (Ptr ArrowSchema)
arrowSchemaDictionary :: Ptr ArrowSchema
arrowSchemaRelease :: FunPtr (Ptr ArrowSchema -> IO ())
arrowSchemaPrivateData :: Ptr ()
..} = do
        Ptr ArrowSchema -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr Int
0 Ptr CChar
arrowSchemaFormat
        Ptr ArrowSchema -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr Int
pointerSize Ptr CChar
arrowSchemaName
        Ptr ArrowSchema -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Ptr CChar
arrowSchemaMetadata
        Ptr ArrowSchema -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) Int64
arrowSchemaFlags
        Ptr ArrowSchema -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4) Int64
arrowSchemaChildCount
        Ptr ArrowSchema -> Int -> Ptr (Ptr ArrowSchema) -> IO ()
forall b. Ptr b -> Int -> Ptr (Ptr ArrowSchema) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5) Ptr (Ptr ArrowSchema)
arrowSchemaChildren
        Ptr ArrowSchema -> Int -> Ptr ArrowSchema -> IO ()
forall b. Ptr b -> Int -> Ptr ArrowSchema -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
6) Ptr ArrowSchema
arrowSchemaDictionary
        Ptr ArrowSchema
-> Int -> FunPtr (Ptr ArrowSchema -> IO ()) -> IO ()
forall b.
Ptr b -> Int -> FunPtr (Ptr ArrowSchema -> IO ()) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7) FunPtr (Ptr ArrowSchema -> IO ())
arrowSchemaRelease
        Ptr ArrowSchema -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowSchema
ptr (Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Ptr ()
arrowSchemaPrivateData

-- | Partial Arrow array view mirroring the DuckDB C API layout.
data ArrowArray = ArrowArray
    { ArrowArray -> Int64
arrowArrayLength :: Int64
    , ArrowArray -> Int64
arrowArrayNullCount :: Int64
    , ArrowArray -> Int64
arrowArrayOffset :: Int64
    , ArrowArray -> Int64
arrowArrayBufferCount :: Int64
    , ArrowArray -> Int64
arrowArrayChildCount :: Int64
    , ArrowArray -> Ptr (Ptr ())
arrowArrayBuffers :: Ptr (Ptr ())
    , ArrowArray -> Ptr (Ptr ArrowArray)
arrowArrayChildren :: Ptr (Ptr ArrowArray)
    , ArrowArray -> Ptr ArrowArray
arrowArrayDictionary :: Ptr ArrowArray
    , ArrowArray -> FunPtr (Ptr ArrowArray -> IO ())
arrowArrayRelease :: FunPtr (Ptr ArrowArray -> IO ())
    , ArrowArray -> Ptr ()
arrowArrayPrivateData :: Ptr ()
    }

instance Storable ArrowArray where
    sizeOf :: ArrowArray -> Int
sizeOf ArrowArray
_ = Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5
    alignment :: ArrowArray -> Int
alignment ArrowArray
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())
    peek :: Ptr ArrowArray -> IO ArrowArray
peek Ptr ArrowArray
ptr =
        Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Ptr (Ptr ())
-> Ptr (Ptr ArrowArray)
-> Ptr ArrowArray
-> FunPtr (Ptr ArrowArray -> IO ())
-> Ptr ()
-> ArrowArray
ArrowArray
            (Int64
 -> Int64
 -> Int64
 -> Int64
 -> Int64
 -> Ptr (Ptr ())
 -> Ptr (Ptr ArrowArray)
 -> Ptr ArrowArray
 -> FunPtr (Ptr ArrowArray -> IO ())
 -> Ptr ()
 -> ArrowArray)
-> IO Int64
-> IO
     (Int64
      -> Int64
      -> Int64
      -> Int64
      -> Ptr (Ptr ())
      -> Ptr (Ptr ArrowArray)
      -> Ptr ArrowArray
      -> FunPtr (Ptr ArrowArray -> IO ())
      -> Ptr ()
      -> ArrowArray)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ArrowArray -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr Int
0
            IO
  (Int64
   -> Int64
   -> Int64
   -> Int64
   -> Ptr (Ptr ())
   -> Ptr (Ptr ArrowArray)
   -> Ptr ArrowArray
   -> FunPtr (Ptr ArrowArray -> IO ())
   -> Ptr ()
   -> ArrowArray)
-> IO Int64
-> IO
     (Int64
      -> Int64
      -> Int64
      -> Ptr (Ptr ())
      -> Ptr (Ptr ArrowArray)
      -> Ptr ArrowArray
      -> FunPtr (Ptr ArrowArray -> IO ())
      -> Ptr ()
      -> ArrowArray)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr Int
intFieldSize
            IO
  (Int64
   -> Int64
   -> Int64
   -> Ptr (Ptr ())
   -> Ptr (Ptr ArrowArray)
   -> Ptr ArrowArray
   -> FunPtr (Ptr ArrowArray -> IO ())
   -> Ptr ()
   -> ArrowArray)
-> IO Int64
-> IO
     (Int64
      -> Int64
      -> Ptr (Ptr ())
      -> Ptr (Ptr ArrowArray)
      -> Ptr ArrowArray
      -> FunPtr (Ptr ArrowArray -> IO ())
      -> Ptr ()
      -> ArrowArray)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
            IO
  (Int64
   -> Int64
   -> Ptr (Ptr ())
   -> Ptr (Ptr ArrowArray)
   -> Ptr ArrowArray
   -> FunPtr (Ptr ArrowArray -> IO ())
   -> Ptr ()
   -> ArrowArray)
-> IO Int64
-> IO
     (Int64
      -> Ptr (Ptr ())
      -> Ptr (Ptr ArrowArray)
      -> Ptr ArrowArray
      -> FunPtr (Ptr ArrowArray -> IO ())
      -> Ptr ()
      -> ArrowArray)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3)
            IO
  (Int64
   -> Ptr (Ptr ())
   -> Ptr (Ptr ArrowArray)
   -> Ptr ArrowArray
   -> FunPtr (Ptr ArrowArray -> IO ())
   -> Ptr ()
   -> ArrowArray)
-> IO Int64
-> IO
     (Ptr (Ptr ())
      -> Ptr (Ptr ArrowArray)
      -> Ptr ArrowArray
      -> FunPtr (Ptr ArrowArray -> IO ())
      -> Ptr ()
      -> ArrowArray)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
            IO
  (Ptr (Ptr ())
   -> Ptr (Ptr ArrowArray)
   -> Ptr ArrowArray
   -> FunPtr (Ptr ArrowArray -> IO ())
   -> Ptr ()
   -> ArrowArray)
-> IO (Ptr (Ptr ()))
-> IO
     (Ptr (Ptr ArrowArray)
      -> Ptr ArrowArray
      -> FunPtr (Ptr ArrowArray -> IO ())
      -> Ptr ()
      -> ArrowArray)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO (Ptr (Ptr ()))
forall b. Ptr b -> Int -> IO (Ptr (Ptr ()))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5)
            IO
  (Ptr (Ptr ArrowArray)
   -> Ptr ArrowArray
   -> FunPtr (Ptr ArrowArray -> IO ())
   -> Ptr ()
   -> ArrowArray)
-> IO (Ptr (Ptr ArrowArray))
-> IO
     (Ptr ArrowArray
      -> FunPtr (Ptr ArrowArray -> IO ()) -> Ptr () -> ArrowArray)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO (Ptr (Ptr ArrowArray))
forall b. Ptr b -> Int -> IO (Ptr (Ptr ArrowArray))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pointerSize)
            IO
  (Ptr ArrowArray
   -> FunPtr (Ptr ArrowArray -> IO ()) -> Ptr () -> ArrowArray)
-> IO (Ptr ArrowArray)
-> IO (FunPtr (Ptr ArrowArray -> IO ()) -> Ptr () -> ArrowArray)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO (Ptr ArrowArray)
forall b. Ptr b -> Int -> IO (Ptr ArrowArray)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
            IO (FunPtr (Ptr ArrowArray -> IO ()) -> Ptr () -> ArrowArray)
-> IO (FunPtr (Ptr ArrowArray -> IO ()))
-> IO (Ptr () -> ArrowArray)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO (FunPtr (Ptr ArrowArray -> IO ()))
forall b. Ptr b -> Int -> IO (FunPtr (Ptr ArrowArray -> IO ()))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3)
            IO (Ptr () -> ArrowArray) -> IO (Ptr ()) -> IO ArrowArray
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArrowArray -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
    poke :: Ptr ArrowArray -> ArrowArray -> IO ()
poke Ptr ArrowArray
ptr ArrowArray{Int64
Ptr (Ptr ())
Ptr (Ptr ArrowArray)
Ptr ()
Ptr ArrowArray
FunPtr (Ptr ArrowArray -> IO ())
$sel:arrowArrayLength:ArrowArray :: ArrowArray -> Int64
$sel:arrowArrayNullCount:ArrowArray :: ArrowArray -> Int64
$sel:arrowArrayOffset:ArrowArray :: ArrowArray -> Int64
$sel:arrowArrayBufferCount:ArrowArray :: ArrowArray -> Int64
$sel:arrowArrayChildCount:ArrowArray :: ArrowArray -> Int64
$sel:arrowArrayBuffers:ArrowArray :: ArrowArray -> Ptr (Ptr ())
$sel:arrowArrayChildren:ArrowArray :: ArrowArray -> Ptr (Ptr ArrowArray)
$sel:arrowArrayDictionary:ArrowArray :: ArrowArray -> Ptr ArrowArray
$sel:arrowArrayRelease:ArrowArray :: ArrowArray -> FunPtr (Ptr ArrowArray -> IO ())
$sel:arrowArrayPrivateData:ArrowArray :: ArrowArray -> Ptr ()
arrowArrayLength :: Int64
arrowArrayNullCount :: Int64
arrowArrayOffset :: Int64
arrowArrayBufferCount :: Int64
arrowArrayChildCount :: Int64
arrowArrayBuffers :: Ptr (Ptr ())
arrowArrayChildren :: Ptr (Ptr ArrowArray)
arrowArrayDictionary :: Ptr ArrowArray
arrowArrayRelease :: FunPtr (Ptr ArrowArray -> IO ())
arrowArrayPrivateData :: Ptr ()
..} = do
        Ptr ArrowArray -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr Int
0 Int64
arrowArrayLength
        Ptr ArrowArray -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr Int
intFieldSize Int64
arrowArrayNullCount
        Ptr ArrowArray -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int64
arrowArrayOffset
        Ptr ArrowArray -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) Int64
arrowArrayBufferCount
        Ptr ArrowArray -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4) Int64
arrowArrayChildCount
        Ptr ArrowArray -> Int -> Ptr (Ptr ()) -> IO ()
forall b. Ptr b -> Int -> Ptr (Ptr ()) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5) Ptr (Ptr ())
arrowArrayBuffers
        Ptr ArrowArray -> Int -> Ptr (Ptr ArrowArray) -> IO ()
forall b. Ptr b -> Int -> Ptr (Ptr ArrowArray) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pointerSize) Ptr (Ptr ArrowArray)
arrowArrayChildren
        Ptr ArrowArray -> Int -> Ptr ArrowArray -> IO ()
forall b. Ptr b -> Int -> Ptr ArrowArray -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Ptr ArrowArray
arrowArrayDictionary
        Ptr ArrowArray -> Int -> FunPtr (Ptr ArrowArray -> IO ()) -> IO ()
forall b. Ptr b -> Int -> FunPtr (Ptr ArrowArray -> IO ()) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) FunPtr (Ptr ArrowArray -> IO ())
arrowArrayRelease
        Ptr ArrowArray -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArrowArray
ptr (Int
intFieldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pointerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4) Ptr ()
arrowArrayPrivateData

{- | Pointer wrapper for the deprecated Arrow schema handle exposed by DuckDB.
The underlying memory is managed by DuckDB and must only be accessed through
the deprecated Arrow helper functions.
-}
newtype ArrowSchemaPtr = ArrowSchemaPtr {ArrowSchemaPtr -> Ptr ArrowSchema
unArrowSchemaPtr :: Ptr ArrowSchema}
    deriving (ArrowSchemaPtr -> ArrowSchemaPtr -> Bool
(ArrowSchemaPtr -> ArrowSchemaPtr -> Bool)
-> (ArrowSchemaPtr -> ArrowSchemaPtr -> Bool) -> Eq ArrowSchemaPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArrowSchemaPtr -> ArrowSchemaPtr -> Bool
== :: ArrowSchemaPtr -> ArrowSchemaPtr -> Bool
$c/= :: ArrowSchemaPtr -> ArrowSchemaPtr -> Bool
/= :: ArrowSchemaPtr -> ArrowSchemaPtr -> Bool
Eq)

{- | Pointer wrapper for the deprecated Arrow array handle exposed by DuckDB.
DuckDB assumes exclusive ownership and coordinates buffer lifetimes via the
release callback stored in the referenced @ArrowArray@ struct.
-}
newtype ArrowArrayPtr = ArrowArrayPtr {ArrowArrayPtr -> Ptr ArrowArray
unArrowArrayPtr :: Ptr ArrowArray}
    deriving (ArrowArrayPtr -> ArrowArrayPtr -> Bool
(ArrowArrayPtr -> ArrowArrayPtr -> Bool)
-> (ArrowArrayPtr -> ArrowArrayPtr -> Bool) -> Eq ArrowArrayPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArrowArrayPtr -> ArrowArrayPtr -> Bool
== :: ArrowArrayPtr -> ArrowArrayPtr -> Bool
$c/= :: ArrowArrayPtr -> ArrowArrayPtr -> Bool
/= :: ArrowArrayPtr -> ArrowArrayPtr -> Bool
Eq)

{- | Pointer wrapper for the deprecated Arrow stream handle returned by DuckDB.
DuckDB owns the referenced stream; call @c_duckdb_destroy_arrow_stream@ after
invoking @duckdb_arrow_scan@.
-}
newtype ArrowStreamPtr = ArrowStreamPtr {ArrowStreamPtr -> Ptr ()
unArrowStreamPtr :: Ptr ()}
    deriving (ArrowStreamPtr -> ArrowStreamPtr -> Bool
(ArrowStreamPtr -> ArrowStreamPtr -> Bool)
-> (ArrowStreamPtr -> ArrowStreamPtr -> Bool) -> Eq ArrowStreamPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArrowStreamPtr -> ArrowStreamPtr -> Bool
== :: ArrowStreamPtr -> ArrowStreamPtr -> Bool
$c/= :: ArrowStreamPtr -> ArrowStreamPtr -> Bool
/= :: ArrowStreamPtr -> ArrowStreamPtr -> Bool
Eq)

pointerSize :: Int
pointerSize :: Int
pointerSize = Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ()
forall a. Ptr a
nullPtr :: Ptr ())

intFieldSize :: Int
intFieldSize :: Int
intFieldSize = Int64 -> Int
forall a. Storable a => a -> Int
sizeOf (Int64
0 :: Int64)