duckdb-simple 0.1.2.4 → 0.1.5.0

raw patch · 21 files changed

+1444/−420 lines, 21 filesdep +directorydep ~duckdb-ffiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory

Dependency ranges changed: duckdb-ffi

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• duckdb-simple.cabal +78/−63
• src/Database/DuckDB/Simple.hs +107/−74
• src/Database/DuckDB/Simple/Catalog.hs +86/−0
• src/Database/DuckDB/Simple/Config.hs +88/−0
• src/Database/DuckDB/Simple/Copy.hs +250/−0
• src/Database/DuckDB/Simple/FileSystem.hs +159/−0
• src/Database/DuckDB/Simple/FromField.hs +35/−28
• src/Database/DuckDB/Simple/FromRow.hs +8/−8
• src/Database/DuckDB/Simple/Function.hs +95/−24
• src/Database/DuckDB/Simple/Generic.hs +98/−69
• src/Database/DuckDB/Simple/Internal.hs +76/−3
• src/Database/DuckDB/Simple/Logging.hs +102/−0
• src/Database/DuckDB/Simple/LogicalRep.hs +26/−15
• src/Database/DuckDB/Simple/Materialize.hs +27/−27
• src/Database/DuckDB/Simple/Ok.hs +4/−4
• src/Database/DuckDB/Simple/ToField.hs +21/−18
• src/Database/DuckDB/Simple/ToRow.hs +2/−2
• src/Database/DuckDB/Simple/Types.hs +2/−2
• test/Properties.hs +5/−5
• test/Spec.hs +168/−78

@@ -1,5 +1,12 @@ # Changelog +## 0.1.5.0+- Raise the supported DuckDB runtime baseline to `1.5.0+` via the `duckdb-ffi-1.5` dependency line.+- Add DuckDB 1.5 high-level wrappers for startup config inspection and connection setup, catalog lookup, file-system handles, copy-function registration, and custom log storage registration.+- Extend scalar-function support with `createFunctionWithState`, allowing thread-local per-worker execution state backed by the new DuckDB 1.5 scalar init API.+- Deduplicate shared helpers (`withClientContext`, `destroyValue`, `destroyLogicalType`, etc.) into `Internal.hs`.+- Update the test suite for DuckDB 1.5 behavior, including `TIME_NS` decoding and new wrapper coverage for copy/logging/config/catalog/file-system helpers.+ ## 0.1.2.3 - Move DuckDBColumnType requirement for ToField to DuckValue 

@@ -1,78 +1,93 @@-cabal-version:      3.4-name:               duckdb-simple-version:            0.1.2.4-license:            MPL-2.0-license-file:       LICENSE-author:             Matthias Pall Gissurarson-maintainer:        mpg@mpg.is-category:           Database-build-type:         Simple-tested-with:        GHC == 9.6.*, GHC == 9.8.*, GHC == 9.10.*, GHC == 9.12.*, GHC == 9.14.*+cabal-version: 3.4+name: duckdb-simple+version: 0.1.5.0+license: MPL-2.0+license-file: LICENSE+author: Matthias Pall Gissurarson+maintainer: mpg@mpg.is+category: Database+build-type: Simple+tested-with:+  ghc ==9.6.*+  ghc ==9.8.*+  ghc ==9.10.*+  ghc ==9.12.*+  ghc ==9.14.*+ extra-doc-files: README.md-homepage:       https://github.com/Tritlo/duckdb-haskell-bug-reports:    https://github.com/Tritlo/duckdb-haskell/issues-synopsis:           Haskell FFI bindings for DuckDB+homepage: https://github.com/Tritlo/duckdb-haskell+bug-reports: https://github.com/Tritlo/duckdb-haskell/issues+synopsis: Haskell FFI bindings for DuckDB description:-    This library provides a mid-level interface for interacting with DuckDB,-    in the style of other "simple" libraries such as sqlite-simple and-    postgresql-simple.-    .-    Tested with DuckDB version 1.4.0, and 1.4.0.-extra-doc-files:    CHANGELOG.md, README.md+  This library provides a mid-level interface for interacting with DuckDB,+  in the style of other "simple" libraries such as sqlite-simple and+  postgresql-simple.+  .+  Tested with DuckDB version 1.5.0. +extra-doc-files:+  CHANGELOG.md+  README.md+ source-repository head-  type:     git+  type: git   location: https://github.com/Tritlo/duckdb-haskell.git-  subdir:  duckdb-simple--+  subdir: duckdb-simple  library   exposed-modules:-      Database.DuckDB.Simple-      Database.DuckDB.Simple.Function-      Database.DuckDB.Simple.FromField-      Database.DuckDB.Simple.FromRow-      Database.DuckDB.Simple.Internal-      Database.DuckDB.Simple.LogicalRep-      Database.DuckDB.Simple.Generic-      Database.DuckDB.Simple.Ok-      Database.DuckDB.Simple.ToField-      Database.DuckDB.Simple.ToRow-      Database.DuckDB.Simple.Types+    Database.DuckDB.Simple+    Database.DuckDB.Simple.Catalog+    Database.DuckDB.Simple.Config+    Database.DuckDB.Simple.Copy+    Database.DuckDB.Simple.FileSystem+    Database.DuckDB.Simple.FromField+    Database.DuckDB.Simple.FromRow+    Database.DuckDB.Simple.Function+    Database.DuckDB.Simple.Generic+    Database.DuckDB.Simple.Internal+    Database.DuckDB.Simple.Logging+    Database.DuckDB.Simple.LogicalRep+    Database.DuckDB.Simple.Ok+    Database.DuckDB.Simple.ToField+    Database.DuckDB.Simple.ToRow+    Database.DuckDB.Simple.Types+   other-modules:-      Database.DuckDB.Simple.Materialize-  hs-source-dirs:   src+    Database.DuckDB.Simple.Materialize++  hs-source-dirs: src   default-language: Haskell2010   build-depends:-      base >=4.14 && <5-    , bytestring >= 0.11 && <0.13-    , containers >= 0.6 && <0.9-    , duckdb-ffi >= 1.4.1.2 && <1.5-    , text >= 2.0 && <2.2-    , transformers >= 0.6 && <0.7-    , uuid >=1.3 && <1.4-    , time >= 1.12 && <1.16-    , array >= 0.5 && <0.6+    array >=0.5 && <0.6,+    base >=4.14 && <5,+    bytestring >=0.11 && <0.13,+    containers >=0.6 && <0.9,+    duckdb-ffi >=1.5.0.0 && <1.6,+    text >=2.0 && <2.2,+    time >=1.12 && <1.16,+    transformers >=0.6 && <0.7,+    uuid >=1.3 && <1.4,  test-suite duckdb-simple-test-  type:             exitcode-stdio-1.0-  hs-source-dirs:   test-  main-is:          Spec.hs-  other-modules:    Properties+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  other-modules: Properties   default-language: Haskell2010   build-depends:-      base >=4.14 && <5-    , duckdb-simple-    , bytestring-    , containers >= 0.6 && <0.9-    , text-    , tasty >=1.4 && <1.6-    , tasty-hunit >=0.10 && <0.12-    , tasty-quickcheck >=0.10 && <0.11-    , tasty-expected-failure >=0.12 && <0.13-    , QuickCheck >=2.14 && <2.15-    , uuid >=1.3 && <1.4-    , time-    , array >= 0.5 && <0.6-    , duckdb-ffi >= 1.4.1.2 && <1.5+    QuickCheck >=2.14 && <2.15,+    array >=0.5 && <0.6,+    base >=4.14 && <5,+    bytestring,+    containers >=0.6 && <0.9,+    directory >=1.3 && <1.4,+    duckdb-ffi >=1.5.0.0 && <1.6,+    duckdb-simple,+    tasty >=1.4 && <1.6,+    tasty-expected-failure >=0.12 && <0.13,+    tasty-hunit >=0.10 && <0.12,+    tasty-quickcheck >=0.10 && <0.11,+    text,+    time,+    uuid >=1.3 && <1.4,

@@ -9,14 +9,16 @@  The API mirrors the ergonomics of @sqlite-simple@ while being backed by the DuckDB C API. It supports connection management, parameter binding, execution,-and typed result decoding. See 'README.md' for usage examples.+and typed result decoding. See @README.md@ for usage examples. -} module Database.DuckDB.Simple (     -- * Connections     Connection,     open,+    openWithConfig,     close,     withConnection,+    withConnectionWithConfig,      -- * Queries and statements     Query (..),@@ -70,53 +72,56 @@     (:.) (..),      -- * User-defined scalar functions-    Function,+    Function (..),     createFunction,+    createFunctionWithState,     deleteFunction, ) where -import Control.Monad (forM, join, void, when, zipWithM, zipWithM_)-import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) import Control.Exception (SomeException, bracket, finally, mask, onException, throwIO, try)+import Control.Monad (forM, forM_, join, void, when, zipWithM, zipWithM_)+import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) import Data.Maybe (isJust, isNothing) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Foreign as TextForeign import Database.DuckDB.FFI-import Database.DuckDB.Simple.FromField-    ( Field (..)-    , FieldParser-    , FromField (..)-    , ResultError (..)-    )-import Database.DuckDB.Simple.FromRow-    ( FromRow (..)-    , RowParser-    , field-    , fieldWith-    , numFieldsRemaining-    , parseRow-    , rowErrorsToSqlError-    )-import Database.DuckDB.Simple.Function (Function, createFunction, deleteFunction)-import Database.DuckDB.Simple.Materialize-    ( materializeValue )-import Database.DuckDB.Simple.Internal-    ( Connection (..)-    , ConnectionState (..)-    , Query (..)-    , SQLError (..)-    , Statement (..)-    , StatementState (..)-    , StatementStream (..)-    , StatementStreamChunk (..)-    , StatementStreamChunkVector (..)-    , StatementStreamColumn (..)-    , StatementStreamState (..)-    , withConnectionHandle-    , withQueryCString-    , withStatementHandle-    )+import Database.DuckDB.Simple.FromField (+    Field (..),+    FieldParser,+    FromField (..),+    ResultError (..),+ )+import Database.DuckDB.Simple.FromRow (+    FromRow (..),+    RowParser,+    field,+    fieldWith,+    numFieldsRemaining,+    parseRow,+    rowErrorsToSqlError,+ )+import Database.DuckDB.Simple.Function (Function, createFunction, createFunctionWithState, deleteFunction)+import Database.DuckDB.Simple.Internal (+    Connection (..),+    ConnectionState (..),+    Query (..),+    SQLError (..),+    Statement (..),+    StatementState (..),+    StatementStream (..),+    StatementStreamChunk (..),+    StatementStreamChunkVector (..),+    StatementStreamColumn (..),+    StatementStreamState (..),+    withConnectionHandle,+    withQueryCString,+    withStatementHandle,+ )+import Database.DuckDB.Simple.Materialize (+    materializeValue,+ )+import Database.DuckDB.Simple.Ok (Ok (..)) import Database.DuckDB.Simple.ToField (DuckDBColumnType (..), FieldBinding, NamedParam (..), ToField (..), bindFieldBinding, duckdbColumnType, renderFieldBinding) import Database.DuckDB.Simple.ToRow (ToRow (..)) import Database.DuckDB.Simple.Types (FormatError (..), Null (..), Only (..), (:.) (..))@@ -124,13 +129,16 @@ import Foreign.Marshal.Alloc (alloca, free, malloc) import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Storable (peek, poke)-import Database.DuckDB.Simple.Ok (Ok(..))  -- | Open a DuckDB database located at the supplied path. open :: FilePath -> IO Connection-open path =+open path = openWithConfig path []++-- | Open a DuckDB database with configuration flags applied before startup.+openWithConfig :: FilePath -> [(Text, Text)] -> IO Connection+openWithConfig path settings =     mask \restore -> do-        db <- restore (openDatabase path)+        db <- restore (openDatabaseWithConfig path settings)         conn <-             restore (connectDatabase db)                 `onException` closeDatabaseHandle db@@ -152,6 +160,10 @@ withConnection :: FilePath -> (Connection -> IO a) -> IO a withConnection path = bracket (open path) close +-- | Run an action with a freshly opened configured connection, closing it afterwards.+withConnectionWithConfig :: FilePath -> [(Text, Text)] -> (Connection -> IO a) -> IO a+withConnectionWithConfig path settings = bracket (openWithConfig path settings) close+ -- | Prepare a SQL statement for execution. openStatement :: Connection -> Query -> IO Statement openStatement conn queryText =@@ -309,9 +321,10 @@                     c_duckdb_free (castPtr namePtr)                     pure name --- | Execute a prepared statement and return the number of affected rows.---   Resets any active result stream before running and raises a 'SqlError'---   if DuckDB reports a failure.+{- | Execute a prepared statement and return the number of affected rows.+  Resets any active result stream before running and raises an @SQLError@+  if DuckDB reports a failure.+-} executeStatement :: Statement -> IO Int executeStatement stmt =     withStatementHandle stmt \handle -> do@@ -428,9 +441,10 @@  -- Streaming folds ----------------------------------------------------------- --- | Stream a parameterised query through an accumulator without loading all rows.---   Bind the supplied parameters, start a streaming result, and apply the step---   function row by row to produce a final accumulator value.+{- | Stream a parameterised query through an accumulator without loading all rows.+  Bind the supplied parameters, start a streaming result, and apply the step+  function row by row to produce a final accumulator value.+-} fold :: (FromRow row, ToRow params) => Connection -> Query -> params -> a -> (a -> row -> IO a) -> IO a fold conn queryText params initial step =     withStatement conn queryText \stmt -> do@@ -468,7 +482,7 @@ nextRow :: (FromRow r) => Statement -> IO (Maybe r) nextRow = nextRowWith fromRow --- | Fetch the next row using a custom parser, returning 'Nothing' once exhausted.+-- | Fetch the next row using a custom parser, returning @Nothing@ once exhausted. nextRowWith :: RowParser r -> Statement -> IO (Maybe r) nextRowWith parser stmt@Statement{statementStream} =     mask \restore -> do@@ -489,8 +503,8 @@ consumeStream :: IORef StatementStreamState -> RowParser r -> Statement -> StatementStream -> IO (Maybe r) consumeStream streamRef parser stmt stream = do     result <--        ( try (streamNextRow (statementQuery stmt) stream)-            :: IO (Either SomeException (Maybe [Field], StatementStream))+        ( try (streamNextRow (statementQuery stmt) stream) ::+            IO (Either SomeException (Maybe [Field], StatementStream))         )     case result of         Left err -> do@@ -690,11 +704,10 @@         result <- restore action `onException` rollbackAction         void (execute_ conn commit)         pure result--  where begin = Query (Text.pack "BEGIN TRANSACTION")-        commit = Query (Text.pack "COMMIT")-        rollback = Query (Text.pack "ROLLBACK")-+  where+    begin = Query (Text.pack "BEGIN TRANSACTION")+    commit = Query (Text.pack "COMMIT")+    rollback = Query (Text.pack "ROLLBACK")  -- Internal helpers ----------------------------------------------------------- @@ -716,8 +729,9 @@     streamRef <- newIORef StatementStreamIdle     _ <-         mkWeakIORef ref $-          do join $-               atomicModifyIORef' ref $ \case+            do+                join $+                    atomicModifyIORef' ref $ \case                         StatementClosed -> (StatementClosed, pure ())                         StatementOpen{statementHandle} ->                             ( StatementClosed@@ -733,22 +747,43 @@             , statementStream = streamRef             } -openDatabase :: FilePath -> IO DuckDBDatabase-openDatabase path =+openDatabaseWithConfig :: FilePath -> [(Text, Text)] -> IO DuckDBDatabase+openDatabaseWithConfig path settings =     alloca \dbPtr ->-        alloca \errPtr -> do-            poke errPtr nullPtr-            withCString path \cPath -> do-                rc <- c_duckdb_open_ext cPath dbPtr nullPtr errPtr-                if rc == DuckDBSuccess-                    then do-                        db <- peek dbPtr-                        maybeFreeErr errPtr-                        pure db-                    else do-                        errMsg <- peekError errPtr-                        maybeFreeErr errPtr-                        throwIO $ mkOpenError errMsg+        alloca \configPtr ->+            alloca \errPtr -> do+                rcConfig <- c_duckdb_create_config configPtr+                when (rcConfig /= DuckDBSuccess) $+                    throwIO (mkOpenError (Text.pack "duckdb-simple: failed to allocate DuckDB config"))+                config <- peek configPtr+                poke errPtr nullPtr+                let destroyConfig =+                        when (config /= nullPtr) $+                            alloca \cfgPtr -> poke cfgPtr config >> c_duckdb_destroy_config cfgPtr+                flip finally destroyConfig $+                    do+                        forM_ settings \(name, value) ->+                            TextForeign.withCString name \cName ->+                                TextForeign.withCString value \cValue -> do+                                    rcSet <- c_duckdb_set_config config cName cValue+                                    when (rcSet /= DuckDBSuccess) $+                                        throwIO $+                                            mkOpenError $+                                                Text.concat+                                                    [ Text.pack "duckdb-simple: failed to set config option "+                                                    , name+                                                    ]+                        withCString path \cPath -> do+                            rc <- c_duckdb_open_ext cPath dbPtr config errPtr+                            if rc == DuckDBSuccess+                                then do+                                    db <- peek dbPtr+                                    maybeFreeErr errPtr+                                    pure db+                                else do+                                    errMsg <- peekError errPtr+                                    maybeFreeErr errPtr+                                    throwIO $ mkOpenError errMsg  connectDatabase :: DuckDBDatabase -> IO DuckDBConnection connectDatabase db =@@ -776,7 +811,6 @@ destroyPrepared stmt =     alloca \ptr -> poke ptr stmt >> c_duckdb_destroy_prepare ptr - fetchPrepareError :: DuckDBPreparedStatement -> IO Text fetchPrepareError stmt = do     msgPtr <- c_duckdb_prepare_error stmt@@ -885,7 +919,6 @@         , sqlErrorType = Nothing         , sqlErrorQuery = Just (statementQuery stmt)         }-  normalizeName :: Text -> Text normalizeName name =

@@ -0,0 +1,86 @@+{-# LANGUAGE BlockArguments #-}++{- |+Module      : Database.DuckDB.Simple.Catalog+Description : High-level helpers for DuckDB catalog inspection.+-}+module Database.DuckDB.Simple.Catalog (+    CatalogEntry (..),+    catalogTypeName,+    lookupCatalogEntry,+) where++import Control.Exception (bracket)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Foreign as TextForeign+import Database.DuckDB.FFI+import Database.DuckDB.Simple.Internal (Connection, withClientContext)+import Foreign.C.String (CString, peekCString)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (nullPtr)+import Foreign.Storable (poke)++-- | A simplified view of a catalog entry returned by DuckDB.+data CatalogEntry = CatalogEntry+    { catalogEntryName :: !Text+    , catalogEntryType :: !DuckDBCatalogEntryType+    }+    deriving (Eq, Show)++-- | Look up the backend type name of a named catalog.+catalogTypeName :: Connection -> Text -> IO (Maybe Text)+catalogTypeName conn catalogName =+    withClientContext conn \ctx ->+        TextForeign.withCString catalogName \cName ->+            withMaybeCatalog ctx cName \catalog -> do+                namePtr <- c_duckdb_catalog_get_type_name catalog+                if namePtr == nullPtr+                    then pure Nothing+                    else Just . Text.pack <$> peekCString namePtr++-- | Look up a catalog entry by catalog, schema, name, and expected entry kind.+lookupCatalogEntry :: Connection -> Text -> Text -> Text -> DuckDBCatalogEntryType -> IO (Maybe CatalogEntry)+lookupCatalogEntry conn catalogName schemaName entryName entryType =+    withClientContext conn \ctx ->+        TextForeign.withCString catalogName \cCatalog ->+            TextForeign.withCString schemaName \cSchema ->+                TextForeign.withCString entryName \cEntry ->+                    withMaybeCatalog ctx cCatalog \catalog ->+                        withMaybeCatalogEntry catalog ctx entryType cSchema cEntry \entry -> do+                            typ <- c_duckdb_catalog_entry_get_type entry+                            namePtr <- c_duckdb_catalog_entry_get_name entry+                            if namePtr == nullPtr+                                then pure Nothing+                                else do+                                    name <- Text.pack <$> peekCString namePtr+                                    pure (Just CatalogEntry{catalogEntryName = name, catalogEntryType = typ})++destroyCatalog :: DuckDBCatalog -> IO ()+destroyCatalog catalog =+    alloca \ptr -> poke ptr catalog >> c_duckdb_destroy_catalog ptr++destroyCatalogEntry :: DuckDBCatalogEntry -> IO ()+destroyCatalogEntry entry =+    alloca \ptr -> poke ptr entry >> c_duckdb_destroy_catalog_entry ptr++withMaybeCatalog :: DuckDBClientContext -> CString -> (DuckDBCatalog -> IO (Maybe a)) -> IO (Maybe a)+withMaybeCatalog ctx name action = do+    catalog <- c_duckdb_client_context_get_catalog ctx name+    if catalog == nullPtr+        then pure Nothing+        else bracket (pure catalog) destroyCatalog action++withMaybeCatalogEntry ::+    DuckDBCatalog ->+    DuckDBClientContext ->+    DuckDBCatalogEntryType ->+    CString ->+    CString ->+    (DuckDBCatalogEntry -> IO (Maybe a)) ->+    IO (Maybe a)+withMaybeCatalogEntry catalog ctx entryType schemaName entryName action = do+    entry <- c_duckdb_catalog_get_entry catalog ctx entryType schemaName entryName+    if entry == nullPtr+        then pure Nothing+        else bracket (pure entry) destroyCatalogEntry action

@@ -0,0 +1,88 @@+{-# LANGUAGE BlockArguments #-}++{- |+Module      : Database.DuckDB.Simple.Config+Description : High-level helpers for DuckDB 1.5 configuration inspection.+-}+module Database.DuckDB.Simple.Config (+    ConfigFlag (..),+    ConfigValue (..),+    listConfigFlags,+    getConfigOption,+) where++import Control.Exception (bracket)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Foreign as TextForeign+import Database.DuckDB.FFI+import Database.DuckDB.Simple.Internal (Connection, destroyValue, withClientContext)+import Foreign.C.String (peekCString)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (castPtr, nullPtr)+import Foreign.Storable (peek, poke)++-- | Static metadata describing a known DuckDB configuration flag.+data ConfigFlag = ConfigFlag+    { configFlagName :: !Text+    , configFlagDescription :: !Text+    }+    deriving (Eq, Show)++-- | The current value of a configuration option plus its scope, when available.+data ConfigValue = ConfigValue+    { configValueText :: !Text+    , configValueScope :: !(Maybe DuckDBConfigOptionScope)+    }+    deriving (Eq, Show)++-- | List all configuration flags known to the linked DuckDB runtime.+listConfigFlags :: IO [ConfigFlag]+listConfigFlags = do+    count <- c_duckdb_config_count+    let indices = [0 .. fromIntegral count - 1] :: [Int]+    mapM fetchFlag indices+  where+    fetchFlag idx =+        alloca \namePtr ->+            alloca \descPtr -> do+                rc <- c_duckdb_get_config_flag (fromIntegral idx) namePtr descPtr+                if rc /= DuckDBSuccess+                    then pure ConfigFlag{configFlagName = Text.pack (show idx), configFlagDescription = Text.pack ""}+                    else do+                        name <- peek namePtr >>= peekCString+                        description <- peek descPtr >>= peekCString+                        pure ConfigFlag{configFlagName = Text.pack name, configFlagDescription = Text.pack description}++-- | Read a configuration option from a live connection's client context.+getConfigOption :: Connection -> Text -> IO (Maybe ConfigValue)+getConfigOption conn name =+    withClientContext conn \ctx ->+        TextForeign.withCString name \cName ->+            alloca \scopePtr -> do+                poke scopePtr DuckDBConfigOptionScopeInvalid+                value <- c_duckdb_client_context_get_config_option ctx cName scopePtr+                if value == nullPtr+                    then pure Nothing+                    else bracket+                        (pure value)+                        destroyValue+                        \duckValue -> do+                            strPtr <- c_duckdb_get_varchar duckValue+                            rendered <-+                                if strPtr == nullPtr+                                    then pure Text.empty+                                    else do+                                        txt <- Text.pack <$> peekCString strPtr+                                        c_duckdb_free (castPtr strPtr)+                                        pure txt+                            scope <- peek scopePtr+                            pure $+                                Just+                                    ConfigValue+                                        { configValueText = rendered+                                        , configValueScope =+                                            if scope == DuckDBConfigOptionScopeInvalid+                                                then Nothing+                                                else Just scope+                                        }

@@ -0,0 +1,250 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}++{- |+Module      : Database.DuckDB.Simple.Copy+Description : High-level wrappers for DuckDB custom COPY functions.+-}+module Database.DuckDB.Simple.Copy (+    CopyBindInfo (..),+    CopyInitInfo (..),+    CopySinkInfo (..),+    CopyFinalizeInfo (..),+    registerCopyToFunction,+) where++import Control.Exception (SomeException, bracket, displayException, onException, try)+import Control.Monad (forM, when)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Foreign as TextForeign+import Database.DuckDB.FFI+import Database.DuckDB.Simple.FromField (Field (..))+import Database.DuckDB.Simple.Internal (Connection, destroyLogicalType, mkDeleteCallback, releaseStablePtrData, throwRegistrationError, withConnectionHandle)+import Database.DuckDB.Simple.Materialize (materializeValue)+import Foreign.C.String (CString, peekCString)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (Ptr, freeHaskellFunPtr, nullPtr)+import Foreign.StablePtr (StablePtr, castPtrToStablePtr, castStablePtrToPtr, deRefStablePtr, freeStablePtr, newStablePtr)+import Foreign.Storable (poke)++-- | Bind-phase metadata for a custom `COPY ... TO` function.+data CopyBindInfo = CopyBindInfo+    { copyBindColumnTypes :: ![DuckDBType]+    }+    deriving (Eq, Show)++-- | Init-phase inputs for a custom `COPY ... TO` function.+data CopyInitInfo bindState = CopyInitInfo+    { copyInitBindState :: !bindState+    , copyInitFilePath :: !FilePath+    }++-- | Sink-phase inputs for a custom `COPY ... TO` function.+data CopySinkInfo bindState globalState = CopySinkInfo+    { copySinkBindState :: !bindState+    , copySinkGlobalState :: !globalState+    }++-- | Finalize-phase inputs for a custom `COPY ... TO` function.+data CopyFinalizeInfo bindState globalState = CopyFinalizeInfo+    { copyFinalizeBindState :: !bindState+    , copyFinalizeGlobalState :: !globalState+    }++data CopyFunctionResources = CopyFunctionResources+    { copyBindPtr :: !DuckDBCopyFunctionBindFun+    , copyInitPtr :: !DuckDBCopyFunctionGlobalInitFun+    , copySinkPtr :: !DuckDBCopyFunctionSinkFun+    , copyFinalizePtr :: !DuckDBCopyFunctionFinalizeFun+    , copyStateDestroyPtr :: !DuckDBDeleteCallback+    }++-- | Register a custom `COPY ... TO` implementation backed by Haskell callbacks.+registerCopyToFunction ::+    forall bindState globalState.+    Connection ->+    Text ->+    (CopyBindInfo -> IO bindState) ->+    (CopyInitInfo bindState -> IO globalState) ->+    (CopySinkInfo bindState globalState -> [[Field]] -> IO ()) ->+    (CopyFinalizeInfo bindState globalState -> IO ()) ->+    IO ()+registerCopyToFunction conn name bindFn initFn sinkFn finalizeFn = do+    stateDestroyCb <- mkDeleteCallback releaseStablePtrData+    bindPtr <- mkCopyBindFun (copyBindHandler stateDestroyCb bindFn)+    initPtr <- mkCopyGlobalInitFun (copyGlobalInitHandler stateDestroyCb initFn)+    sinkPtr <- mkCopySinkFun (copySinkHandler sinkFn)+    finalizePtr <- mkCopyFinalizeFun (copyFinalizeHandler finalizeFn)+    resources <-+        newStablePtr+            CopyFunctionResources+                { copyBindPtr = bindPtr+                , copyInitPtr = initPtr+                , copySinkPtr = sinkPtr+                , copyFinalizePtr = finalizePtr+                , copyStateDestroyPtr = stateDestroyCb+                }+    destroyCb <- mkDeleteCallback releaseCopyResources+    let release =+            freeHaskellFunPtr bindPtr+                >> freeHaskellFunPtr initPtr+                >> freeHaskellFunPtr sinkPtr+                >> freeHaskellFunPtr finalizePtr+                >> freeHaskellFunPtr stateDestroyCb+                >> freeStablePtr resources+                >> freeHaskellFunPtr destroyCb+    bracket c_duckdb_create_copy_function destroyCopyFunction \copyFun ->+        (`onException` release) $ do+            TextForeign.withCString name \cName ->+                c_duckdb_copy_function_set_name copyFun cName+            c_duckdb_copy_function_set_bind copyFun bindPtr+            c_duckdb_copy_function_set_global_init copyFun initPtr+            c_duckdb_copy_function_set_sink copyFun sinkPtr+            c_duckdb_copy_function_set_finalize copyFun finalizePtr+            c_duckdb_copy_function_set_extra_info copyFun (castStablePtrToPtr resources) destroyCb+            withConnectionHandle conn \connPtr -> do+                rc <- c_duckdb_register_copy_function connPtr copyFun+                if rc == DuckDBSuccess+                    then pure ()+                    else throwRegistrationError "register copy function"++copyBindHandler ::+    forall bindState.+    DuckDBDeleteCallback ->+    (CopyBindInfo -> IO bindState) ->+    DuckDBCopyFunctionBindInfo ->+    IO ()+copyBindHandler destroyCb bindFn info = do+    outcome <- try do+        copyBindColumnTypes <- fetchColumnTypes info+        bindState <- bindFn CopyBindInfo{copyBindColumnTypes}+        stable <- newStablePtr bindState+        c_duckdb_copy_function_bind_set_bind_data info (castStablePtrToPtr stable) destroyCb+    reportCopyError c_duckdb_copy_function_bind_set_error info outcome++copyGlobalInitHandler ::+    forall bindState globalState.+    DuckDBDeleteCallback ->+    (CopyInitInfo bindState -> IO globalState) ->+    DuckDBCopyFunctionGlobalInitInfo ->+    IO ()+copyGlobalInitHandler destroyCb initFn info = do+    outcome <- try do+        rawBindState <- c_duckdb_copy_function_global_init_get_bind_data info+        when (rawBindState == nullPtr) $+            throwRegistrationError "missing copy bind state"+        bindState <- deRefStablePtr (castPtrToStablePtr rawBindState :: StablePtr bindState)+        pathPtr <- c_duckdb_copy_function_global_init_get_file_path info+        filePath <-+            if pathPtr == nullPtr+                then pure ""+                else peekCString pathPtr+        globalState <- initFn CopyInitInfo{copyInitBindState = bindState, copyInitFilePath = filePath}+        stable <- newStablePtr globalState+        c_duckdb_copy_function_global_init_set_global_state info (castStablePtrToPtr stable) destroyCb+    reportCopyError c_duckdb_copy_function_global_init_set_error info outcome++copySinkHandler ::+    forall bindState globalState.+    (CopySinkInfo bindState globalState -> [[Field]] -> IO ()) ->+    DuckDBCopyFunctionSinkInfo ->+    DuckDBDataChunk ->+    IO ()+copySinkHandler sinkFn info chunk = do+    outcome <- try do+        bindState <- readStablePtrState c_duckdb_copy_function_sink_get_bind_data info+        globalState <- readStablePtrState c_duckdb_copy_function_sink_get_global_state info+        rows <- materializeChunkRows chunk+        sinkFn CopySinkInfo{copySinkBindState = bindState, copySinkGlobalState = globalState} rows+    reportCopyError c_duckdb_copy_function_sink_set_error info outcome++copyFinalizeHandler ::+    forall bindState globalState.+    (CopyFinalizeInfo bindState globalState -> IO ()) ->+    DuckDBCopyFunctionFinalizeInfo ->+    IO ()+copyFinalizeHandler finalizeFn info = do+    outcome <- try do+        bindState <- readStablePtrState c_duckdb_copy_function_finalize_get_bind_data info+        globalState <- readStablePtrState c_duckdb_copy_function_finalize_get_global_state info+        finalizeFn CopyFinalizeInfo{copyFinalizeBindState = bindState, copyFinalizeGlobalState = globalState}+    reportCopyError c_duckdb_copy_function_finalize_set_error info outcome++reportCopyError :: (i -> CString -> IO ()) -> i -> Either SomeException () -> IO ()+reportCopyError _ _ (Right ()) = pure ()+reportCopyError setError info (Left err) =+    TextForeign.withCString (Text.pack (displayException err)) \cMsg ->+        setError info cMsg++fetchColumnTypes :: DuckDBCopyFunctionBindInfo -> IO [DuckDBType]+fetchColumnTypes info = do+    count <- c_duckdb_copy_function_bind_get_column_count info+    let indices = [0 .. fromIntegral count - 1] :: [Int]+    forM indices \idx -> do+        logical <- c_duckdb_copy_function_bind_get_column_type info (fromIntegral idx)+        dtype <- c_duckdb_get_type_id logical+        destroyLogicalType logical+        pure dtype++readStablePtrState :: forall a i. (i -> IO (Ptr ())) -> i -> IO a+readStablePtrState getter info = do+    rawPtr <- getter info+    if rawPtr == nullPtr+        then throwRegistrationError "missing copy callback state"+        else deRefStablePtr (castPtrToStablePtr rawPtr :: StablePtr a)++materializeChunkRows :: DuckDBDataChunk -> IO [[Field]]+materializeChunkRows chunk = do+    rawColumnCount <- c_duckdb_data_chunk_get_column_count chunk+    let columnCount = fromIntegral rawColumnCount :: Int+    readers <- mapM (makeColumnReader chunk) [0 .. columnCount - 1]+    rawRowCount <- c_duckdb_data_chunk_get_size chunk+    let rowCount = fromIntegral rawRowCount :: Int+    forM [0 .. rowCount - 1] \row ->+        forM readers \reader ->+            reader (fromIntegral row)++type ColumnReader = DuckDBIdx -> IO Field++makeColumnReader :: DuckDBDataChunk -> Int -> IO ColumnReader+makeColumnReader chunk columnIndex = do+    vector <- c_duckdb_data_chunk_get_vector chunk (fromIntegral columnIndex)+    logical <- c_duckdb_vector_get_column_type vector+    dtype <- c_duckdb_get_type_id logical+    destroyLogicalType logical+    dataPtr <- c_duckdb_vector_get_data vector+    validity <- c_duckdb_vector_get_validity vector+    let name = Text.pack ("column" <> show columnIndex)+    pure \rowIdx -> do+        fieldValue <- materializeValue dtype vector dataPtr validity (fromIntegral rowIdx)+        pure Field{fieldName = name, fieldIndex = columnIndex, fieldValue}++releaseCopyResources :: Ptr () -> IO ()+releaseCopyResources rawPtr =+    when (rawPtr /= nullPtr) $ do+        let stablePtr = castPtrToStablePtr rawPtr :: StablePtr CopyFunctionResources+        CopyFunctionResources{copyBindPtr, copyInitPtr, copySinkPtr, copyFinalizePtr, copyStateDestroyPtr} <- deRefStablePtr stablePtr+        freeHaskellFunPtr copyBindPtr+        freeHaskellFunPtr copyInitPtr+        freeHaskellFunPtr copySinkPtr+        freeHaskellFunPtr copyFinalizePtr+        freeHaskellFunPtr copyStateDestroyPtr+        freeStablePtr stablePtr++destroyCopyFunction :: DuckDBCopyFunction -> IO ()+destroyCopyFunction copyFun =+    alloca \ptr -> poke ptr copyFun >> c_duckdb_destroy_copy_function ptr++foreign import ccall "wrapper"+    mkCopyBindFun :: (DuckDBCopyFunctionBindInfo -> IO ()) -> IO DuckDBCopyFunctionBindFun++foreign import ccall "wrapper"+    mkCopyGlobalInitFun :: (DuckDBCopyFunctionGlobalInitInfo -> IO ()) -> IO DuckDBCopyFunctionGlobalInitFun++foreign import ccall "wrapper"+    mkCopySinkFun :: (DuckDBCopyFunctionSinkInfo -> DuckDBDataChunk -> IO ()) -> IO DuckDBCopyFunctionSinkFun++foreign import ccall "wrapper"+    mkCopyFinalizeFun :: (DuckDBCopyFunctionFinalizeInfo -> IO ()) -> IO DuckDBCopyFunctionFinalizeFun

@@ -0,0 +1,159 @@+{-# LANGUAGE BlockArguments #-}++{- |+Module      : Database.DuckDB.Simple.FileSystem+Description : High-level wrappers around DuckDB's file-system API.+-}+module Database.DuckDB.Simple.FileSystem (+    withFileHandle,+    readFileHandleChunk,+    writeFileHandleBytes,+    fileHandleTell,+    fileHandleSize,+    fileHandleSeek,+    fileHandleSync,+) where++import Control.Exception (bracket, throwIO)+import qualified Data.ByteString as BS+import Data.Int (Int64)+import Data.Text (Text)+import qualified Data.Text as Text+import Database.DuckDB.FFI+import Database.DuckDB.Simple.Internal (Connection, SQLError (..), withClientContext)+import Foreign.C.String (peekCString, withCString)+import Foreign.Marshal.Alloc (alloca, free, mallocBytes)+import Foreign.Ptr (castPtr, nullPtr)+import Foreign.Storable (peek, poke)++-- | Open a file through DuckDB's file-system layer for the duration of an action.+withFileHandle :: Connection -> FilePath -> [DuckDBFileFlag] -> (DuckDBFileHandle -> IO a) -> IO a+withFileHandle conn path flags action =+    withFileSystem conn \fs ->+        bracket+            c_duckdb_create_file_open_options+            destroyFileOpenOptions+            \opts -> do+                mapM_ (\flag -> expectState "set file-open flag" (c_duckdb_file_open_options_set_flag opts flag 1)) flags+                withCString path \cPath ->+                    alloca \filePtr -> do+                        rc <- c_duckdb_file_system_open fs cPath opts filePtr+                        if rc /= DuckDBSuccess+                            then throwFileSystemError fs path+                            else do+                                handle <- peek filePtr+                                bracket (pure handle) destroyFileHandle action++-- | Read up to the requested number of bytes from a file handle.+readFileHandleChunk :: DuckDBFileHandle -> Int64 -> IO BS.ByteString+readFileHandleChunk handle requested+    | requested <= 0 = pure BS.empty+    | otherwise = do+        raw <- mallocBytes (fromIntegral requested)+        bytesRead <- c_duckdb_file_handle_read handle raw requested+        if bytesRead < 0+            then free raw >> throwFileHandleError handle (Text.pack "read failed")+            else do+                bs <- BS.packCStringLen (castPtr raw, fromIntegral bytesRead)+                free raw+                pure bs++-- | Write an entire bytestring to a file handle.+writeFileHandleBytes :: DuckDBFileHandle -> BS.ByteString -> IO Int64+writeFileHandleBytes handle bytes =+    BS.useAsCStringLen bytes \(ptr, len) -> do+        written <- c_duckdb_file_handle_write handle (castPtr ptr) (fromIntegral len)+        if written < 0+            then throwFileHandleError handle (Text.pack "write failed")+            else pure written++-- | Return the current file position.+fileHandleTell :: DuckDBFileHandle -> IO Int64+fileHandleTell handle = do+    pos <- c_duckdb_file_handle_tell handle+    if pos < 0 then throwFileHandleError handle (Text.pack "tell failed") else pure pos++-- | Return the current file size in bytes.+fileHandleSize :: DuckDBFileHandle -> IO Int64+fileHandleSize handle = do+    size <- c_duckdb_file_handle_size handle+    if size < 0 then throwFileHandleError handle (Text.pack "size failed") else pure size++-- | Seek to an absolute byte offset.+fileHandleSeek :: DuckDBFileHandle -> Int64 -> IO ()+fileHandleSeek handle pos = do+    rc <- c_duckdb_file_handle_seek handle pos+    if rc == DuckDBSuccess+        then pure ()+        else throwFileHandleError handle (Text.pack "seek failed")++-- | Flush file-handle writes to stable storage.+fileHandleSync :: DuckDBFileHandle -> IO ()+fileHandleSync handle = do+    rc <- c_duckdb_file_handle_sync handle+    if rc == DuckDBSuccess+        then pure ()+        else throwFileHandleError handle (Text.pack "sync failed")++withFileSystem :: Connection -> (DuckDBFileSystem -> IO a) -> IO a+withFileSystem conn action =+    withClientContext conn \ctx ->+        bracket+            (c_duckdb_client_context_get_file_system ctx)+            destroyFileSystem+            action++destroyFileSystem :: DuckDBFileSystem -> IO ()+destroyFileSystem fs =+    alloca \ptr -> poke ptr fs >> c_duckdb_destroy_file_system ptr++destroyFileOpenOptions :: DuckDBFileOpenOptions -> IO ()+destroyFileOpenOptions opts =+    alloca \ptr -> poke ptr opts >> c_duckdb_destroy_file_open_options ptr++destroyFileHandle :: DuckDBFileHandle -> IO ()+destroyFileHandle handle =+    alloca \ptr -> poke ptr handle >> c_duckdb_destroy_file_handle ptr++throwFileSystemError :: DuckDBFileSystem -> FilePath -> IO a+throwFileSystemError fs path = do+    err <- c_duckdb_file_system_error_data fs+    throwErrorData err (Text.concat [Text.pack "duckdb-simple: failed to open file ", Text.pack path])++throwFileHandleError :: DuckDBFileHandle -> Text -> IO a+throwFileHandleError handle fallback = do+    err <- c_duckdb_file_handle_error_data handle+    throwErrorData err fallback++throwErrorData :: DuckDBErrorData -> Text -> IO a+throwErrorData err fallback =+    bracket (pure err) destroyErrorData \errData -> do+        msgPtr <- c_duckdb_error_data_message errData+        errType <- c_duckdb_error_data_error_type errData+        message <-+            if msgPtr == nullPtr+                then pure fallback+                else Text.pack <$> peekCString msgPtr+        throwIO+            SQLError+                { sqlErrorMessage = message+                , sqlErrorType = Just errType+                , sqlErrorQuery = Nothing+                }++destroyErrorData :: DuckDBErrorData -> IO ()+destroyErrorData err =+    alloca \ptr -> poke ptr err >> c_duckdb_destroy_error_data ptr++expectState :: String -> IO DuckDBState -> IO ()+expectState label action = do+    rc <- action+    if rc == DuckDBSuccess+        then pure ()+        else+            throwIO $+                SQLError+                    { sqlErrorMessage = Text.pack ("duckdb-simple: " <> label <> " failed")+                    , sqlErrorType = Nothing+                    , sqlErrorQuery = Nothing+                    }

@@ -20,7 +20,7 @@     UnionMemberType (..),     UnionValue (..),     LogicalTypeRep (..),-    BitString(..),+    BitString (..),     bsFromBool,     BigNum (..),     fromBigNumBytes,@@ -35,9 +35,9 @@ ) where  import Control.Exception (Exception, SomeException (..))+import Data.Array (Array, assocs, bounds, listArray, range, (!)) import Data.Bits (Bits (..), finiteBitSize) import qualified Data.ByteString as BS-import Data.Array (Array, (!), bounds, listArray, range, assocs) import Data.Data (Typeable, typeRep) import Data.Int (Int16, Int32, Int64, Int8) import Data.Map.Strict (Map)@@ -56,19 +56,19 @@     utc,     utcToLocalTime,  )-import Data.Word (Word16, Word32, Word64, Word8)-import Database.DuckDB.Simple.Ok-import Database.DuckDB.Simple.Types (Null (..))-import GHC.Num.Integer (integerFromWordList)-import Numeric.Natural (Natural) import qualified Data.UUID as UUID+import Data.Word (Word16, Word32, Word64, Word8) import Database.DuckDB.Simple.LogicalRep (     LogicalTypeRep (..),     StructField (..),     StructValue (..),     UnionMemberType (..),-    UnionValue (..)+    UnionValue (..),  )+import Database.DuckDB.Simple.Ok+import Database.DuckDB.Simple.Types (Null (..))+import GHC.Num.Integer (integerFromWordList)+import Numeric.Natural (Natural)  -- | Internal representation of a column value. data FieldValue@@ -106,6 +106,7 @@     | FieldUnion (UnionValue FieldValue)     deriving (Eq, Show) +-- | Exact-width decimal payload plus its declared width and scale. data DecimalValue = DecimalValue     { decimalWidth :: !Word8     , decimalScale :: !Word8@@ -113,6 +114,7 @@     }     deriving (Eq, Show) +-- | DuckDB interval payload split into months, days, and microseconds. data IntervalValue = IntervalValue     { intervalMonths :: !Int32     , intervalDays :: !Int32@@ -120,22 +122,22 @@     }     deriving (Eq, Show) -+-- | Arbitrary-precision integer wrapper used for DuckDB's BIGNUM type. newtype BigNum = BigNum Integer     deriving stock (Eq, Show)     deriving (Num) via Integer  {- | Decode DuckDB’s BIGNUM blob (3-byte header + big-endian payload where negative magnitudes are-bitwise complemented) back into a Haskell 'Integer'. We undo the complement when needed, then chunk-the remaining bytes into machine-word limbs (MSB chunk first) for 'integerFromWordList'.+bitwise complemented) back into a Haskell @Integer@. We undo the complement when needed, then chunk+the remaining bytes into machine-word limbs (MSB chunk first) for @integerFromWordList@. -} fromBigNumBytes :: [Word8] -> Integer fromBigNumBytes bytes =     let header = take 3 bytes         payloadRaw = drop 3 bytes         isNeg = case header of-            (h:_) -> h .&. 0x80 == 0-            []    -> False+            (h : _) -> h .&. 0x80 == 0+            [] -> False         payload = if isNeg then map complement payloadRaw else payloadRaw         bytesPerWord = finiteBitSize (0 :: Word) `div` 8 -- 8 on 64-bit, 4 on 32-bit         len = length payload@@ -150,7 +152,7 @@         limbs = (if null firstChunk then id else (firstChunk :)) (chunkWords rest)      in integerFromWordList isNeg (map toWord limbs) -{- | Encode an 'Integer' into DuckDB’s BIGNUM blob layout: emit the 3-byte header+{- | Encode an @Integer@ into DuckDB’s BIGNUM blob layout: emit the 3-byte header   (sign bit plus payload length) followed by the magnitude bytes in the same   big-endian / complemented-on-negative form that DuckDB stores internally. -}@@ -180,8 +182,11 @@         payloadBytes = if isNeg then map complement payloadBE else payloadBE      in headerBytes <> payloadBytes -data BitString = BitString { padding :: !Word8-                           , bits :: !BS.ByteString}+-- | DuckDB BIT value represented as raw bytes plus left-padding bit count.+data BitString = BitString+    { padding :: !Word8+    , bits :: !BS.ByteString+    }     deriving stock (Eq)  instance Show BitString where@@ -191,7 +196,7 @@         word8ToString :: Word8 -> String         word8ToString w = map (\n -> if testBit w n then '1' else '0') [7, 6 .. 0] --- | Construct a 'BitString' from a list of 'Bool's, where the first element+-- | Construct a @BitString@ from a list of @Bool@s, where the first element bsFromBool :: [Bool] -> BitString bsFromBool bits =     let totalBits = length bits@@ -207,7 +212,7 @@     bitsToWord8 :: [Bool] -> Word8     bitsToWord8 bs = foldl (\acc (b, i) -> if b then setBit acc i else acc) 0 (zip bs [7, 6 .. 0]) -+-- | Time-of-day paired with its associated timezone offset. data TimeWithZone = TimeWithZone     { timeWithZoneTime :: !TimeOfDay     , timeWithZoneZone :: !TimeZone@@ -259,18 +264,20 @@         , errHaskellType :: Text         , errMessage :: Text         }-    | -- | A SQL @NULL@ was encountered when the Haskell-      -- type did not permit it.+    | {- | A SQL @NULL@ was encountered when the Haskell+      type did not permit it.+      -}       UnexpectedNull         { errSQLType :: Text         , errSQLField :: Text         , errHaskellType :: Text         , errMessage :: Text         }-    | -- | The SQL value could not be parsed, or could not-      -- be represented as a valid Haskell value, or an-      -- unexpected low-level error occurred (e.g. mismatch-      -- between metadata and actual data in a row).+    | {- | The SQL value could not be parsed, or could not+      be represented as a valid Haskell value, or an+      unexpected low-level error occurred (e.g. mismatch+      between metadata and actual data in a row).+      -}       ConversionFailed         { errSQLType :: Text         , errSQLField :: Text@@ -281,10 +288,10 @@  instance Exception ResultError -{- | Parser used by 'FromField' instances and utilities such as-'Database.DuckDB.Simple.FromRow.fieldWith'. The supplied 'Field' contains-column metadata and an already-decoded 'FieldValue'; callers should return-'Ok' on success or 'Errors' (typically wrapping a 'ResultError') when the+{- | Parser used by @FromField@ instances and utilities such as+@Database.DuckDB.Simple.FromRow.fieldWith@. The supplied @Field@ contains+column metadata and an already-decoded @FieldValue@; callers should return+@Ok@ on success or @Errors@ (typically wrapping a @ResultError@) when the conversion fails. -} type FieldParser a = Field -> Ok a

@@ -10,11 +10,11 @@  {- | Module      : Database.DuckDB.Simple.FromRow-Description : Convert rows of 'Field's into Haskell values using a parser-style interface.+Description : Convert rows of @Field@s into Haskell values using a parser-style interface. -} module Database.DuckDB.Simple.FromRow (     -- * Row parsing-    RowParser (..),+    RowParser,     field,     fieldWith,     numFieldsRemaining,@@ -56,7 +56,7 @@  instance Exception ColumnOutOfBounds --- | Parser used by 'FromRow' implementations.+-- | Parser used by @FromRow@ implementations. newtype RowParser a = RowParser     { runRowParser :: ReaderT RowParseRO (StateT (Int, [Field]) Ok) a     }@@ -85,7 +85,7 @@     default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a     fromRow = to <$> gFromRow --- | Pull the next field using the provided 'FieldParser'.+-- | Pull the next field using the provided @FieldParser@. fieldWith :: FieldParser a -> RowParser a fieldWith fieldParser = RowParser $ do     RowParseRO{rowParseColumnCount} <- ask@@ -102,7 +102,7 @@                     Errors err -> lift $ lift $ Errors err                     Ok value -> pure value --- | Pull the next field and parse it using its 'FromField' instance.+-- | Pull the next field and parse it using its @FromField@ instance. field :: (FromField a) => RowParser a field = fieldWith fromField @@ -113,7 +113,7 @@     (columnIndex, _) <- lift get     pure (rowParseColumnCount - columnIndex) --- | Execute a 'RowParser' against the provided row.+-- | Execute a @RowParser@ against the provided row. parseRow :: RowParser a -> [Field] -> Ok a parseRow parser fields =     let context = RowParseRO (length fields)@@ -217,7 +217,7 @@         remaining <- numFieldsRemaining         replicateM remaining field --- | Convert a 'ResultError' into a user-facing 'SQLError'.+-- | Convert a @ResultError@ into a user-facing @SQLError@. resultErrorToSqlError :: Query -> ResultError -> SQLError resultErrorToSqlError query err =     SQLError@@ -226,7 +226,7 @@         , sqlErrorQuery = Just query         } --- | Collapse parser failure diagnostics into an 'SQLError' while preserving the query.+-- | Collapse parser failure diagnostics into an @SQLError@ while preserving the query. rowErrorsToSqlError :: Query -> [SomeException] -> SQLError rowErrorsToSqlError query errs =     case listToMaybe (mapMaybe (fromException :: SomeException -> Maybe ResultError) errs) of

@@ -1,6 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}@@ -12,12 +13,17 @@ This module mirrors the high-level API provided by @sqlite-simple@ for user defined functions, adapted to DuckDB's chunked execution model.  It allows pure and 'IO'-based Haskell functions to be exposed to SQL while reusing the-existing 'FromField' and 'ToField'-style typeclass machinery for argument-decoding and result marshalling.+existing field-decoding and result-marshalling machinery for arguments and+return values. -} module Database.DuckDB.Simple.Function (-    Function,+    ScalarType,+    ScalarValue,+    FunctionArg (),+    FunctionResult (),+    Function (..),     createFunction,+    createFunctionWithState,     deleteFunction, ) where @@ -45,9 +51,12 @@     Connection,     Query (..),     SQLError (..),+    destroyLogicalType,+    mkDeleteCallback,+    releaseStablePtrData,     withConnectionHandle,-    withQueryCString-    )+    withQueryCString,+ ) import Database.DuckDB.Simple.Materialize (materializeValue) import Database.DuckDB.Simple.Ok (Ok (..)) import Foreign.C.String (peekCString)@@ -56,6 +65,11 @@ import Foreign.StablePtr (StablePtr, castPtrToStablePtr, castStablePtrToPtr, deRefStablePtr, freeStablePtr, newStablePtr) import Foreign.Storable (poke, pokeElemOff) +data ScalarFunctionResources = ScalarFunctionResources+    { scalarFunctionExecPtr :: !DuckDBScalarFunctionFun+    , scalarFunctionInitPtr :: !(Maybe DuckDBScalarFunctionInitFun)+    }+ -- | Tag DuckDB logical types we support for scalar return values. data ScalarType     = ScalarTypeBoolean@@ -215,9 +229,9 @@ createFunction :: forall f. (Function f) => Connection -> Text -> f -> IO () createFunction conn name fn = do     funPtr <- mkScalarFun (scalarFunctionHandler fn)-    funPtrStable <- newStablePtr funPtr-    destroyCb <- mkDeleteCallback releaseFunctionPtr-    let release = destroyFunctionResources funPtr funPtrStable destroyCb+    resources <- newStablePtr ScalarFunctionResources{scalarFunctionExecPtr = funPtr, scalarFunctionInitPtr = Nothing}+    destroyCb <- mkDeleteCallback releaseFunctionResources+    let release = destroyRegistrationResources funPtr Nothing resources destroyCb     bracket c_duckdb_create_scalar_function cleanupScalarFunction \scalarFun ->         (`onException` release) $ do             TextForeign.withCString name $ \cName ->@@ -230,13 +244,47 @@             when (isVolatile (Proxy :: Proxy f)) $                 c_duckdb_scalar_function_set_volatile scalarFun             c_duckdb_scalar_function_set_function scalarFun funPtr-            c_duckdb_scalar_function_set_extra_info scalarFun (castStablePtrToPtr funPtrStable) destroyCb+            c_duckdb_scalar_function_set_extra_info scalarFun (castStablePtrToPtr resources) destroyCb             withConnectionHandle conn \connPtr -> do                 rc <- c_duckdb_register_scalar_function connPtr scalarFun                 if rc == DuckDBSuccess                     then pure ()                     else throwIO (functionInvocationError (Text.pack "duckdb-simple: registering function failed")) +-- | Register a scalar function with per-worker thread-local state.+createFunctionWithState :: forall s f. (Function f) => Connection -> Text -> IO s -> (s -> f) -> IO ()+createFunctionWithState conn name initState mkFn = do+    stateDestroyCb <- mkDeleteCallback releaseStablePtrData+    execPtr <- mkScalarFun (scalarFunctionHandlerWithState mkFn)+    initPtr <- mkScalarInitFun (scalarFunctionInitHandler stateDestroyCb initState)+    resources <-+        newStablePtr+            ScalarFunctionResources+                { scalarFunctionExecPtr = execPtr+                , scalarFunctionInitPtr = Just initPtr+                }+    destroyCb <- mkDeleteCallback releaseFunctionResources+    let release = destroyRegistrationResources execPtr (Just initPtr) resources destroyCb >> freeHaskellFunPtr stateDestroyCb+    bracket c_duckdb_create_scalar_function cleanupScalarFunction \scalarFun ->+        (`onException` release) $ do+            TextForeign.withCString name $ \cName ->+                c_duckdb_scalar_function_set_name scalarFun cName+            forM_ (argumentTypes (Proxy :: Proxy f)) \dtype ->+                withLogicalType dtype $ \logical ->+                    c_duckdb_scalar_function_add_parameter scalarFun logical+            withLogicalType (duckTypeForScalar (returnType (Proxy :: Proxy f))) $ \logical ->+                c_duckdb_scalar_function_set_return_type scalarFun logical+            when (isVolatile (Proxy :: Proxy f)) $+                c_duckdb_scalar_function_set_volatile scalarFun+            c_duckdb_scalar_function_set_function scalarFun execPtr+            c_duckdb_scalar_function_set_init scalarFun initPtr+            c_duckdb_scalar_function_set_extra_info scalarFun (castStablePtrToPtr resources) destroyCb+            withConnectionHandle conn \connPtr -> do+                rc <- c_duckdb_register_scalar_function connPtr scalarFun+                if rc == DuckDBSuccess+                    then pure ()+                    else throwIO (functionInvocationError (Text.pack "duckdb-simple: registering function failed"))+ -- | Drop a previously registered scalar function by issuing a DROP FUNCTION statement. deleteFunction :: Connection -> Text -> IO () deleteFunction conn name =@@ -279,18 +327,25 @@         poke ptr scalarFun         c_duckdb_destroy_scalar_function ptr -destroyFunctionResources :: DuckDBScalarFunctionFun -> StablePtr DuckDBScalarFunctionFun -> DuckDBDeleteCallback -> IO ()-destroyFunctionResources funPtr funPtrStable destroyCb = do+destroyRegistrationResources ::+    DuckDBScalarFunctionFun ->+    Maybe DuckDBScalarFunctionInitFun ->+    StablePtr ScalarFunctionResources ->+    DuckDBDeleteCallback ->+    IO ()+destroyRegistrationResources funPtr mInitPtr resources destroyCb = do     freeHaskellFunPtr funPtr-    freeStablePtr funPtrStable+    forM_ mInitPtr freeHaskellFunPtr+    freeStablePtr resources     freeHaskellFunPtr destroyCb -releaseFunctionPtr :: Ptr () -> IO ()-releaseFunctionPtr rawPtr =+releaseFunctionResources :: Ptr () -> IO ()+releaseFunctionResources rawPtr =     when (rawPtr /= nullPtr) $ do-        let stablePtr = castPtrToStablePtr rawPtr :: StablePtr DuckDBScalarFunctionFun-        funPtr <- deRefStablePtr stablePtr-        freeHaskellFunPtr funPtr+        let stablePtr = castPtrToStablePtr rawPtr :: StablePtr ScalarFunctionResources+        ScalarFunctionResources{scalarFunctionExecPtr, scalarFunctionInitPtr} <- deRefStablePtr stablePtr+        freeHaskellFunPtr scalarFunctionExecPtr+        forM_ scalarFunctionInitPtr freeHaskellFunPtr         freeStablePtr stablePtr  withLogicalType :: DuckDBType -> (DuckDBLogicalType -> IO a) -> IO a@@ -305,12 +360,6 @@         )         destroyLogicalType -destroyLogicalType :: DuckDBLogicalType -> IO ()-destroyLogicalType logicalType =-    alloca \ptr -> do-        poke ptr logicalType-        c_duckdb_destroy_logical_type ptr- duckTypeForScalar :: ScalarType -> DuckDBType duckTypeForScalar = \case     ScalarTypeBoolean -> DuckDBTypeBoolean@@ -352,6 +401,28 @@                 c_duckdb_scalar_function_set_error info cMsg         Right () -> pure () +scalarFunctionHandlerWithState :: forall s f. (Function f) => (s -> f) -> DuckDBFunctionInfo -> DuckDBDataChunk -> DuckDBVector -> IO ()+scalarFunctionHandlerWithState mkFn info chunk outVec = do+    statePtr <- c_duckdb_scalar_function_get_state info+    if statePtr == nullPtr+        then+            TextForeign.withCString (Text.pack "duckdb-simple: scalar function state was not initialised") $+                c_duckdb_scalar_function_set_error info+        else do+            state <- deRefStablePtr (castPtrToStablePtr statePtr :: StablePtr s)+            scalarFunctionHandler (mkFn state) info chunk outVec++scalarFunctionInitHandler :: forall s. DuckDBDeleteCallback -> IO s -> DuckDBInitInfo -> IO ()+scalarFunctionInitHandler destroyCb initState info = do+    outcome <- try initState+    case outcome of+        Left (err :: SomeException) ->+            TextForeign.withCString (Text.pack (displayException err)) $+                c_duckdb_scalar_function_init_set_error info+        Right state -> do+            stable <- newStablePtr state+            c_duckdb_scalar_function_init_set_state info (castStablePtrToPtr stable) destroyCb+ type ColumnReader = DuckDBIdx -> IO Field  makeColumnReader :: DuckDBDataChunk -> Int -> IO ColumnReader@@ -458,4 +529,4 @@     mkScalarFun :: (DuckDBFunctionInfo -> DuckDBDataChunk -> DuckDBVector -> IO ()) -> IO DuckDBScalarFunctionFun  foreign import ccall "wrapper"-    mkDeleteCallback :: (Ptr () -> IO ()) -> IO DuckDBDeleteCallback+    mkScalarInitFun :: (DuckDBInitInfo -> IO ()) -> IO DuckDBScalarFunctionInitFun

@@ -16,18 +16,18 @@ Module      : Database.DuckDB.Simple.Generic Description : Generic helpers for encoding Haskell ADTs as DuckDB structs/unions. -This module provides the glue needed to reuse the existing 'ToField'/'FromField'+This module provides the glue needed to reuse the existing @ToField@/@FromField@ machinery with algebraic data types via GHC generics.  The supported mapping is currently intentionally conservative: -* /Product types/ (records or tuples) whose fields already satisfy 'DuckValue'+* /Product types/ (records or tuples) whose fields already satisfy @DuckValue@   are encoded as STRUCT values.  Record fields retain their selector name;   positional products fall back to @field1@, @field2@, … * /Sum types/ (:+:) become UNION values.  Each constructor becomes a union   member; payloads are encoded as structs (or @NULL@ for nullary constructors).  Recursive types are supported as long as every payload is itself encodable-through 'DuckValue'.  Note that sum types must have constructor fields that are+through @DuckValue@. Note that sum types must have constructor fields that are structural products (i.e. we do not yet expose mixed union/record nesting for non-record constructors). @@ -53,7 +53,7 @@ Constructors are turned into a union with members @Circle{radius}@, @Rectangle{width,height}@, and @Origin@ (null payload). -You can also lean on @DerivingVia@ using the exported 'ViaDuckDB' newtype:+You can also lean on @DerivingVia@ using the exported @ViaDuckDB@ newtype:  > data User = User { userId :: Int64, userName :: Text } >   deriving stock (Generic)@@ -65,12 +65,12 @@  The rest of this file is organised so that each building block is reusable: -* 'DuckValue' covers leaf-level conversions between Haskell values, DuckDB-  'FieldValue's, and logical type metadata.-* 'GToField' and friends walk the generic representation to assemble structs or+* @DuckValue@ covers leaf-level conversions between Haskell values, DuckDB+  @FieldValue@s, and logical type metadata.+* @GToField@ and friends walk the generic representation to assemble structs or   unions and carry around the logical type information we later need when   binding parameters.-* 'ViaDuckDB' wires everything together for deriving via.+* @ViaDuckDB@ wires everything together for deriving via.  When adding new features, mimic the structure used here (and document new classes the way the existing ones are documented) so other backends can take@@ -79,6 +79,8 @@ module Database.DuckDB.Simple.Generic (     -- * Field-level primitives     DuckValue (..),+    GToField (),+    GFromField (),      -- * Generic encoding/decoding for ADTs     genericToFieldValue,@@ -94,20 +96,20 @@ import Control.Exception (displayException) import Control.Monad (unless) import Data.Array (Array, elems, listArray)+import qualified Data.ByteString as BS import Data.Int (Int16, Int32, Int64, Int8) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..)) import Data.Text (Text) import qualified Data.Text as Text+import Data.Time (UTCTime) import Data.Time.Calendar (Day) import Data.Time.LocalTime (LocalTime, TimeOfDay)-import Data.Time (UTCTime)-import Data.Word (Word16, Word32, Word64, Word8)-import qualified Data.ByteString as BS+import Data.Typeable (Typeable) import qualified Data.UUID as UUID+import Data.Word (Word16, Word32, Word64, Word8) import GHC.Generics import Numeric.Natural (Natural)-import Data.Typeable (Typeable)  import Database.DuckDB.FFI import Database.DuckDB.Simple.FromField (@@ -132,17 +134,18 @@ -------------------------------------------------------------------------------- -- DuckValue: bridge between Haskell scalars and FieldValue/LogicalTypeRep --- | Types that can appear inside generated structs/unions.------ A 'DuckValue' instance must provide:------ * encoding to 'FieldValue'--- * logical type metadata ('duckLogicalType')--- * decoding from 'FieldValue'------ The primitive instances below are the canonical source for how scalar types--- should be represented; both the generic implementation and the manual--- 'ToField'/'FromField' instances rely on them.+{- | Types that can appear inside generated structs/unions.++A @DuckValue@ instance must provide:++* encoding to @FieldValue@+* logical type metadata (@duckLogicalType@)+* decoding from @FieldValue@++The primitive instances below are the canonical source for how scalar types+should be represented; both the generic implementation and the manual+`ToField`/`FromField` instances rely on them.+-} class DuckValue a where     duckToField :: a -> FieldValue     duckFromField :: FieldValue -> Either String a@@ -269,8 +272,9 @@     duckFromField (FieldList fvs) = traverse duckFromField fvs     duckFromField other = Left ("duckdb-simple: expected LIST, got " <> show other) --- | Array values encode as DuckDB ARRAY (fixed-length).--- Note: Arrays must have consistent bounds to work correctly with DuckDB.+{- | Array values encode as DuckDB ARRAY (fixed-length).+Note: Arrays must have consistent bounds to work correctly with DuckDB.+-} instance (DuckValue a) => DuckValue (Array Int a) where     duckToField arr =         let values = elems arr@@ -309,10 +313,11 @@ -------------------------------------------------------------------------------- -- Generic machinery --- | Internal representation used while traversing the generic structure.  We--- keep both the encoded value and its logical type so we can re-use the same--- traversal when generating metadata ('genericLogicalType') and when producing--- concrete values ('genericToFieldValue').+{- | Internal representation used while traversing the generic structure.  We+keep both the encoded value and its logical type so we can re-use the same+traversal when generating metadata (@genericLogicalType@) and when producing+concrete values (@genericToFieldValue@).+-} data Encoded     = EncodedStruct (StructValue FieldValue) (Array Int (StructField LogicalTypeRep))     | EncodedUnion (UnionValue FieldValue)@@ -324,7 +329,7 @@     EncodedUnion uv -> FieldUnion uv     EncodedNull -> FieldNull --- | Convert a Haskell value (using its generic representation) into a DuckDB 'FieldValue'.+-- | Convert a Haskell value (using its generic representation) into a DuckDB @FieldValue@. genericToFieldValue :: forall a. (Generic a, GToField (Rep a)) => a -> FieldValue genericToFieldValue = encodedValue . gToField . from @@ -332,7 +337,7 @@ genericLogicalType :: forall a. (Generic a, GToField (Rep a)) => Proxy a -> LogicalTypeRep genericLogicalType _ = gLogicalType (Proxy :: Proxy (Rep a ())) --- | Decode a DuckDB 'FieldValue' back into a Haskell value using its generic representation.+-- | Decode a DuckDB @FieldValue@ back into a Haskell value using its generic representation. genericFromFieldValue :: forall a. (Generic a, GFromField (Rep a)) => FieldValue -> Either String a genericFromFieldValue fv = to <$> gFromField fv @@ -351,27 +356,32 @@             , structValueIndex = Map.empty             } +-- | Extract a UNION-shaped generic encoding directly when one is produced. genericToUnionValue :: forall a. (Generic a, GToField (Rep a)) => a -> Maybe (UnionValue FieldValue) genericToUnionValue value =     case gToField (from value) of         EncodedUnion uv -> Just uv         _ -> Nothing --- | Wrapper for deriving-via so that @instance ToField (ViaDuckDB a)@ picks up--- the generic encoding provided by this module.-newtype ViaDuckDB a = ViaDuckDB { getViaDuckDB :: a }+{- | Wrapper for deriving-via so that @instance ToField (ViaDuckDB a)@ picks up+the generic encoding provided by this module.+-}+newtype ViaDuckDB a = ViaDuckDB {getViaDuckDB :: a}  -- Type family to decide whether a representation is a sum.--- | Type family evaluating to 'True for sum-of-constructors generic--- representations.  We use this to select the appropriate encoding strategy.++{- | Type family evaluating to @'True@ for sum-of-constructors generic+representations.  We use this to select the appropriate encoding strategy.+-} type family IsSum f :: Bool where     IsSum (f :+: g) = 'True     IsSum (M1 D _ f) = IsSum f     IsSum (M1 C _ f) = IsSum f     IsSum _ = 'False --- | Generic encoding to the intermediate 'Encoded' representation.  Every--- instance must also supply the corresponding logical type description.+{- | Generic encoding to the intermediate @Encoded@ representation. Every+instance must also supply the corresponding logical type description.+-} class GToField f where     gToField :: f p -> Encoded     gLogicalType :: Proxy (f p) -> LogicalTypeRep@@ -380,14 +390,16 @@     gToField = gToField' (Proxy :: Proxy (IsSum f))     gLogicalType _ = gLogicalType' (Proxy :: Proxy (IsSum f)) (Proxy :: Proxy f) --- | Helper class that splits the product and sum handling using the 'IsSum'--- type family.  We specialise on products ('False) and sums ('True) to keep--- the core logic small and easy to reason about.+{- | Helper class that splits the product and sum handling using the @IsSum@+type family. We specialise on products (@'False@) and sums (@'True@) to keep+the core logic small and easy to reason about.+-} class GToField' (isSum :: Bool) f where     gToField' :: Proxy isSum -> f p -> Encoded     gLogicalType' :: Proxy isSum -> Proxy f -> LogicalTypeRep  -- Products (single constructor records)+ -- | Product encoding: single-constructor datatypes become STRUCT values. instance (GStruct f) => GToField' 'False (M1 D meta (M1 C c f)) where     gToField' _ (M1 (M1 inner)) =@@ -416,6 +428,7 @@          in LogicalTypeStruct typeArray  -- Sums (encode as union)+ -- | Sum encoding: multi-constructor datatypes become UNION values. instance (GSum f) => GToField' 'True (M1 D meta f) where     gToField' _ (M1 value) =@@ -450,16 +463,19 @@     }  resolveNames :: [(Int, Maybe Text)] -> [Text]--- | Assign canonical names to struct fields.  We preserve any selector names--- provided by GHC.Generics and fall back to @fieldN@ for positional products.++{- | Assign canonical names to struct fields.  We preserve any selector names+provided by GHC.Generics and fall back to @fieldN@ for positional products.+-} resolveNames =     map pick   where     pick (_, Just n) = n     pick (idx, Nothing) = Text.pack ("field" <> show (idx + 1)) --- | Helper that builds an 'Array' of struct fields from parallel lists of names--- and payloads.+{- | Helper that builds an @Array@ of struct fields from parallel lists of names+and payloads.+-} listArrayFrom :: [Text] -> [b] -> Array Int (StructField b) listArrayFrom names values =     case values of@@ -469,8 +485,9 @@                 (0, length values - 1)                 (zipWith (\n v -> StructField{structFieldName = n, structFieldValue = v}) names values) --- | Collect the components (values and types) of a product.  Implementations--- produce parallel lists so we can zip them during encoding and decoding.+{- | Collect the components (values and types) of a product.  Implementations+produce parallel lists so we can zip them during encoding and decoding.+-} class GStruct f where     gStructValues :: f p -> [FieldComponent FieldValue]     gStructTypes :: Proxy (f p) -> [FieldComponent LogicalTypeRep]@@ -504,9 +521,10 @@ -------------------------------------------------------------------------------- -- Sums (unions) --- | Sum type encoding.  We gather the metadata ('gSumMembers'), convert a value--- to its discriminant and payload ('gSumEncode'), and provide the inverse--- ('gSumDecode').+{- | Sum type encoding. We gather the metadata (@gSumMembers@), convert a value+to its discriminant and payload (@gSumEncode@), and provide the inverse+(@gSumDecode@).+-} class GSum f where     gSumMembers :: Proxy (f p) -> [UnionMemberType]     gSumEncode :: f p -> (Int, FieldValue)@@ -556,16 +574,20 @@ -------------------------------------------------------------------------------- -- GStructDecode: inverse of GStruct for decoding --- | Inverse of 'GStruct': decode struct payloads back into a generic product.+-- | Inverse of @GStruct@: decode struct payloads back into a generic product. class GStructDecode f where     gStructDecodeStruct :: Proxy (f p) -> StructValue FieldValue -> Either String (f p)-    -- | Construct a null/empty value for a struct type.-    -- This is only valid for U1 (empty structs) and their compositions.-    -- For selectors with actual values, this should never be called in practice-    -- as nullary constructors are represented as U1.++    {- | Construct a null/empty value for a struct type.+    This is only valid for U1 (empty structs) and their compositions.+    For selectors with actual values, this should never be called in practice+    as nullary constructors are represented as U1.+    -}     gStructNull :: Proxy (f p) -> f p-    -- | Consume a prefix of fields from left to right while decoding, returning-    -- the reconstructed value and any remaining fields.++    {- | Consume a prefix of fields from left to right while decoding, returning+    the reconstructed value and any remaining fields.+    -}     gStructDecodeList :: Proxy (f p) -> [FieldValue] -> Either String (f p, [FieldValue])  instance GStructDecode U1 where@@ -596,6 +618,7 @@             [fv] -> M1 . K1 <$> duckFromField fv             [] -> Left "duckdb-simple: missing struct field (expected 1, got 0)"             xs -> Left ("duckdb-simple: expected single field struct, but got " <> show (length xs) <> " fields")+     -- IMPOSSIBLE: This should never be called in practice because nullary constructors     -- are represented as U1, not as selectors with actual field values. A selector (M1 S)     -- represents a record field that must contain a value, so there's no sensible way to@@ -620,8 +643,9 @@ -------------------------------------------------------------------------------- -- GFromField (inverse generic) --- | Generic decoding entry point mirroring 'GToField'.  This is used both by--- @genericFromFieldValue@ and the 'Generically' deriving helper.+{- | Generic decoding entry point mirroring @GToField@. This is used both by+@genericFromFieldValue@ and the @Generically@ deriving helper.+-} class GFromField f where     gFromField :: FieldValue -> Either String (f p) @@ -648,9 +672,10 @@ -------------------------------------------------------------------------------- -- ViaDuckDB instances --- | The deriving-via version of 'DuckDBColumnType'.  We look at the generic--- logical type and map it back to a textual name.  The textual names are only--- used for diagnostics (errors and column metadata).+{- | The deriving-via version of @DuckDBColumnType@. We look at the generic+logical type and map it back to a textual name.  The textual names are only+used for diagnostics (errors and column metadata).+-} instance (Generic a, GToField (Rep a)) => DuckDBColumnType (ViaDuckDB a) where     duckdbColumnTypeFor _ =         case genericLogicalType (Proxy :: Proxy a) of@@ -663,9 +688,10 @@             LogicalTypeDecimal{} -> Text.pack "DECIMAL"             LogicalTypeEnum{} -> Text.pack "ENUM" --- | Deriving-via 'ToField' instance.  We reuse the helpers above to decide--- whether the top-level representation is a union, struct, or scalar and then--- delegate to the existing 'ToField' instances for those composite types.+{- | Deriving-via @ToField@ instance. We reuse the helpers above to decide+whether the top-level representation is a union, struct, or scalar and then+delegate to the existing @ToField@ instances for those composite types.+-} instance (Generic a, GToField (Rep a)) => ToField (ViaDuckDB a) where     toField (ViaDuckDB x) =         case genericToUnionValue x of@@ -680,8 +706,9 @@                             FieldNull -> toField (Nothing :: Maybe Int)                             other -> error ("duckdb-simple: unsupported generic encoding " <> show other) --- | Deriving-via 'FromField' instance.  Errors are rewrapped using the existing--- 'returnError' helper so callers receive a proper 'ResultError'.+{- | Deriving-via @FromField@ instance. Errors are rewrapped using the existing+@returnError@ helper so callers receive a proper @ResultError@.+-} instance (Generic a, GFromField (Rep a), Typeable a) => FromField (ViaDuckDB a) where     fromField f@Field{fieldValue} =         case genericFromFieldValue fieldValue of@@ -690,8 +717,10 @@                 returnError ConversionFailed f (Text.pack err)  duckdbTypeToName :: DuckDBType -> Text--- | Translate a 'DuckDBType' into a textual label for diagnostics and--- documentation.  This mirrors the naming used in "Database.DuckDB.Simple.ToField".++{- | Translate a @DuckDBType@ into a textual label for diagnostics and+documentation.  This mirrors the naming used in "Database.DuckDB.Simple.ToField".+-} duckdbTypeToName dtype     | dtype == DuckDBTypeBoolean = Text.pack "BOOLEAN"     | dtype == DuckDBTypeTinyInt = Text.pack "TINYINT"

@@ -8,7 +8,7 @@  This module provides access to the opaque data constructors and helper utilities required by the high-level API.  It is not part of the supported-public interface; consumers should depend on 'Database.DuckDB.Simple' instead.+public interface; consumers should depend on @Database.DuckDB.Simple@ instead. -} module Database.DuckDB.Simple.Internal (     -- * Data constructors (internal use only)@@ -28,12 +28,21 @@     -- * Helpers     connectionClosedError,     statementClosedError,+    withDatabaseHandle,     withConnectionHandle,     withStatementHandle,     withQueryCString,+    withClientContext,+    destroyClientContext,+    destroyValue,+    destroyLogicalType,+    throwRegistrationError,+    releaseStablePtrData,+    mkDeleteCallback, ) where -import Control.Exception (Exception, throwIO)+import Control.Exception (Exception, bracket, throwIO)+import Control.Monad (when) import Data.IORef (IORef, readIORef) import Data.String (IsString (..)) import Data.Text (Text)@@ -41,17 +50,28 @@ import qualified Data.Text.Foreign as TextForeign import Data.Word (Word64) import Database.DuckDB.FFI (+    DuckDBClientContext,     DuckDBConnection,     DuckDBDataChunk,     DuckDBDatabase,+    DuckDBDeleteCallback,     DuckDBErrorType,+    DuckDBLogicalType,     DuckDBPreparedStatement,     DuckDBResult,     DuckDBType,+    DuckDBValue,     DuckDBVector,+    c_duckdb_connection_get_client_context,+    c_duckdb_destroy_client_context,+    c_duckdb_destroy_logical_type,+    c_duckdb_destroy_value,  ) import Foreign.C.String (CString)-import Foreign.Ptr (Ptr)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.StablePtr (StablePtr, castPtrToStablePtr, freeStablePtr)+import Foreign.Storable (peek, poke)  -- | Represents a textual SQL query with UTF-8 encoding semantics. newtype Query = Query@@ -136,6 +156,7 @@  instance Exception SQLError +-- | Convert an arbitrary exception into an untyped @SQLError@. toSQLError :: (Exception e) => e -> SQLError toSQLError ex =     SQLError@@ -181,3 +202,55 @@     case state of         ConnectionClosed -> throwIO connectionClosedError         ConnectionOpen{connectionHandle} -> action connectionHandle++-- | Internal helper for safely accessing the underlying database handle.+withDatabaseHandle :: Connection -> (DuckDBDatabase -> IO a) -> IO a+withDatabaseHandle Connection{connectionState} action = do+    state <- readIORef connectionState+    case state of+        ConnectionClosed -> throwIO connectionClosedError+        ConnectionOpen{connectionDatabase} -> action connectionDatabase++-- | Acquire the client context for the connection, destroying it after the action.+withClientContext :: Connection -> (DuckDBClientContext -> IO a) -> IO a+withClientContext conn action =+    withConnectionHandle conn $ \connPtr ->+        alloca $ \ctxPtr -> do+            c_duckdb_connection_get_client_context connPtr ctxPtr+            ctx <- peek ctxPtr+            bracket (pure ctx) destroyClientContext action++-- | Destroy a client context handle.+destroyClientContext :: DuckDBClientContext -> IO ()+destroyClientContext ctx =+    alloca $ \ptr -> poke ptr ctx >> c_duckdb_destroy_client_context ptr++-- | Destroy a value handle.+destroyValue :: DuckDBValue -> IO ()+destroyValue value =+    alloca $ \ptr -> poke ptr value >> c_duckdb_destroy_value ptr++-- | Destroy a logical type handle.+destroyLogicalType :: DuckDBLogicalType -> IO ()+destroyLogicalType logicalType =+    alloca $ \ptr -> poke ptr logicalType >> c_duckdb_destroy_logical_type ptr++-- | Throw a standardised registration error.+throwRegistrationError :: String -> IO a+throwRegistrationError label =+    throwIO+        SQLError+            { sqlErrorMessage = Text.pack ("duckdb-simple: " <> label <> " failed")+            , sqlErrorType = Nothing+            , sqlErrorQuery = Nothing+            }++-- | Free a stable pointer stored behind a raw @Ptr ()@.+releaseStablePtrData :: Ptr () -> IO ()+releaseStablePtrData rawPtr =+    when (rawPtr /= nullPtr) $+        freeStablePtr (castPtrToStablePtr rawPtr :: StablePtr ())++-- | Create a DuckDB delete callback from a Haskell function.+foreign import ccall "wrapper"+    mkDeleteCallback :: (Ptr () -> IO ()) -> IO DuckDBDeleteCallback

@@ -0,0 +1,102 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE NamedFieldPuns #-}++{- |+Module      : Database.DuckDB.Simple.Logging+Description : High-level wrappers for DuckDB custom log storage.+-}+module Database.DuckDB.Simple.Logging (+    LogEntry (..),+    registerLogStorage,+) where++import Control.Exception (bracket, onException)+import Data.Ratio ((%))+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Foreign as TextForeign+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Database.DuckDB.FFI+import Database.DuckDB.Simple.Internal (Connection, mkDeleteCallback, throwRegistrationError, withDatabaseHandle)+import Foreign.C.String (CString, peekCString)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (Ptr, freeHaskellFunPtr, nullPtr)+import Foreign.StablePtr (StablePtr, castPtrToStablePtr, castStablePtrToPtr, deRefStablePtr, freeStablePtr, newStablePtr)+import Foreign.Storable (peek, poke)++-- | A single log event delivered through DuckDB's log-storage callback.+data LogEntry = LogEntry+    { logEntryTimestamp :: !(Maybe UTCTime)+    , logEntryLevel :: !Text+    , logEntryType :: !Text+    , logEntryMessage :: !Text+    }+    deriving (Eq, Show)++-- | Register a custom log storage callback on the database behind a connection.+registerLogStorage :: Connection -> Text -> (LogEntry -> IO ()) -> IO ()+registerLogStorage conn name callback = do+    writeCb <- mkWriteLogEntryCallback (logStorageHandler callback)+    callbackStable <- newStablePtr writeCb+    deleteCb <- mkDeleteCallback releaseWriteLogCallback+    let release = freeHaskellFunPtr writeCb >> freeStablePtr callbackStable >> freeHaskellFunPtr deleteCb+    bracket c_duckdb_create_log_storage destroyLogStorage \storage ->+        (`onException` release) $ do+            TextForeign.withCString name \cName ->+                c_duckdb_log_storage_set_name storage cName+            c_duckdb_log_storage_set_write_log_entry storage writeCb+            c_duckdb_log_storage_set_extra_data storage (castStablePtrToPtr callbackStable) deleteCb+            withDatabaseHandle conn \db -> do+                rc <- c_duckdb_register_log_storage db storage+                if rc == DuckDBSuccess+                    then pure ()+                    else throwRegistrationError "register log storage"++logStorageHandler ::+    (LogEntry -> IO ()) ->+    Ptr () ->+    Ptr DuckDBTimestamp ->+    CString ->+    CString ->+    CString ->+    IO ()+logStorageHandler callback _ timestampPtr levelPtr logTypePtr messagePtr = do+    entry <- do+        logEntryTimestamp <- readTimestamp timestampPtr+        logEntryLevel <- readCStringText levelPtr+        logEntryType <- readCStringText logTypePtr+        logEntryMessage <- readCStringText messagePtr+        pure LogEntry{logEntryTimestamp, logEntryLevel, logEntryType, logEntryMessage}+    callback entry++readTimestamp :: Ptr DuckDBTimestamp -> IO (Maybe UTCTime)+readTimestamp ptr+    | ptr == nullPtr = pure Nothing+    | otherwise = do+        DuckDBTimestamp micros <- peek ptr+        pure (Just (posixSecondsToUTCTime (fromRational (toInteger micros % 1000000))))++readCStringText :: CString -> IO Text+readCStringText ptr+    | ptr == nullPtr = pure Text.empty+    | otherwise = Text.pack <$> peekCString ptr++releaseWriteLogCallback :: Ptr () -> IO ()+releaseWriteLogCallback rawPtr =+    if rawPtr == nullPtr+        then pure ()+        else do+            let stablePtr = castPtrToStablePtr rawPtr :: StablePtr DuckDBLoggerWriteLogEntryFun+            callback <- deRefStablePtr stablePtr+            freeHaskellFunPtr callback+            freeStablePtr stablePtr++destroyLogStorage :: DuckDBLogStorage -> IO ()+destroyLogStorage storage =+    alloca \ptr -> poke ptr storage >> c_duckdb_destroy_log_storage ptr++foreign import ccall "wrapper"+    mkWriteLogEntryCallback ::+        (Ptr () -> Ptr DuckDBTimestamp -> CString -> CString -> CString -> IO ()) ->+        IO DuckDBLoggerWriteLogEntryFun

@@ -2,6 +2,10 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{- |+Module      : Database.DuckDB.Simple.LogicalRep+Description : Structured logical-type and value representations for DuckDB.+-} module Database.DuckDB.Simple.LogicalRep (     -- * Structured value helpers     StructField (..),@@ -31,6 +35,7 @@ import Foreign.Ptr (castPtr, nullPtr) import Foreign.Storable (poke) +-- | A Haskell description of a DuckDB logical type tree. data LogicalTypeRep     = LogicalTypeScalar DuckDBType     | LogicalTypeDecimal !Word8 !Word8@@ -42,12 +47,14 @@     | LogicalTypeEnum !(Array Int Text)     deriving (Eq, Show) +-- | A named field within a STRUCT-like value or type. data StructField a = StructField     { structFieldName :: !Text     , structFieldValue :: !a     }     deriving (Eq, Show) +-- | A fully materialized STRUCT value together with its type metadata. data StructValue a = StructValue     { structValueFields :: !(Array Int (StructField a))     , structValueTypes :: !(Array Int (StructField LogicalTypeRep))@@ -55,12 +62,14 @@     }     deriving (Eq, Show) +-- | A named member within a UNION type. data UnionMemberType = UnionMemberType     { unionMemberName :: !Text     , unionMemberType :: !LogicalTypeRep     }     deriving (Eq, Show) +-- | A fully materialized UNION value together with its member metadata. data UnionValue a = UnionValue     { unionValueIndex :: !Word16     , unionValueLabel :: !Text@@ -69,18 +78,22 @@     }     deriving (Eq, Show) +-- | Recover the logical STRUCT type corresponding to a @StructValue@. structValueTypeRep :: StructValue a -> LogicalTypeRep structValueTypeRep StructValue{structValueTypes} = LogicalTypeStruct structValueTypes +-- | Recover the logical UNION type corresponding to a @UnionValue@. unionValueTypeRep :: UnionValue a -> LogicalTypeRep unionValueTypeRep UnionValue{unionValueMembers} = LogicalTypeUnion unionValueMembers +-- | Destroy a logical type handle obtained from DuckDB. destroyLogicalType :: DuckDBLogicalType -> IO () destroyLogicalType logical =     alloca \ptr -> do         poke ptr logical         c_duckdb_destroy_logical_type ptr +-- | Convert a DuckDB logical type handle into the pure @LogicalTypeRep@ tree. logicalTypeToRep :: DuckDBLogicalType -> IO LogicalTypeRep logicalTypeToRep logical = do     dtype <- c_duckdb_get_type_id logical@@ -164,6 +177,7 @@         _ ->             pure (LogicalTypeScalar dtype) +-- | Materialize a DuckDB logical type handle from a @LogicalTypeRep@ tree. logicalTypeFromRep :: LogicalTypeRep -> IO DuckDBLogicalType logicalTypeFromRep = \case     LogicalTypeScalar dtype ->@@ -178,16 +192,15 @@     LogicalTypeMap keyRep valueRep ->         bracket (logicalTypeFromRep keyRep) destroyLogicalType \keyType ->             bracket (logicalTypeFromRep valueRep) destroyLogicalType $-                        c_duckdb_create_map_type keyType+                c_duckdb_create_map_type keyType     LogicalTypeStruct fieldArray -> do         let fields = elems fieldArray             count = length fields         if count == 0-            then-                withMany withCString [] \namePtrs ->-                    withArray namePtrs \nameArray ->-                        withArray [] \typeArray ->-                            c_duckdb_create_struct_type typeArray nameArray 0+            then withMany withCString [] \namePtrs ->+                withArray namePtrs \nameArray ->+                    withArray [] \typeArray ->+                        c_duckdb_create_struct_type typeArray nameArray 0             else do                 childTypes <- mapM (logicalTypeFromRep . structFieldValue) fields                 let names = map (Text.unpack . structFieldName) fields@@ -202,11 +215,10 @@         let members = elems memberArray             count = length members         if count == 0-            then-                withMany withCString [] \namePtrs ->-                    withArray namePtrs \nameArray ->-                        withArray [] \memberPtr ->-                            c_duckdb_create_union_type memberPtr nameArray 0+            then withMany withCString [] \namePtrs ->+                withArray namePtrs \nameArray ->+                    withArray [] \memberPtr ->+                        c_duckdb_create_union_type memberPtr nameArray 0             else do                 memberTypes <- mapM (logicalTypeFromRep . unionMemberType) members                 let names = map (Text.unpack . unionMemberName) members@@ -222,10 +234,9 @@             count = length entries         if count == 0             then c_duckdb_create_enum_type nullPtr 0-            else-                withMany withCString (map Text.unpack entries) \namePtrs ->-                    withArray namePtrs \nameArray ->-                        c_duckdb_create_enum_type nameArray (fromIntegral count)+            else withMany withCString (map Text.unpack entries) \namePtrs ->+                withArray namePtrs \nameArray ->+                    c_duckdb_create_enum_type nameArray (fromIntegral count)  word64ToInt :: Text -> Word64 -> IO Int word64ToInt label value =

@@ -7,45 +7,45 @@  import Control.Exception (bracket, throwIO) import Control.Monad (forM, when)-import qualified Data.ByteString as BS+import Data.Array (Array, elems, listArray) import Data.Bits (clearBit, shiftL, xor, (.|.))+import qualified Data.ByteString as BS import Data.Int (Int16, Int32, Int64, Int8)+import qualified Data.Map.Strict as Map import Data.Ratio ((%)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as TextEncoding-import Data.Array (Array, elems, listArray)-import qualified Data.Map.Strict as Map import Data.Time.Calendar (Day, fromGregorian) import Data.Time.Clock (UTCTime (..)) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.Time.LocalTime-    ( LocalTime (..)-    , TimeOfDay (..)-    , minutesToTimeZone-    , utc-    , utcToLocalTime-    )+import Data.Time.LocalTime (+    LocalTime (..),+    TimeOfDay (..),+    minutesToTimeZone,+    utc,+    utcToLocalTime,+ ) import qualified Data.UUID as UUID import Data.Word (Word16, Word32, Word64, Word8) import Database.DuckDB.FFI-import Database.DuckDB.Simple.FromField-    ( BigNum (..)-    , BitString (..)-    , DecimalValue (..)-    , FieldValue (..)-    , IntervalValue (..)-    , TimeWithZone (..)-    , fromBigNumBytes-    )-import Database.DuckDB.Simple.LogicalRep-    ( LogicalTypeRep (..)-    , StructField (..)-    , StructValue (..)-    , UnionMemberType (..)-    , UnionValue (..)-    , logicalTypeToRep-    )+import Database.DuckDB.Simple.FromField (+    BigNum (..),+    BitString (..),+    DecimalValue (..),+    FieldValue (..),+    IntervalValue (..),+    TimeWithZone (..),+    fromBigNumBytes,+ )+import Database.DuckDB.Simple.LogicalRep (+    LogicalTypeRep (..),+    StructField (..),+    StructValue (..),+    UnionMemberType (..),+    UnionValue (..),+    logicalTypeToRep,+ ) import Foreign.C.Types (CBool (..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr)

@@ -5,10 +5,10 @@ Module      : Database.DuckDB.Simple.Ok Description : Lightweight error accumulation for row parsing. -The 'Ok' type mirrors the helper used by @sqlite-simple@: it behaves like an-`Either [SomeException]` with sensible 'Alternative' semantics that accumulate-failure reasons instead of discarding them. This underpins the RowParser-machinery in 'Database.DuckDB.Simple.FromRow'.+The @Ok@ type mirrors the helper used by @sqlite-simple@: it behaves like an+@Either [SomeException]@ with sensible @Alternative@ semantics that accumulate+failure reasons instead of discarding them. This underpins the row parser+machinery in @Database.DuckDB.Simple.FromRow@. -} module Database.DuckDB.Simple.Ok (     Ok (..),

@@ -10,11 +10,12 @@ Module      : Database.DuckDB.Simple.ToField Description : Convert Haskell parameters into DuckDB bindable values. -The 'ToField' class mirrors the interface provided by @sqlite-simple@ while+The @ToField@ class mirrors the interface provided by @sqlite-simple@ while delegating to the DuckDB C API under the hood. -} module Database.DuckDB.Simple.ToField (     FieldBinding,+    ToDuckValue (..),     ToField (..),     DuckDBColumnType (..),     NamedParam (..),@@ -25,10 +26,10 @@  import Control.Exception (bracket, throwIO) import Control.Monad (when, zipWithM)-import Data.Bits (complement, (.&.), shiftL, shiftR)-import qualified Data.ByteString as BS import Data.Array (Array, elems)-import Data.Int (Int8, Int16, Int32, Int64)+import Data.Bits (complement, shiftL, shiftR, (.&.))+import qualified Data.ByteString as BS+import Data.Int (Int16, Int32, Int64, Int8) import Data.Proxy (Proxy (..)) import Data.Text (Text) import qualified Data.Text as Text@@ -36,9 +37,15 @@ import Data.Time.Calendar (Day, toGregorian) import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds) import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..), TimeZone (..), timeOfDayToTime, timeZoneMinutes, utc, utcToLocalTime)+import qualified Data.UUID as UUID import Data.Word (Word16, Word32, Word64, Word8) import Database.DuckDB.FFI import Database.DuckDB.Simple.FromField (BigNum (..), BitString (..), DecimalValue (..), FieldValue (..), IntervalValue (..), TimeWithZone (..), toBigNumBytes)+import Database.DuckDB.Simple.Internal (+    SQLError (..),+    Statement (..),+    withStatementHandle,+ ) import Database.DuckDB.Simple.LogicalRep (     LogicalTypeRep (..),     StructField (..),@@ -47,12 +54,7 @@     UnionValue (..),     logicalTypeFromRep,     structValueTypeRep,-    unionValueTypeRep- )-import Database.DuckDB.Simple.Internal (-    SQLError (..),-    Statement (..),-    withStatementHandle,+    unionValueTypeRep,  ) import Database.DuckDB.Simple.Types (Null (..)) import Foreign.C.String (peekCString)@@ -63,7 +65,6 @@ import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Storable (poke) import Numeric.Natural (Natural)-import qualified Data.UUID as UUID  -- | Represents a named parameter binding using the @:=@ operator. data NamedParam where@@ -77,7 +78,9 @@     , fieldBindingDisplay :: !String     } -class DuckDBColumnType a => ToDuckValue a where+-- | Low-level class for values that can be marshalled directly into `DuckDBValue`s.+class (DuckDBColumnType a) => ToDuckValue a where+    -- | Convert a Haskell value into an owned DuckDB boxed value.     toDuckValue :: a -> IO DuckDBValue  valueBinding :: String -> IO DuckDBValue -> FieldBinding@@ -85,15 +88,15 @@     mkFieldBinding display $ \stmt idx ->         bindDuckValue stmt idx mkValue --- | Types that map to a concrete DuckDB column type when used with 'ToField'.+-- | Types that map to a concrete DuckDB column type when used with @ToField@. class DuckDBColumnType a where     duckdbColumnTypeFor :: Proxy a -> Text --- | Report the DuckDB column type that best matches a given 'ToField' instance.+-- | Report the DuckDB column type that best matches a given @ToField@ instance. duckdbColumnType :: forall a. (DuckDBColumnType a) => Proxy a -> Text duckdbColumnType = duckdbColumnTypeFor --- | Apply a 'FieldBinding' to the given statement/index.+-- | Apply a @FieldBinding@ to the given statement/index. bindFieldBinding :: Statement -> DuckDBIdx -> FieldBinding -> IO () bindFieldBinding stmt idx FieldBinding{fieldBindingAction} = fieldBindingAction stmt idx @@ -188,7 +191,6 @@ instance DuckDBColumnType Int8 where     duckdbColumnTypeFor _ = "TINYINT" - instance DuckDBColumnType Int16 where     duckdbColumnTypeFor _ = "SMALLINT" @@ -319,7 +321,8 @@ uuidDuckValue uuid =     alloca $ \ptr -> do         let (upper, lower) = UUID.toWords64 uuid-        poke ptr+        poke+            ptr             DuckDBUHugeInt                 { duckDBUHugeIntLower = lower                 , duckDBUHugeIntUpper = upper@@ -430,7 +433,7 @@         throwIO (userError "duckdb-simple: struct value/type field names mismatch")     childValues <-         zipWithM-            (\StructField{structFieldValue = typeRep} StructField{structFieldValue = fieldVal} ->+            ( \StructField{structFieldValue = typeRep} StructField{structFieldValue = fieldVal} ->                 fieldValueWithTypeDuckValue typeRep fieldVal             )             typeFields

@@ -6,7 +6,7 @@ Module      : Database.DuckDB.Simple.ToRow Description : Rendering Haskell collections into parameter rows. -The 'ToRow' class converts Haskell values into lists of 'FieldBinding's that+The `ToRow` class converts Haskell values into lists of `FieldBinding`s that can be consumed by statement binding functions. -} module Database.DuckDB.Simple.ToRow (@@ -24,7 +24,7 @@     default toRow :: (Generic a, GToRow (Rep a)) => a -> [FieldBinding]     toRow = gtoRow . from --- | Generic helper for deriving 'ToRow'.+-- | Generic helper for deriving `ToRow`. class GToRow f where     gtoRow :: f p -> [FieldBinding] 

@@ -7,7 +7,7 @@ The datatypes in this module are intentionally kept lightweight.  The main `Database.DuckDB.Simple` module exposes the types without their constructors so that callers interact with them through the high-level API.  The actual-definitions live in 'Database.DuckDB.Simple.Internal'.+definitions live in @Database.DuckDB.Simple.Internal@. -} module Database.DuckDB.Simple.Types (     Connection,@@ -38,7 +38,7 @@ newtype Only a = Only {fromOnly :: a}     deriving (Eq, Ord, Show, Read) --- | Convenience product type for combining 'FromRow'/'ToRow' instances.+-- | Convenience product type for combining @FromRow@ and @ToRow@ instances. data h :. t = h :. t     deriving (Eq, Ord, Show, Read) 

@@ -39,7 +39,7 @@     StructField (..),     StructValue (..),     UnionMemberType (..),-    UnionValue (..)+    UnionValue (..),  ) import Database.DuckDB.Simple.ToField (ToField) import Database.DuckDB.Simple.Types (Null (..), Only (..))@@ -53,8 +53,8 @@     chooseInteger,     counterexample,     elements,-    frequency,     forAllShrink,+    frequency,     ioProperty,     scale,     shrink,@@ -69,7 +69,7 @@  data SomeRoundTrip     = forall a.-      (Eq a, Show a, ToField a, FromField a) =>+        (Eq a, Show a, ToField a, FromField a) =>       SomeRoundTrip String (Proxy a) (Gen a) (a -> [a])  roundTripTests :: TestTree@@ -84,8 +84,8 @@  mkRoundTripTest :: IO Connection -> SomeRoundTrip -> TestTree mkRoundTripTest getConn (SomeRoundTrip label proxy gen shrinker) =-            testProperty label $-                forAllShrink gen shrinker (roundTripProperty getConn proxy)+    testProperty label $+        forAllShrink gen shrinker (roundTripProperty getConn proxy)  roundTripProperty ::     forall a.

@@ -2,25 +2,28 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE LambdaCase #-}  -- | Tasty-based test suite for duckdb-simple. module Main (main) where  import Control.Applicative ((<|>)) import Control.Exception (ErrorCall, Exception, SomeException, displayException, fromException, try)-import Control.Monad (forM_, replicateM_)-import qualified Data.ByteString as BS+import Control.Monad (forM_, replicateM_, when) import Data.Array (Array, elems, listArray)-import Data.IORef (atomicModifyIORef', newIORef)+import qualified Data.ByteString as BS+import Data.IORef (atomicModifyIORef', newIORef, readIORef) import Data.Int (Int16, Int32, Int64, Int8) import Data.List (sortOn) import qualified Data.Map.Strict as Map+import Data.Maybe (fromJust) import Data.Proxy (Proxy (..))+import Data.Ratio ((%)) import Data.String (fromString) import qualified Data.Text as Text import Data.Time.Calendar (fromGregorian)@@ -33,44 +36,54 @@     timeOfDayToTime,     utc,  )+import qualified Data.UUID as UUID import Data.Word (Word16, Word32, Word64, Word8)-import Data.Ratio ((%))+import Database.DuckDB.FFI (+    pattern DuckDBCatalogEntryTypeTable,+    pattern DuckDBFileFlagCreate,+    pattern DuckDBFileFlagRead,+    pattern DuckDBFileFlagWrite,+ ) import Database.DuckDB.Simple-import Database.DuckDB.Simple.FromField-    ( BigNum (..)-    , BitString (..)-    , bsFromBool-    , DecimalValue (..)-    , Field (..)-    , FieldValue (..)-    , IntervalValue (..)-    , TimeWithZone (..)-    , fromBigNumBytes-    , returnError-    , toBigNumBytes-    )-import Database.DuckDB.Simple.LogicalRep-    ( StructField (..)-    , StructValue (..)-    , UnionMemberType (..)-    , UnionValue (..)-    )-import Database.DuckDB.Simple.Generic-    ( genericFromFieldValue-    , genericToFieldValue-    , genericToStructValue-    , ViaDuckDB (..)-    )+import qualified Database.DuckDB.Simple.Catalog as Catalog+import qualified Database.DuckDB.Simple.Config as Config+import qualified Database.DuckDB.Simple.Copy as Copy+import qualified Database.DuckDB.Simple.FileSystem as FileSystem+import Database.DuckDB.Simple.FromField (+    BigNum (..),+    BitString (..),+    DecimalValue (..),+    Field (..),+    FieldValue (..),+    IntervalValue (..),+    TimeWithZone (..),+    bsFromBool,+    fromBigNumBytes,+    returnError,+    toBigNumBytes,+ )+import Database.DuckDB.Simple.Generic (+    ViaDuckDB (..),+    genericFromFieldValue,+    genericToFieldValue,+    genericToStructValue,+ )+import qualified Database.DuckDB.Simple.Logging as Logging+import Database.DuckDB.Simple.LogicalRep (+    StructField (..),+    StructValue (..),+    UnionMemberType (..),+    UnionValue (..),+ ) import Database.DuckDB.Simple.Ok (Ok (..))-import Properties (roundTripTests) import GHC.Generics (Generic) import Numeric.Natural (Natural)+import Properties (roundTripTests)+import System.Directory (doesFileExist, removeFile) import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.ExpectedFailure (expectFailBecause) import Test.Tasty.HUnit import Test.Tasty.QuickCheck (testProperty, (===))-import Test.Tasty.ExpectedFailure (expectFailBecause)-import qualified Data.UUID as UUID-import Data.Maybe (fromJust)  data Person = Person     { personId :: Int@@ -189,6 +202,7 @@         , typeTests         , streamingTests         , functionsTests+        , v15Tests         , transactionTests         ] @@ -203,8 +217,93 @@             conn <- open ":memory:"             close conn             close conn+        , testCase "opens with startup config" $ do+            conn <- openWithConfig ":memory:" [("threads", "1")]+            mValue <- Config.getConfigOption conn "threads"+            close conn+            case mValue of+                Nothing -> assertFailure "expected threads config value"+                Just value -> Config.configValueText value @?= "1"         ] +v15Tests :: TestTree+v15Tests =+    testGroup+        "DuckDB 1.5 wrappers"+        [ testCase "lists config flags" $ do+            flags <- Config.listConfigFlags+            assertBool "expected at least one config flag" (not (null flags))+            assertBool "expected threads flag" (any ((== "threads") . Config.configFlagName) flags)+        , testCase "catalog lookup works inside a transaction" $+            withConnection ":memory:" \conn -> do+                _ <- execute_ conn "CREATE TABLE catalog_probe(id INTEGER)"+                withTransaction conn $ do+                    mType <- Catalog.catalogTypeName conn "memory"+                    assertBool "expected catalog type name" (mType /= Nothing)+                    mEntry <- Catalog.lookupCatalogEntry conn "memory" "main" "catalog_probe" DuckDBCatalogEntryTypeTable+                    case mEntry of+                        Nothing -> assertFailure "expected catalog entry"+                        Just entry -> Catalog.catalogEntryName entry @?= "catalog_probe"+        , testCase "file system wrappers round-trip bytes" $ do+            let path = "/tmp/duckdb-simple-filesystem.bin"+                payload = BS.pack [0, 1, 2, 3, 255]+            exists <- doesFileExist path+            when exists (removeFile path)+            withConnection ":memory:" \conn -> do+                FileSystem.withFileHandle conn path [DuckDBFileFlagCreate, DuckDBFileFlagWrite] \handle -> do+                    written <- FileSystem.writeFileHandleBytes handle payload+                    written @?= fromIntegral (BS.length payload)+                    FileSystem.fileHandleSync handle+                FileSystem.withFileHandle conn path [DuckDBFileFlagRead] \handle -> do+                    size <- FileSystem.fileHandleSize handle+                    size @?= fromIntegral (BS.length payload)+                    bytes <- FileSystem.readFileHandleChunk handle 32+                    bytes @?= payload+            removeFile path+        , testCase "copy wrappers receive COPY TO rows" $+            withConnection ":memory:" \conn -> do+                capturedRef <- newIORef ([] :: [Int])+                pathRef <- newIORef Nothing+                Copy.registerCopyToFunction+                    conn+                    "hs_capture"+                    (\bindInfo -> pure (length (Copy.copyBindColumnTypes bindInfo)))+                    ( \initInfo -> do+                        atomicModifyIORef' pathRef \_ -> (Just (Copy.copyInitFilePath initInfo), ())+                        pure (Copy.copyInitBindState initInfo)+                    )+                    ( \sinkInfo rows -> do+                        Copy.copySinkBindState sinkInfo @?= 1+                        Copy.copySinkGlobalState sinkInfo @?= 1+                        values <- mapM fieldInt rows+                        atomicModifyIORef' capturedRef \existing -> (existing <> values, ())+                    )+                    ( \finalizeInfo -> do+                        Copy.copyFinalizeBindState finalizeInfo @?= 1+                        Copy.copyFinalizeGlobalState finalizeInfo @?= 1+                    )+                _ <- execute_ conn "COPY (SELECT * FROM (VALUES (1), (2), (3)) AS t(x)) TO '/tmp/duckdb-simple-copy.out' (FORMAT hs_capture)"+                captured <- readIORef capturedRef+                filePath <- readIORef pathRef+                captured @?= [1, 2, 3]+                filePath @?= Just "/tmp/duckdb-simple-copy.out"+        , testCase "logging wrapper registers a log sink" $+            withConnection ":memory:" \conn -> do+                entriesRef <- newIORef ([] :: [Logging.LogEntry])+                Logging.registerLogStorage conn "hs_log_capture" \entry ->+                    atomicModifyIORef' entriesRef \entries -> (entry : entries, ())+                _ <- execute_ conn "SELECT write_log('duckdb-simple logging wrapper', level := 'INFO', scope := 'connection')"+                _ <- readIORef entriesRef+                pure ()+        ]++fieldInt :: [Field] -> IO Int+fieldInt [fld] =+    case fromField fld of+        Errors err -> assertFailure (show err) >> pure 0+        Ok value -> pure value+fieldInt fields = assertFailure ("expected one field, got " <> show (length fields)) >> pure 0+ withConnectionTests :: TestTree withConnectionTests =     testGroup@@ -436,7 +535,7 @@                     withConnection ":memory:" \conn -> do                         let sql =                                 Query-                                    (case castExpression of+                                    ( case castExpression of                                         CastExpression expressionValue expressionType ->                                             Text.concat ["SELECT CAST(", expressionValue, " AS ", expressionType, ")"]                                         DirectExpression expressionSQL ->@@ -507,12 +606,12 @@     , successCase "UUID" (quoted $ UUID.toText uuid) "UUID" (ExpectEquals (FieldUUID uuid))     , successCase "BIT" (quoted $ Text.pack $ show bits) "BIT" (ExpectEquals (FieldBit bits))     , successCase "ARRAY" (quoted "[1,2,3]") "INTEGER[3]" (ExpectEquals (FieldArray arrayElements))-     -- This one is broken upstream, instead of a DuckDBTypeTimeNs, we get a DuckDBType 0-    , failCaseWith "TIME_NS" (quoted "03:04:05.123456789") "TIME_NS" "TIME_NS decoding unsupported" (expectErrorCallContaining "INVALID")+    , -- This one is broken upstream, instead of a DuckDBTypeTimeNs, we get a DuckDBType 0+      successCase "TIME_NS" (quoted "03:04:05.123456789") "TIME_NS" (ExpectEquals (FieldTime (TimeOfDay 3 4 5.123456789)))     , successDirect "STRUCT" "{'a': 1, 'b': 2}" (expectStruct structFields)     , successDirect "UNION" "CAST(union_value(a := 42) AS UNION(a INTEGER, b VARCHAR))" (expectUnion 0 (Text.pack "a") (FieldInt32 42))-    -- These can never surface from a query, only internally.-    , failCaseOK "ANY" (quoted "1") "ANY" (expectSQLErrorContaining "ANY")+    , -- These can never surface from a query, only internally.+      failCaseOK "ANY" (quoted "1") "ANY" (expectSQLErrorContaining "ANY")     , failCaseOK "STRING_LITERAL" (quoted literalText) "STRING_LITERAL" (expectSQLErrorContaining "STRING_LITERAL")     , failCaseOK "INTEGER_LITERAL" (quoted "123") "INTEGER_LITERAL" (expectSQLErrorContaining "INTEGER_LITERAL")     , failCaseOK "INVALID" "0" "INVALID" (expectSQLErrorContaining "INVALID")@@ -538,13 +637,6 @@             , castExpectation = expectation             , castExpectFailureReason = Nothing             }-    failCaseWith label value ty reason expectation =-        DuckDBCastCase-            { castLabel = label-            , castExpression = CastExpression value ty-            , castExpectation = expectation-            , castExpectFailureReason = Just reason-            }     failCaseOK label value ty expectation =         DuckDBCastCase             { castLabel = label@@ -554,14 +646,14 @@             }     expectMapEntries expectedPairs =         ExpectSatisfies $-           \case-             FieldMap actualPairs ->-                 let normalize = sortOn (mapKey . fst)-                     mapKey (FieldText txt) = txt-                     mapKey other = Text.pack (show other)-                  in assertEqual "map entries" (normalize expectedPairs) (normalize actualPairs)-             other ->-                 assertFailure ("expected FieldMap, but saw " <> show other)+            \case+                FieldMap actualPairs ->+                    let normalize = sortOn (mapKey . fst)+                        mapKey (FieldText txt) = txt+                        mapKey other = Text.pack (show other)+                     in assertEqual "map entries" (normalize expectedPairs) (normalize actualPairs)+                other ->+                    assertFailure ("expected FieldMap, but saw " <> show other)     structFields =         [ StructField{structFieldName = Text.pack "a", structFieldValue = FieldInt32 1}         , StructField{structFieldName = Text.pack "b", structFieldValue = FieldInt32 2}@@ -598,22 +690,11 @@             case fromException err :: Maybe SQLError of                 Just sqlErr ->                     let message = sqlErrorMessage sqlErr-                        in assertBool+                     in assertBool                             ("expected SQLError containing " <> Text.unpack needle <> ", but saw: " <> Text.unpack message)                             (Text.isInfixOf needle message)                 Nothing ->                     assertFailure ("expected SQLError, but saw " <> displayException err)-    expectErrorCallContaining :: Text.Text -> DuckDBExpectation-    expectErrorCallContaining needle =-        ExpectException $ \err ->-            case fromException err :: Maybe ErrorCall of-                Just callErr ->-                    let message = Text.pack (displayException callErr)-                        in assertBool-                            ("expected ErrorCall containing " <> Text.unpack needle <> ", but saw: " <> Text.unpack message)-                            (Text.isInfixOf needle message)-                Nothing ->-                    assertFailure ("expected ErrorCall, but saw " <> displayException err)     bsFromString :: String -> BS.ByteString     bsFromString = BS.pack . map (fromIntegral . fromEnum)     secondsWithFraction :: Integer -> Integer -> Integer -> Rational@@ -929,11 +1010,11 @@             let sumVal = SumBool True             case genericToFieldValue sumVal of                 FieldUnion uv -> do-                    map unionMemberName (elems (unionValueMembers uv)) @?=-                        [ Text.pack "SumInt"-                        , Text.pack "SumBool"-                        , Text.pack "SumPair"-                        ]+                    map unionMemberName (elems (unionValueMembers uv))+                        @?= [ Text.pack "SumInt"+                            , Text.pack "SumBool"+                            , Text.pack "SumPair"+                            ]                     unionValueLabel uv @?= Text.pack "SumBool"                     genericFromFieldValue (FieldUnion uv) @?= Right sumVal                 other -> assertFailure ("expected FieldUnion, got " <> show other)@@ -945,8 +1026,8 @@                     case unionValuePayload uv of                         FieldStruct StructValue{structValueFields} -> do                             map structFieldName (elems structValueFields) @?= [Text.pack "field1", Text.pack "field2"]-                            map structFieldValue (elems structValueFields) @?=-                                [FieldInt64 7, FieldText (Text.pack "duck")]+                            map structFieldValue (elems structValueFields)+                                @?= [FieldInt64 7, FieldText (Text.pack "duck")]                         other -> assertFailure ("expected struct payload, got " <> show other)                     genericFromFieldValue (FieldUnion uv) @?= Right sumVal                 other -> assertFailure ("expected FieldUnion, got " <> show other)@@ -970,8 +1051,8 @@                     unionValuePayload uv @?= FieldNull                     genericFromFieldValue (FieldUnion uv) @?= Right EnumRed                 other -> assertFailure ("expected FieldUnion, got " <> show other)-        -- Edge case tests-        , testCase "struct with multiple basic fields" $ do+        , -- Edge case tests+          testCase "struct with multiple basic fields" $ do             -- Test a struct with multiple fields             let twoField = TwoFieldStruct 42 (Text.pack "text")             case genericToFieldValue twoField of@@ -997,9 +1078,9 @@                     genericFromFieldValue (FieldStruct sv1) @?= Right withJust                     genericFromFieldValue (FieldStruct sv2) @?= Right withNothing                 (other1, other2) -> assertFailure ("expected FieldStruct, got " <> show (other1, other2))-        -- Error case tests-        , testCase "decode wrong field type fails" $ do-            let wrongType = FieldInt32 42  -- Trying to decode as GenericRecord+        , -- Error case tests+          testCase "decode wrong field type fails" $ do+            let wrongType = FieldInt32 42 -- Trying to decode as GenericRecord             case genericFromFieldValue wrongType :: Either String GenericRecord of                 Left err -> assertBool "error mentions STRUCT" (Text.pack "STRUCT" `Text.isInfixOf` Text.pack err)                 Right _ -> assertFailure "expected decode error for wrong type"@@ -1105,6 +1186,15 @@                 second <- query_ conn "SELECT hs_counter()" :: IO [Only Int]                 assertEqual "first counter call" [Only 1] first                 assertEqual "second counter call" [Only 2] second+        , testCase "supports thread-local function state" $ do+            conn <- openWithConfig ":memory:" [("threads", "1")]+            createFunctionWithState conn "hs_stateful_counter" (newIORef (0 :: Int)) \ref -> do+                atomicModifyIORef' ref \n ->+                    let next = n + 1+                     in (next, next)+            rows <- query_ conn "SELECT hs_stateful_counter() FROM range(3)" :: IO [Only Int]+            close conn+            assertEqual "stateful rows" [Only 1, Only 2, Only 3] rows         ]  transactionTests :: TestTree