duckdb-simple 0.1.1.2 → 0.1.2.0

raw patch · 10 files changed

+1158/−375 lines, 10 filesdep +QuickCheckdep +containersdep +tasty-expected-failuredep ~duckdb-ffiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, containers, tasty-expected-failure, tasty-quickcheck, uuid

Dependency ranges changed: duckdb-ffi

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−1
• README.md +28/−40
• duckdb-simple.cabal +9/−2
• src/Database/DuckDB/Simple.hs +195/−156
• src/Database/DuckDB/Simple/FromField.hs +250/−67
• src/Database/DuckDB/Simple/FromRow.hs +22/−22
• src/Database/DuckDB/Simple/Function.hs +63/−64
• src/Database/DuckDB/Simple/Internal.hs +9/−8
• src/Database/DuckDB/Simple/ToField.hs +192/−5
• test/Spec.hs +384/−10

@@ -1,6 +1,11 @@ # Changelog -# Changelog+## 0.1.2.0+- Added LIST/MAP coverage note: LIST columns decode into Haskell lists and MAP columns into strict `Map k v`, with matching parameter bindings via `ToField`.+- Taught `FromField` to interpret `FieldBigNum` as `Integer`/`Natural` and added matching `ToField` instances for `BigNum`, `Integer`, and `Natural` so BIGNUM parameters round-trip without truncation.+- Added `duckdbColumnType` helper and `DuckDBColumnType` class, exposing the DuckDB column type associated with each `ToField` instance.+- Fixed UUID decoding by undoing DuckDB’s upper-word bias and added a UUID round-trip regression test.+- Fixed BIT encoding and decoding  ## 0.1.1.2 - Broadened `FieldValue` and `FromField` coverage to handle all DuckDB scalar types, including intervals, HUGEINT/UHUGEINT, decimals (with metadata), time/timestamp with additional precisions, timezone-aware values, bit strings, bignums, and enums.

@@ -3,8 +3,10 @@ `duckdb-simple` provides a high-level Haskell interface to DuckDB inspired by the ergonomics of [`sqlite-simple`](https://hackage.haskell.org/package/sqlite-simple). It builds on the low-level bindings exposed by [`duckdb-ffi`](../duckdb-ffi) and-provides a small, focused API for opening connections, running queries, binding-parameters, and decoding typed results.+provides a focused API for opening connections, running queries, binding+parameters, and decoding typed results—including the full set of DuckDB scalar+types (signed/unsigned integers, decimals, hugeints, intervals, precise and+timezone-aware temporals, blobs, enums, bit strings, and bignums).  ## Getting Started @@ -25,14 +27,14 @@  ### Key Modules -- `Database.DuckDB.Simple` – primary API: connections, statements, execution,-  queries, and error handling.-- `Database.DuckDB.Simple.ToField` / `ToRow` – typeclasses for preparing-  parameters that can be passed to `execute`/`query`.+- `Database.DuckDB.Simple` – connections, prepared statements, execution,+  queries, metadata, and error handling.+- `Database.DuckDB.Simple.ToField` / `ToRow` – typeclasses and helpers for+  preparing positional or named parameters. - `Database.DuckDB.Simple.FromField` / `FromRow` – typeclasses for decoding-  query results returned by `query`/`query_`.-- `Database.DuckDB.Simple.Types` – common utility types (`Query`, `Null`,-  `Only`, `(:.)`, `SQLError`).+  query results, with generic deriving support for product types.+- `Database.DuckDB.Simple.Types` – shared types (`Query`, `Null`, `Only`,+  `(:.)`, `SQLError`). - `Database.DuckDB.Simple.Function` – register scalar Haskell functions that   can be invoked directly from SQL. @@ -70,10 +72,10 @@     ["$kind" := ("metric" :: String), "$payload" := ("ok" :: String)] ``` -DuckDB currently does not allow mixing positional and named placeholders within-the same SQL statement; the library preserves DuckDB’s error message in that-situation. Savepoints are also unavailable in DuckDB at the moment, so-`withSavepoint` throws an `SQLError` detailing the limitation.+DuckDB does not allow mixing positional and named placeholders within the same+SQL statement; the library preserves DuckDB’s error message in that situation.+Savepoints are currently rejected by DuckDB, so `withSavepoint` raises an+`SQLError` describing the limitation.  If the number of supplied parameters does not match the statement’s declared placeholders—or if you attempt to bind named arguments to a positional-only@@ -140,32 +142,19 @@ For manual cursor-style iteration, use `nextRow`/`nextRowWith` on an open `Statement` to pull rows one at a time and decide when to stop. -### Temporal & Binary Types--`duckdb-simple` now maps DuckDB temporal columns directly onto familiar-`Data.Time` types (`DATE` → `Day`, `TIME` → `TimeOfDay`, `TIMESTAMP` →-`LocalTime`/`UTCTime`). Binary blobs surface as strict `ByteString` values. Casting-logic plugs into the existing `ToField`/`FromField` classes, so round-tripping values-through prepared statements works just like the numeric and text helpers shown earlier.--### Feature Coverage & Roadmap--Included today:+### Feature Coverage  - Connections, prepared statements, positional/named parameter binding. - High-level execution (`execute*`) and eager queries (`query*`, `queryNamed`).-- Streaming/folding helpers (`fold`, `foldNamed`, `fold_`, `nextRow`).-- Temporal (`Day`, `TimeOfDay`, `LocalTime`, `UTCTime`) and blob (`ByteString`)-  round-trips via `FromField`/`ToField` instances.-- Row decoding via `FromField`/`FromRow`, including generic deriving support.-- Basic transaction helpers (`withTransaction`, `withSavepoint` fallback).-- Metadata helpers: `columnCount`, `columnName`, and connection-level-  `rowsChanged`.--Planned for a future release:--- Broader type coverage for structured/list/decimal families, including UUID-friendly APIs.-- Native savepoints once DuckDB exposes the required support.+- Streaming helpers (`fold`, `foldNamed`, `fold_`, `nextRow`) for constant-space+  result processing.+- Comprehensive scalar type support: signed/unsigned integers, HUGEINT/UHUGEINT,+  decimals (with width/scale), intervals, precise and timezone-aware temporals,+  enums, bit strings, blobs, and bignums.+- Row decoding via `FromField`/`FromRow`, with generic deriving for product types.+- User-defined scalar functions backed by Haskell functions.+- Transaction helpers (`withTransaction`, `withSavepoint` fallback) and metadata+  accessors (`columnCount`, `columnName`, `rowsChanged`).  ## User-Defined Functions @@ -190,10 +179,9 @@  Exceptions raised while the function executes are propagated back to DuckDB as `SQLError` values, and `deleteFunction` issues a `DROP FUNCTION IF EXISTS`-statement to remove the registration. Current DuckDB releases mark C API-registrations as internal, so the drop operation reports an error instead of-removing the function; duckdb-simple surfaces that limitation as an-`SQLError`.+statement to remove the registration. DuckDB registers C API scalar functions+as internal entries; attempting to drop them this way will yield an error, which+the library surfaces as an `SQLError`.  ## Tests 

@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               duckdb-simple-version:            0.1.1.2+version:            0.1.2.0 license:            MPL-2.0 license-file:       LICENSE author:             Matthias Pall Gissurarson@@ -42,9 +42,11 @@   build-depends:       base >=4.14 && <5     , bytestring >= 0.11 && <0.12-    , duckdb-ffi >= 1.4 && <1.5+    , containers >= 0.6 && <0.7+    , duckdb-ffi >= 1.4.1.2 && <1.5     , text >= 2.0 && <2.1     , transformers >= 0.6 && <0.7+    , uuid >=1.3 && <1.4     , time >= 1.12 && <1.13  test-suite duckdb-simple-test@@ -56,7 +58,12 @@       base >=4.14 && <5     , duckdb-simple     , bytestring+    , containers >= 0.6 && <0.7     , 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

@@ -63,6 +63,8 @@     ToRow (..),     FieldBinding,     NamedParam (..),+    DuckDBColumnType (..),+    duckdbColumnType,     Null (..),     Only (..),     (:.) (..),@@ -73,11 +75,11 @@     deleteFunction, ) where -import Control.Monad (forM, foldM, join, void, when, zipWithM, zipWithM_)+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 qualified Data.ByteString as BS-import Data.Bits ((.|.), shiftL)+import Data.Bits ((.|.), shiftL, Bits (..)) import Data.Int (Int16, Int32, Int64, Int8) import Data.Maybe (isJust, isNothing) import Data.Text (Text)@@ -105,9 +107,10 @@     , FieldValue (..)     , FieldParser     , FromField (..)-    , ResultError (..)     , IntervalValue (..)+    , ResultError (..)     , TimeWithZone (..)+    , fromBigNumBytes     ) import Database.DuckDB.Simple.FromRow     ( FromRow (..)@@ -135,15 +138,16 @@     , withQueryCString     , withStatementHandle     )-import Database.DuckDB.Simple.ToField (FieldBinding, NamedParam (..), ToField (..), bindFieldBinding, renderFieldBinding)+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 (..), (:.) (..)) import Foreign.C.String (CString, peekCString, withCString)-import Foreign.C.Types (CBool (..), CDouble (..))+import Foreign.C.Types (CBool (..)) import Foreign.Marshal.Alloc (alloca, free, malloc) import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr)-import Foreign.Storable (peek, peekElemOff, poke)+import Foreign.Storable (Storable (..), peekElemOff, peekByteOff, pokeByteOff) import Database.DuckDB.Simple.Ok (Ok(..))+import qualified Data.UUID as UUID  -- | Open a DuckDB database located at the supplied path. open :: FilePath -> IO Connection@@ -537,7 +541,7 @@     withStatementHandle stmt \handle -> do         columns <- collectStreamColumns handle         resultPtr <- malloc-        rc <- c_duckdb_execute_prepared_streaming handle resultPtr+        rc <- c_duckdb_execute_prepared handle resultPtr         if rc /= DuckDBSuccess             then do                 (errMsg, errType) <- fetchResultError resultPtr@@ -582,7 +586,7 @@  fetchChunk :: StatementStream -> IO StatementStream fetchChunk stream@StatementStream{statementStreamResult} = do-    chunk <- c_duckdb_stream_fetch_chunk statementStreamResult+    chunk <- c_duckdb_fetch_chunk statementStreamResult     if chunk == nullPtr         then pure stream         else do@@ -638,7 +642,7 @@     zipWithM (buildField queryText rowIdx) columns vectors  buildField :: Query -> Int -> StatementStreamColumn -> StatementStreamChunkVector -> IO Field-buildField queryText rowIdx column StatementStreamChunkVector{statementStreamChunkVectorData, statementStreamChunkVectorValidity} = do+buildField queryText rowIdx column StatementStreamChunkVector{statementStreamChunkVectorHandle, statementStreamChunkVectorData, statementStreamChunkVectorValidity} = do     let duckIdx = fromIntegral rowIdx         dtype = statementStreamColumnType column     valid <- chunkIsRowValid statementStreamChunkVectorValidity duckIdx@@ -695,8 +699,16 @@                     raw <- peekElemOff (castPtr statementStreamChunkVectorData :: Ptr Double) rowIdx                     pure (FieldDouble raw)                 DuckDBTypeVarchar -> FieldText <$> chunkDecodeText statementStreamChunkVectorData duckIdx-                DuckDBTypeHugeInt -> error "duckdb-simple: HUGEINT is not supported"-                DuckDBTypeUHugeInt -> error "duckdb-simple: HUGEINT is not supported"+                DuckDBTypeList -> FieldList <$> decodeListElements statementStreamChunkVectorHandle statementStreamChunkVectorData rowIdx+                DuckDBTypeMap -> FieldMap <$> decodeMapPairs statementStreamChunkVectorHandle statementStreamChunkVectorData rowIdx+                DuckDBTypeStruct -> error "duckdb-simple: STRUCT columns are not supported"+                DuckDBTypeUnion -> error "duckdb-simple: UNION columns are not supported"+                DuckDBTypeHugeInt -> do+                    raw <- peekElemOff (castPtr statementStreamChunkVectorData :: Ptr DuckDBHugeInt) rowIdx+                    pure (FieldHugeInt (duckDBHugeIntToInteger raw))+                DuckDBTypeUHugeInt -> do+                    raw <- peekElemOff (castPtr statementStreamChunkVectorData :: Ptr DuckDBUHugeInt) rowIdx+                    pure (FieldUHugeInt (duckDBUHugeIntToInteger raw))                 _ ->                     throwIO (streamingUnsupportedTypeError queryText column)     pure@@ -1014,20 +1026,33 @@ collectRows :: Ptr DuckDBResult -> IO [[Field]] collectRows resPtr = do     columns <- collectResultColumns resPtr-    chunkCount <- (fromIntegral <$> c_duckdb_result_chunk_count resPtr) :: IO Int-    if null columns || chunkCount <= 0-        then pure []-        else do-            (_, chunks) <--                foldM-                    (\(rowBase, acc) chunkIdx -> do-                        (nextBase, chunkRows) <- collectChunkRows resPtr columns chunkIdx rowBase-                        pure (nextBase, chunkRows : acc)-                    )-                    (0, [])-                    [0 .. chunkCount - 1]-            pure (concat (reverse chunks))+    collectChunks columns []+  where+    collectChunks columns acc = do+        chunk <- c_duckdb_fetch_chunk resPtr+        if chunk == nullPtr+            then pure (concat (reverse acc))+            else do+                rows <-+                    finally+                        (decodeChunk columns chunk)+                        (destroyDataChunk chunk)+                let acc' = maybe acc (: acc) rows+                collectChunks columns acc' +    decodeChunk columns chunk = do+        rawSize <- c_duckdb_data_chunk_get_size chunk+        let rowCount = fromIntegral rawSize :: Int+        if rowCount <= 0+            then pure Nothing+            else+                if null columns+                    then pure (Just (replicate rowCount []))+                    else do+                        vectors <- prepareChunkVectors chunk columns+                        rows <- mapM (buildMaterializedRow columns vectors) [0 .. rowCount - 1]+                        pure (Just rows)+ collectResultColumns :: Ptr DuckDBResult -> IO [StatementStreamColumn] collectResultColumns resPtr = do     rawCount <- c_duckdb_column_count resPtr@@ -1046,32 +1071,6 @@                 , statementStreamColumnType = dtype                 } -collectChunkRows :: Ptr DuckDBResult -> [StatementStreamColumn] -> Int -> Int -> IO (Int, [[Field]])-collectChunkRows resPtr columns chunkIndex rowBase = do-    chunk <- c_duckdb_result_get_chunk resPtr (fromIntegral chunkIndex)-    if chunk == nullPtr-        then pure (rowBase, [])-        else-            finally-                (do-                    rawSize <- c_duckdb_data_chunk_get_size chunk-                    let rowCount = fromIntegral rawSize :: Int-                    when (rowCount > 0 && not (null columns)) $-                        void $-                            fetchFieldValue-                                resPtr-                                (statementStreamColumnType (head columns))-                                (statementStreamColumnIndex (head columns))-                                rowBase-                    if rowCount <= 0-                        then pure (rowBase, [])-                        else do-                            vectors <- prepareChunkVectors chunk columns-                            rows <- mapM (buildMaterializedRow columns vectors) [0 .. rowCount - 1]-                            pure (rowBase + rowCount, rows)-                )-                (destroyDataChunk chunk)- buildMaterializedRow :: [StatementStreamColumn] -> [StatementStreamChunkVector] -> Int -> IO [Field] buildMaterializedRow columns vectors rowIdx =     zipWithM (buildMaterializedField rowIdx) columns vectors@@ -1092,41 +1091,87 @@             , fieldValue = value             } -fetchFieldValue :: Ptr DuckDBResult -> DuckDBType -> Int -> Int -> IO FieldValue-fetchFieldValue resPtr dtype columnIndex rowIndex =-    withChunkForRow resPtr rowIndex \chunk localRow -> do-        vector <- c_duckdb_data_chunk_get_vector chunk (fromIntegral columnIndex)-        dataPtr <- c_duckdb_vector_get_data vector-        validity <- c_duckdb_vector_get_validity vector-        materializedValueFromPointers dtype vector dataPtr validity localRow+data DuckDBListEntry = DuckDBListEntry+    { duckDBListEntryOffset :: !Word64+    , duckDBListEntryLength :: !Word64+    }+    deriving (Eq, Show) -withChunkForRow :: Ptr DuckDBResult -> Int -> (DuckDBDataChunk -> Int -> IO a) -> IO a-withChunkForRow resPtr targetRow action = do-    chunkCount <- (fromIntegral <$> c_duckdb_result_chunk_count resPtr) :: IO Int-    let seek chunkIdx remaining-            | chunkIdx >= chunkCount =-                throwIO (userError "duckdb-simple: row index out of bounds while materialising result")-            | otherwise = do-                chunk <- c_duckdb_result_get_chunk resPtr (fromIntegral chunkIdx)-                if chunk == nullPtr-                    then seek (chunkIdx + 1) remaining-                    else do-                        rawSize <- c_duckdb_data_chunk_get_size chunk-                        let rowCount = fromIntegral rawSize :: Int-                        if rowCount <= 0-                            then do-                                destroyDataChunk chunk-                                seek (chunkIdx + 1) remaining-                            else if remaining < rowCount-                                then-                                    finally-                                        (action chunk remaining)-                                        (destroyDataChunk chunk)-                                else do-                                    destroyDataChunk chunk-                                    seek (chunkIdx + 1) (remaining - rowCount)-    seek 0 targetRow+instance Storable DuckDBListEntry where+    sizeOf _ = listEntryWordSize * 2+    alignment _ = alignment (0 :: Word64)+    peek ptr = do+        offset <- peekByteOff ptr 0+        len <- peekByteOff ptr listEntryWordSize+        pure DuckDBListEntry{duckDBListEntryOffset = offset, duckDBListEntryLength = len}+    poke ptr DuckDBListEntry{duckDBListEntryOffset, duckDBListEntryLength} = do+        pokeByteOff ptr 0 duckDBListEntryOffset+        pokeByteOff ptr listEntryWordSize duckDBListEntryLength +listEntryWordSize :: Int+listEntryWordSize = sizeOf (0 :: Word64)++decodeListElements :: DuckDBVector -> Ptr () -> Int -> IO [FieldValue]+decodeListElements vector dataPtr rowIdx = do+    entry <- peekElemOff (castPtr dataPtr :: Ptr DuckDBListEntry) rowIdx+    (baseIdx, len) <- listEntryBounds (Text.pack "list") entry+    childVec <- c_duckdb_list_vector_get_child vector+    when (childVec == nullPtr) $+        throwIO (userError "duckdb-simple: list child vector is null")+    childType <- vectorElementType childVec+    childData <- c_duckdb_vector_get_data childVec+    childValidity <- c_duckdb_vector_get_validity childVec+    forM [0 .. len - 1] \delta ->+        materializedValueFromPointers childType childVec childData childValidity (baseIdx + delta)++decodeMapPairs :: DuckDBVector -> Ptr () -> Int -> IO [(FieldValue, FieldValue)]+decodeMapPairs vector dataPtr rowIdx = do+    entry <- peekElemOff (castPtr dataPtr :: Ptr DuckDBListEntry) rowIdx+    (baseIdx, len) <- listEntryBounds (Text.pack "map") entry+    structVec <- c_duckdb_list_vector_get_child vector+    when (structVec == nullPtr) $+        throwIO (userError "duckdb-simple: map struct vector is null")+    keyVec <- c_duckdb_struct_vector_get_child structVec 0+    valueVec <- c_duckdb_struct_vector_get_child structVec 1+    when (keyVec == nullPtr || valueVec == nullPtr) $+        throwIO (userError "duckdb-simple: map child vectors are null")+    keyType <- vectorElementType keyVec+    valueType <- vectorElementType valueVec+    keyData <- c_duckdb_vector_get_data keyVec+    valueData <- c_duckdb_vector_get_data valueVec+    keyValidity <- c_duckdb_vector_get_validity keyVec+    valueValidity <- c_duckdb_vector_get_validity valueVec+    forM [0 .. len - 1] \delta -> do+        let childIdx = baseIdx + delta+        keyValue <- materializedValueFromPointers keyType keyVec keyData keyValidity childIdx+        valueValue <- materializedValueFromPointers valueType valueVec valueData valueValidity childIdx+        pure (keyValue, valueValue)++vectorElementType :: DuckDBVector -> IO DuckDBType+vectorElementType vec = do+    logical <- c_duckdb_vector_get_column_type vec+    dtype <- c_duckdb_get_type_id logical+    destroyLogicalType logical+    pure dtype++listEntryBounds :: Text -> DuckDBListEntry -> IO (Int, Int)+listEntryBounds context DuckDBListEntry{duckDBListEntryOffset, duckDBListEntryLength} = do+    base <- ensureWithinIntRange (context <> Text.pack " offset") duckDBListEntryOffset+    len <- ensureWithinIntRange (context <> Text.pack " length") duckDBListEntryLength+    let maxInt = toInteger (maxBound :: Int)+        upperBound = toInteger base + toInteger len - 1+    when (len > 0 && upperBound > maxInt) $+        throwIO (userError ("duckdb-simple: " <> Text.unpack context <> " bounds exceed Int range"))+    pure (base, len)++ensureWithinIntRange :: Text -> Word64 -> IO Int+ensureWithinIntRange context value =+    let actual = toInteger value+        limit = toInteger (maxBound :: Int)+     in if actual <= limit+            then pure (fromInteger actual)+            else throwIO (userError ("duckdb-simple: " <> Text.unpack context <> " exceeds Int range"))+ materializedValueFromPointers :: DuckDBType -> DuckDBVector -> Ptr () -> Ptr Word64 -> Int -> IO FieldValue materializedValueFromPointers dtype vector dataPtr validity rowIdx = do     let duckIdx = fromIntegral rowIdx :: DuckDBIdx@@ -1134,23 +1179,6 @@     if not valid         then pure FieldNull         else do-            (decimalInfo, enumInternal) <--                if dtype == DuckDBTypeDecimal || dtype == DuckDBTypeEnum-                    then do-                        logical <- c_duckdb_vector_get_column_type vector-                        info <--                            case dtype of-                                DuckDBTypeDecimal -> do-                                    width <- c_duckdb_decimal_width logical-                                    scale <- c_duckdb_decimal_scale logical-                                    pure (Just (width, scale), Nothing)-                                DuckDBTypeEnum -> do-                                    internal <- c_duckdb_enum_internal_type logical-                                    pure (Nothing, Just internal)-                                _ -> pure (Nothing, Nothing)-                        destroyLogicalType logical-                        pure info-                    else pure (Nothing, Nothing)             case dtype of                 DuckDBTypeBoolean -> do                     raw <- peekElemOff (castPtr dataPtr :: Ptr Word8) rowIdx@@ -1186,7 +1214,11 @@                     raw <- peekElemOff (castPtr dataPtr :: Ptr Double) rowIdx                     pure (FieldDouble raw)                 DuckDBTypeVarchar -> FieldText <$> chunkDecodeText dataPtr duckIdx-                DuckDBTypeUUID -> FieldText <$> chunkDecodeText dataPtr duckIdx+                DuckDBTypeUUID -> do+                    DuckDBUHugeInt lower upper_biased <-+                      peekElemOff (castPtr dataPtr :: Ptr DuckDBUHugeInt) rowIdx+                    let upper = upper_biased `xor` (0x8000000000000000 :: Word64)+                    return $ FieldUUID $ UUID.fromWords64 (fromIntegral upper) lower                 DuckDBTypeBlob -> FieldBlob <$> chunkDecodeBlob dataPtr duckIdx                 DuckDBTypeDate -> do                     raw <- peekElemOff (castPtr dataPtr :: Ptr Int32) rowIdx@@ -1219,13 +1251,24 @@                     raw <- peekElemOff (castPtr dataPtr :: Ptr DuckDBInterval) rowIdx                     pure (FieldInterval (intervalValueFromDuckDB raw))                 DuckDBTypeDecimal -> do-                    raw <- peekElemOff (castPtr dataPtr :: Ptr DuckDBDecimal) rowIdx-                    case decimalInfo of-                        Just (width, scale) -> do-                            decimal <- decimalValueFromDuckDB width scale raw-                            pure (FieldDecimal decimal)-                        Nothing ->-                            error "duckdb-simple: missing decimal metadata for result vector"+                    bracket (c_duckdb_vector_get_column_type vector)+                            (\lty -> alloca $ \ptr -> poke ptr lty >> c_duckdb_destroy_logical_type ptr) $+                              \logical -> do+                                 width <- c_duckdb_decimal_width logical+                                 scale <- c_duckdb_decimal_scale logical+                                 internal_ty <- c_duckdb_decimal_internal_type logical+                                 raw <- case internal_ty of+                                     DuckDBTypeSmallInt ->+                                         toInteger <$> peekElemOff (castPtr dataPtr :: Ptr Int16) rowIdx+                                     DuckDBTypeInteger ->+                                         toInteger <$> peekElemOff (castPtr dataPtr :: Ptr Int32) rowIdx+                                     DuckDBTypeBigInt ->+                                         toInteger <$> peekElemOff (castPtr dataPtr :: Ptr Int64) rowIdx+                                     DuckDBTypeHugeInt ->+                                         toInteger . duckDBHugeIntToInteger <$>+                                            peekElemOff (castPtr dataPtr :: Ptr DuckDBHugeInt) rowIdx+                                     _ -> error "duckdb-simple: unsupported decimal internal storage type"+                                 pure (FieldDecimal (DecimalValue width scale raw))                 DuckDBTypeHugeInt -> do                     raw <- peekElemOff (castPtr dataPtr :: Ptr DuckDBHugeInt) rowIdx                     pure (FieldHugeInt (duckDBHugeIntToInteger raw))@@ -1233,24 +1276,52 @@                     raw <- peekElemOff (castPtr dataPtr :: Ptr DuckDBUHugeInt) rowIdx                     pure (FieldUHugeInt (duckDBUHugeIntToInteger raw))                 DuckDBTypeBit -> do-                    raw <- peekElemOff (castPtr dataPtr :: Ptr DuckDBBit) rowIdx-                    FieldBit <$> decodeDuckDBBit raw+                    -- Same deal as with bignum, we need to manually decode the string_t+                    let base = castPtr dataPtr :: Ptr Word8+                        -- luckily, the underlying data has only one field, which is a string_t+                        offset = fromIntegral rowIdx * duckdbStringTSize+                        stringPtr = castPtr (base `plusPtr` offset) :: Ptr DuckDBStringT+                    len <- c_duckdb_string_t_length stringPtr+                    ptr <- c_duckdb_string_t_data stringPtr+                    bs <- BS.unpack <$> BS.packCStringLen (ptr, fromIntegral len)+                    case bs of+                       [] -> return $ FieldBit (BitString 0 BS.empty)+                       [padding] -> return $ FieldBit (BitString padding BS.empty)+                       (padding:b:bits) -> do+                           let tc = [(8-fromIntegral padding)..7]+                               cleared = foldl clearBit b tc+                           return $ FieldBit $ BitString padding (BS.pack (cleared:bits))                 DuckDBTypeBigNum -> do-                    raw <- peekElemOff (castPtr dataPtr :: Ptr DuckDBBignum) rowIdx-                    FieldBigNum <$> decodeDuckDBBigNum raw+                    -- Here we have to get messy, because DuckDB returns a pointer+                    -- to a bignum_t and not a duckdb_bignum.+                    let base = castPtr dataPtr :: Ptr Word8+                        -- luckily, the underlying data has only one field, which is a string_t+                        offset = fromIntegral rowIdx * duckdbStringTSize+                        stringPtr = castPtr (base `plusPtr` offset) :: Ptr DuckDBStringT+                    len <- c_duckdb_string_t_length stringPtr+                    if len < 3+                    then return $ FieldBigNum (BigNum 0)+                    else do ptr <- c_duckdb_string_t_data stringPtr+                            bs <- BS.unpack <$> BS.packCStringLen (ptr, fromIntegral len)+                            return $ FieldBigNum $ BigNum (fromBigNumBytes bs)+                DuckDBTypeList -> FieldList <$> decodeListElements vector dataPtr rowIdx+                DuckDBTypeMap -> FieldMap <$> decodeMapPairs vector dataPtr rowIdx+                DuckDBTypeStruct -> error "duckdb-simple: STRUCT columns are not supported"+                DuckDBTypeUnion -> error "duckdb-simple: UNION columns are not supported"                 DuckDBTypeEnum -> do-                    case enumInternal of-                        Just DuckDBTypeUTinyInt -> do-                            raw <- peekElemOff (castPtr dataPtr :: Ptr Word8) rowIdx-                            pure (FieldEnum (fromIntegral raw))-                        Just DuckDBTypeUSmallInt -> do-                            raw <- peekElemOff (castPtr dataPtr :: Ptr Word16) rowIdx-                            pure (FieldEnum (fromIntegral raw))-                        Just DuckDBTypeUInteger -> do-                            raw <- peekElemOff (castPtr dataPtr :: Ptr Word32) rowIdx-                            pure (FieldEnum raw)-                        _ ->-                            error "duckdb-simple: unsupported enum internal storage type"+                    bracket (c_duckdb_vector_get_column_type vector)+                            (\lty -> alloca $ \ptr -> poke ptr lty >> c_duckdb_destroy_logical_type ptr) $+                            \logical -> do+                              enumInternal <- c_duckdb_enum_internal_type logical+                              FieldEnum <$>+                                case enumInternal of+                                    DuckDBTypeUTinyInt -> do+                                        fromIntegral <$> peekElemOff (castPtr dataPtr :: Ptr Word8) rowIdx+                                    DuckDBTypeUSmallInt -> do+                                        fromIntegral <$> peekElemOff (castPtr dataPtr :: Ptr Word16) rowIdx+                                    DuckDBTypeUInteger -> do+                                        fromIntegral <$> peekElemOff (castPtr dataPtr :: Ptr Word32) rowIdx+                                    _ -> error "duckdb-simple: unsupported enum internal storage type"                 DuckDBTypeSQLNull ->                     pure FieldNull                 DuckDBTypeStringLiteral -> FieldText <$> chunkDecodeText dataPtr duckIdx@@ -1347,19 +1418,6 @@         , intervalMicros = duckDBIntervalMicros         } -decimalValueFromDuckDB :: Word8 -> Word8 -> DuckDBDecimal -> IO DecimalValue-decimalValueFromDuckDB width scale rawDecimal =-    alloca \ptr -> do-        let decimal = rawDecimal{duckDBDecimalWidth = width, duckDBDecimalScale = scale}-        poke ptr decimal-        CDouble approx <- c_duckdb_decimal_to_double ptr-        pure-            DecimalValue-                { decimalWidth = width-                , decimalScale = scale-                , decimalInteger = duckDBHugeIntToInteger (duckDBDecimalValue decimal)-                , decimalApproximate = realToFrac approx-                }  duckDBHugeIntToInteger :: DuckDBHugeInt -> Integer duckDBHugeIntToInteger DuckDBHugeInt{duckDBHugeIntLower, duckDBHugeIntUpper} =@@ -1368,25 +1426,6 @@ duckDBUHugeIntToInteger :: DuckDBUHugeInt -> Integer duckDBUHugeIntToInteger DuckDBUHugeInt{duckDBUHugeIntLower, duckDBUHugeIntUpper} =     (fromIntegral duckDBUHugeIntUpper `shiftL` 64) .|. fromIntegral duckDBUHugeIntLower--decodeDuckDBBit :: DuckDBBit -> IO BitString-decodeDuckDBBit DuckDBBit{duckDBBitData, duckDBBitSize}-    | duckDBBitData == nullPtr || duckDBBitSize == 0 =-        pure BitString{bitStringLength = 0, bitStringBytes = BS.empty}-    | otherwise = do-        let bitLength = duckDBBitSize-            byteLength = fromIntegral ((bitLength + 7) `div` 8) :: Int-        bytes <- BS.packCStringLen (castPtr duckDBBitData, byteLength)-        pure BitString{bitStringLength = bitLength, bitStringBytes = bytes}--decodeDuckDBBigNum :: DuckDBBignum -> IO BigNum-decodeDuckDBBigNum DuckDBBignum{duckDBBignumData, duckDBBignumSize, duckDBBignumIsNegative}-    | duckDBBignumData == nullPtr || duckDBBignumSize == 0 =-        pure BigNum{bigNumIsNegative = duckDBBignumIsNegative /= 0, bigNumMagnitude = BS.empty}-    | otherwise = do-        let byteLength = fromIntegral duckDBBignumSize :: Int-        bytes <- BS.packCStringLen (castPtr duckDBBignumData, byteLength)-        pure BigNum{bigNumIsNegative = duckDBBignumIsNegative /= 0, bigNumMagnitude = bytes}  peekError :: Ptr CString -> IO Text peekError ptr = do

@@ -1,11 +1,13 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE StrictData #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}  {- | Module      : Database.DuckDB.Simple.FromField@@ -14,37 +16,47 @@ module Database.DuckDB.Simple.FromField (     Field (..),     FieldValue (..),-    BitString (..),+    BitString(..),+    bsFromBool,     BigNum (..),+    fromBigNumBytes,+    toBigNumBytes,     DecimalValue (..),     IntervalValue (..),     TimeWithZone (..),     ResultError (..),     FieldParser,     FromField (..),-    returnError+    returnError, ) where  import Control.Exception (Exception, SomeException (..))+import Data.Bits (Bits (..), finiteBitSize) import qualified Data.ByteString as BS+import Data.Data (Typeable, typeRep) import Data.Int (Int16, Int32, Int64, Int8)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Proxy (Proxy (..)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as TextEncoding import Data.Time.Calendar (Day) import Data.Time.Clock (UTCTime (..))-import Data.Time.LocalTime-    ( LocalTime (..)-    , TimeOfDay (..)-    , TimeZone (..)-    , localTimeToUTC-    , utc-    , utcToLocalTime-    )+import Data.Time.LocalTime (+    LocalTime (..),+    TimeOfDay (..),+    TimeZone (..),+    localTimeToUTC,+    utc,+    utcToLocalTime,+ ) import Data.Word (Word16, Word32, Word64, Word8)-import Database.DuckDB.Simple.Types (Null (..)) import Database.DuckDB.Simple.Ok-import Data.Data (Typeable, Proxy (..), typeRep)+import Database.DuckDB.Simple.Types (Null (..))+import GHC.Num.Integer (integerFromWordList)+import Numeric.Natural (Natural)+import qualified Data.UUID as UUID  -- | Internal representation of a column value. data FieldValue@@ -57,6 +69,7 @@     | FieldWord16 Word16     | FieldWord32 Word32     | FieldWord64 Word64+    | FieldUUID UUID.UUID     | FieldFloat Float     | FieldDouble Double     | FieldText Text@@ -74,13 +87,14 @@     | FieldBit BitString     | FieldBigNum BigNum     | FieldEnum Word32+    | FieldList [FieldValue]+    | FieldMap [(FieldValue, FieldValue)]     deriving (Eq, Show)  data DecimalValue = DecimalValue     { decimalWidth :: !Word8     , decimalScale :: !Word8     , decimalInteger :: !Integer-    , decimalApproximate :: !Double     }     deriving (Eq, Show) @@ -91,18 +105,92 @@     }     deriving (Eq, Show) -data BitString = BitString-    { bitStringLength :: !Word64-    , bitStringBytes :: !BS.ByteString-    }-    deriving (Eq, Show) -data BigNum = BigNum-    { bigNumIsNegative :: !Bool-    , bigNumMagnitude :: !BS.ByteString-    }-    deriving (Eq, Show)+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'.+-}+fromBigNumBytes :: [Word8] -> Integer+fromBigNumBytes bytes =+    let header = take 3 bytes+        payloadRaw = drop 3 bytes+        isNeg = head header .&. 0x80 == 0+        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+        (firstChunk, rest) = splitAt (len `mod` bytesPerWord) payload++        chunkWords [] = []+        chunkWords xs =+            let (chunk, remainder) = splitAt bytesPerWord xs+             in chunk : chunkWords remainder++        toWord = foldl (\acc b -> (acc `shiftL` 8) .|. fromIntegral b) 0+        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+  (sign bit plus payload length) followed by the magnitude bytes in the same+  big-endian / complemented-on-negative form that DuckDB stores internally.+-}+toBigNumBytes :: Integer -> [Word8]+toBigNumBytes value =+    let isNeg = value < 0+        magnitude = if isNeg then negate value else value+        payloadBE+            | magnitude == 0 = [0]+            | otherwise = go magnitude []+          where+            go 0 acc = acc+            go n acc =+                let (q, r) = quotRem n 256+                 in go q (fromIntegral r : acc)++        headerBase :: Word32+        headerBase = (fromIntegral (length payloadBE) .|. 0x00800000)+        headerVal :: Word32+        headerVal = if isNeg then complement headerBase else headerBase+        headerMasked = headerVal .&. 0x00FFFFFF+        headerBytes =+            [ fromIntegral ((headerMasked `shiftR` 16) .&. 0xFF)+            , fromIntegral ((headerMasked `shiftR` 8) .&. 0xFF)+            , fromIntegral (headerMasked .&. 0xFF)+            ]+        payloadBytes = if isNeg then map complement payloadBE else payloadBE+     in headerBytes <> payloadBytes++data BitString = BitString { padding :: !Word8+                           , bits :: !BS.ByteString}+    deriving stock (Eq)++instance Show BitString where+    show (BitString padding bits) =+        drop (fromIntegral padding) $ concatMap word8ToString $ BS.unpack bits+      where+        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+bsFromBool :: [Bool] -> BitString+bsFromBool bits =+    let totalBits = length bits+        padding = (8 - (totalBits `mod` 8)) `mod` 8+        paddedBits = replicate padding False ++ bits+        byteChunks = chunk 8 paddedBits+        byteValues = map bitsToWord8 byteChunks+     in BitString (fromIntegral padding) (BS.pack byteValues)+  where+    chunk _ [] = []+    chunk n xs = take n xs : chunk n (drop n xs)++    bitsToWord8 :: [Bool] -> Word8+    bitsToWord8 bs = foldl (\acc (b, i) -> if b then setBit acc i else acc) 0 (zip bs [7, 6 .. 0])++ data TimeWithZone = TimeWithZone     { timeWithZoneTime :: !TimeOfDay     , timeWithZoneZone :: !TimeZone@@ -143,38 +231,45 @@     }     deriving (Eq, Show) --- | Exception thrown if conversion from a SQL value to a Haskell--- value fails.-data ResultError = Incompatible { errSQLType :: Text-                                , errSQLField :: Text-                                , errHaskellType :: Text-                                , errMessage :: Text }-                 -- ^ The SQL and Haskell types are not compatible.-                 | UnexpectedNull { errSQLType :: Text-                                  , errSQLField :: Text-                                  , errHaskellType :: Text-                                  , errMessage :: Text }-                 -- ^ A SQL @NULL@ was encountered when the Haskell-                 -- type did not permit it.-                 | ConversionFailed { 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).-                   deriving (Eq, Show, Typeable)+{- | Exception thrown if conversion from a SQL value to a Haskell+value fails.+-}+data ResultError+    = -- | The SQL and Haskell types are not compatible.+      Incompatible+        { errSQLType :: Text+        , errSQLField :: Text+        , errHaskellType :: Text+        , errMessage :: Text+        }+    | -- | 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).+      ConversionFailed+        { errSQLType :: Text+        , errSQLField :: Text+        , errHaskellType :: Text+        , errMessage :: Text+        }+    deriving (Eq, Show, Typeable)  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--- conversion fails.+{- | 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  -- | Types that can be constructed from a DuckDB column.@@ -188,8 +283,19 @@     fromField f@Field{fieldValue} =         case fieldValue of             FieldNull -> Ok Null-            _ ->  returnError Incompatible f "expected NULL"+            _ -> returnError Incompatible f "expected NULL" +instance FromField UUID.UUID where+    fromField f@Field{fieldValue} =+        case fieldValue of+            FieldText t ->+                case UUID.fromText t of+                    Just uuid -> Ok uuid+                    Nothing -> returnError ConversionFailed f "invalid UUID format"+            FieldUUID uuid -> Ok uuid+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""+ instance FromField Bool where     fromField f@Field{fieldValue} =         case fieldValue of@@ -253,18 +359,40 @@         case fieldValue of             FieldInt i -> Ok (fromIntegral i)             FieldWord w -> Ok (fromIntegral w)+            FieldBigNum (BigNum big) -> Ok big             FieldHugeInt value -> Ok value             FieldUHugeInt value -> Ok value             FieldNull -> returnError UnexpectedNull f ""             _ -> returnError Incompatible f "" +instance FromField Natural where+    fromField f@Field{fieldValue} =+        case fieldValue of+            FieldInt i+                | i >= 0 -> Ok (fromIntegral i)+                | otherwise ->+                    returnError ConversionFailed f "negative value cannot be converted to Natural"+            FieldWord w -> Ok (fromIntegral w)+            FieldHugeInt value+                | value >= 0 -> Ok (fromIntegral value)+                | otherwise ->+                    returnError ConversionFailed f "negative value cannot be converted to Natural"+            FieldUHugeInt value -> Ok (fromIntegral value)+            FieldBigNum (BigNum big) ->+                if big >= 0+                    then Ok $ fromIntegral big+                    else returnError ConversionFailed f "negative value cannot be converted to Natural"+            FieldEnum value -> Ok (fromIntegral value)+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""+ instance FromField Word64 where     fromField f@Field{fieldValue} =         case fieldValue of             FieldInt i                 | i >= 0 -> Ok (fromIntegral i)                 | otherwise ->-                     returnError ConversionFailed f "negative value cannot be converted to unsigned integer"+                    returnError ConversionFailed f "negative value cannot be converted to unsigned integer"             FieldWord w -> Ok (fromIntegral w)             FieldHugeInt value                 | value >= 0 -> boundedFromInteger f value@@ -348,7 +476,8 @@         case fieldValue of             FieldDouble d -> Ok d             FieldInt i -> Ok (fromIntegral i)-            FieldDecimal DecimalValue{decimalApproximate} -> Ok decimalApproximate+            FieldDecimal DecimalValue{decimalInteger, decimalScale} ->+                Ok (realToFrac decimalInteger / 10 ^ decimalScale)             FieldNull -> returnError UnexpectedNull f ""             _ -> returnError Incompatible f "" @@ -376,14 +505,14 @@         case fieldValue of             FieldBlob bs -> Ok bs             FieldText t -> Ok (TextEncoding.encodeUtf8 t)-            FieldBit bit -> Ok (bitStringBytes bit)+            FieldBit (BitString _ bits) -> Ok bits             FieldNull -> returnError UnexpectedNull f ""             _ -> returnError Incompatible f ""  instance FromField BitString where     fromField f@Field{fieldValue} =         case fieldValue of-            FieldBit bit -> Ok bit+            FieldBit b -> Ok b             FieldNull -> returnError UnexpectedNull f ""             _ -> returnError Incompatible f "" @@ -394,6 +523,53 @@             FieldNull -> returnError UnexpectedNull f ""             _ -> returnError Incompatible f "" +instance {-# OVERLAPPABLE #-} (Typeable a, FromField a) => FromField [a] where+    fromField f@Field{fieldValue} =+        case fieldValue of+            FieldList entries ->+                traverse (uncurry parseElement) (zip [0 :: Int ..] entries)+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""+      where+        parseElement idx value =+            fromField+                Field+                    { fieldName = fieldNameWithIndex idx+                    , fieldIndex = fieldIndex f+                    , fieldValue = value+                    }+        fieldNameWithIndex idx =+            let base = fieldName f+                idxText = Text.pack (show idx)+             in base <> Text.pack "[" <> idxText <> Text.pack "]"++instance (Ord k, Typeable k, Typeable v, FromField k, FromField v) => FromField (Map k v) where+    fromField f@Field{fieldValue} =+        case fieldValue of+            FieldMap pairs -> Map.fromList <$> traverse (uncurry parsePair) (zip [0 :: Int ..] pairs)+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""+      where+        parsePair idx (keyValue, valValue) = do+            key <-+                fromField+                    Field+                        { fieldName = fieldName f <> suffix idx ".key"+                        , fieldIndex = fieldIndex f+                        , fieldValue = keyValue+                        }+            value <-+                fromField+                    Field+                        { fieldName = fieldName f <> suffix idx ".value"+                        , fieldIndex = fieldIndex f+                        , fieldValue = valValue+                        }+            pure (key, value)+        suffix idx label =+            let idxText = Text.pack (show idx)+             in Text.pack "[" <> idxText <> Text.pack "]" <> Text.pack label+ instance FromField DecimalValue where     fromField f@Field{fieldValue} =         case fieldValue of@@ -425,7 +601,7 @@             _ -> returnError Incompatible f ""  instance FromField LocalTime where-    fromField f@Field{ fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldTimestamp ts -> Ok ts             FieldDate day -> Ok (LocalTime day midnight)@@ -474,15 +650,19 @@         returnError ConversionFailed f "integer value out of bounds"     | otherwise = Ok (fromInteger value) --- | Helper to construct a ResultError with field context.--- based on postgresql-simple's implementation+{- | Helper to construct a ResultError with field context.+based on postgresql-simple's implementation+-} returnError :: forall b. (Typeable b) => (Text -> Text -> Text -> Text -> ResultError) -> Field -> Text -> Ok b returnError mkError Field{fieldValue, fieldName} msg =-    Errors [SomeException $ mkError (fieldValueTypeName fieldValue)-                                    fieldName-                                    (Text.pack $ show (typeRep (Proxy :: Proxy b)))-                                    msg]-+    Errors+        [ SomeException $+            mkError+                (fieldValueTypeName fieldValue)+                fieldName+                (Text.pack $ show (typeRep (Proxy :: Proxy b)))+                msg+        ]  fieldValueTypeName :: FieldValue -> Text fieldValueTypeName = \case@@ -512,3 +692,6 @@     FieldBit{} -> "BIT"     FieldBigNum{} -> "BIGNUM"     FieldEnum{} -> "ENUM"+    FieldList{} -> "LIST"+    FieldMap{} -> "MAP"+    FieldUUID{} -> "UUID"

@@ -5,8 +5,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}  {- | Module      : Database.DuckDB.Simple.FromRow@@ -122,7 +122,7 @@             Ok (value, (columnCount, _))                 | columnCount == length fields -> Ok value                 | otherwise -> Errors [SomeException $ ColumnOutOfBounds (columnCount + 1)]-            Errors errs ->  Errors errs+            Errors errs -> Errors errs  instance FromRow () where     fromRow = pure ()@@ -255,26 +255,26 @@ renderError :: ResultError -> Text renderError = \case     Incompatible{errSQLType, errSQLField, errHaskellType, errMessage} ->-            Text.concat-                [ "duckdb-simple: column "-                , errSQLField-                , " has type "-                , errSQLType-                , " but expected "-                , errHaskellType-                , if Text.null errMessage-                  then ""-                  else ": " <> errMessage-                ]+        Text.concat+            [ "duckdb-simple: column "+            , errSQLField+            , " has type "+            , errSQLType+            , " but expected "+            , errHaskellType+            , if Text.null errMessage+                then ""+                else ": " <> errMessage+            ]     UnexpectedNull{errHaskellType, errSQLField, errMessage} ->-            Text.concat-                [ "duckdb-simple: column "-                , errSQLField-                , " is NULL but expected "-                , errHaskellType-                , if Text.null errMessage-                  then ""-                  else ": " <> errMessage-                ]+        Text.concat+            [ "duckdb-simple: column "+            , errSQLField+            , " is NULL but expected "+            , errHaskellType+            , if Text.null errMessage+                then ""+                else ": " <> errMessage+            ]     ConversionFailed{errMessage} ->         errMessage

@@ -31,51 +31,52 @@     try,  ) import Control.Monad (forM, forM_, when)+import Data.Bits (shiftL, (.|.), clearBit) import qualified Data.ByteString as BS-import Data.Bits ((.|.), shiftL) import Data.Int (Int16, Int32, Int64, Int8)-import Data.Ratio ((%)) import Data.Proxy (Proxy (..))+import Data.Ratio ((%)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as TE import qualified Data.Text.Foreign as TextForeign-import Data.Word (Word16, Word32, Word64, Word8) 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 Data.Word (Word16, Word32, Word64, Word8) import Database.DuckDB.FFI-import Database.DuckDB.Simple.FromField-    ( BigNum (..)-    , BitString (..)-    , DecimalValue (..)-    , Field (..)-    , FieldValue (..)-    , FromField (..)-    , IntervalValue (..)-    , TimeWithZone (..)-    )-import Database.DuckDB.Simple.Internal-    ( Connection-    , Query (..)-    , SQLError (..)-    , withConnectionHandle-    , withQueryCString-    )+import Database.DuckDB.Simple.FromField (+    BigNum (..),+    BitString (..),+    DecimalValue (..),+    Field (..),+    FieldValue (..),+    FromField (..),+    IntervalValue (..),+    TimeWithZone (..),+    fromBigNumBytes,+ )+import Database.DuckDB.Simple.Internal (+    Connection,+    Query (..),+    SQLError (..),+    withConnectionHandle,+    withQueryCString,+ )+import Database.DuckDB.Simple.Ok (Ok (..)) import Foreign.C.String (peekCString)-import Foreign.C.Types (CBool (..), CDouble (..))+import Foreign.C.Types (CBool (..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (Ptr, castPtr, freeHaskellFunPtr, nullPtr, plusPtr) import Foreign.StablePtr (StablePtr, castPtrToStablePtr, castStablePtrToPtr, deRefStablePtr, freeStablePtr, newStablePtr) import Foreign.Storable (peek, peekElemOff, poke, pokeElemOff)-import Database.DuckDB.Simple.Ok (Ok(..))  -- | Tag DuckDB logical types we support for scalar return values. data ScalarType@@ -502,11 +503,32 @@                             functionInvocationError $                                 Text.pack "duckdb-simple: missing decimal metadata for scalar function argument"             DuckDBTypeBit -> do-                value <- peekElemOff (castPtr dataPtr :: Ptr DuckDBBit) idx-                FieldBit <$> decodeDuckDBBit value+                -- Same deal as with bignum, we need to manually decode the string_t+                let base = castPtr dataPtr :: Ptr Word8+                    -- luckily, the underlying data has only one field, which is a string_t+                    offset = fromIntegral rowIdx * duckdbStringTSize+                    stringPtr = castPtr (base `plusPtr` offset) :: Ptr DuckDBStringT+                len <- c_duckdb_string_t_length stringPtr+                ptr <- c_duckdb_string_t_data stringPtr+                bs <- BS.unpack <$> BS.packCStringLen (ptr, fromIntegral len)+                case bs of+                    [] -> return $ FieldBit (BitString 0 BS.empty)+                    [padding] -> return $ FieldBit (BitString padding BS.empty)+                    (padding:b:bits) ->+                        let cleared = foldl clearBit b [0..fromIntegral padding -1]+                        in return $ FieldBit $ BitString padding (BS.pack (cleared:bits))             DuckDBTypeBigNum -> do-                value <- peekElemOff (castPtr dataPtr :: Ptr DuckDBBignum) idx-                FieldBigNum <$> decodeDuckDBBigNum value+                let base = castPtr dataPtr :: Ptr Word8+                    -- luckily, the underlying data has only one field, which is a string_t+                    offset = fromIntegral rowIdx * duckdbStringTSize+                    stringPtr = castPtr (base `plusPtr` offset) :: Ptr DuckDBStringT+                len <- c_duckdb_string_t_length stringPtr+                if len < 3+                    then return $ FieldBigNum (BigNum 0)+                    else do+                        ptr <- c_duckdb_string_t_data stringPtr+                        bs <- BS.unpack <$> BS.packCStringLen (ptr, fromIntegral len)+                        return $ FieldBigNum $ BigNum (fromBigNumBytes bs)             DuckDBTypeEnum -> do                 case enumInternal of                     Just DuckDBTypeUTinyInt -> do@@ -652,18 +674,14 @@         }  decimalValueFromDuckDB :: Word8 -> Word8 -> DuckDBDecimal -> IO DecimalValue-decimalValueFromDuckDB width scale rawDecimal =-    alloca \ptr -> do-        let decimal = rawDecimal{duckDBDecimalWidth = width, duckDBDecimalScale = scale}-        poke ptr decimal-        CDouble approx <- c_duckdb_decimal_to_double ptr-        pure-            DecimalValue-                { decimalWidth = width-                , decimalScale = scale-                , decimalInteger = duckDBHugeIntToInteger (duckDBDecimalValue decimal)-                , decimalApproximate = realToFrac approx-                }+decimalValueFromDuckDB width scale rawDecimal = do+    let decimal = rawDecimal{duckDBDecimalWidth = width, duckDBDecimalScale = scale}+    pure+        DecimalValue+            { decimalWidth = width+            , decimalScale = scale+            , decimalInteger = duckDBHugeIntToInteger (duckDBDecimalValue decimal)+            }  duckDBHugeIntToInteger :: DuckDBHugeInt -> Integer duckDBHugeIntToInteger DuckDBHugeInt{duckDBHugeIntLower, duckDBHugeIntUpper} =@@ -672,25 +690,6 @@ duckDBUHugeIntToInteger :: DuckDBUHugeInt -> Integer duckDBUHugeIntToInteger DuckDBUHugeInt{duckDBUHugeIntLower, duckDBUHugeIntUpper} =     (fromIntegral duckDBUHugeIntUpper `shiftL` 64) .|. fromIntegral duckDBUHugeIntLower--decodeDuckDBBit :: DuckDBBit -> IO BitString-decodeDuckDBBit DuckDBBit{duckDBBitData, duckDBBitSize}-    | duckDBBitData == nullPtr || duckDBBitSize == 0 =-        pure BitString{bitStringLength = 0, bitStringBytes = BS.empty}-    | otherwise = do-        let bitLength = duckDBBitSize-            byteLength = fromIntegral ((bitLength + 7) `div` 8) :: Int-        bytes <- BS.packCStringLen (castPtr duckDBBitData, byteLength)-        pure BitString{bitStringLength = bitLength, bitStringBytes = bytes}--decodeDuckDBBigNum :: DuckDBBignum -> IO BigNum-decodeDuckDBBigNum DuckDBBignum{duckDBBignumData, duckDBBignumSize, duckDBBignumIsNegative}-    | duckDBBignumData == nullPtr || duckDBBignumSize == 0 =-        pure BigNum{bigNumIsNegative = duckDBBignumIsNegative /= 0, bigNumMagnitude = BS.empty}-    | otherwise = do-        let byteLength = fromIntegral duckDBBignumSize :: Int-        bytes <- BS.packCStringLen (castPtr duckDBBignumData, byteLength)-        pure BigNum{bigNumIsNegative = duckDBBignumIsNegative /= 0, bigNumMagnitude = bytes}  writeResults :: ScalarType -> [ScalarValue] -> DuckDBVector -> IO () writeResults resultType values outVec = do

@@ -41,8 +41,8 @@ import qualified Data.Text.Foreign as TextForeign import Data.Word (Word64) import Database.DuckDB.FFI (-    DuckDBDataChunk,     DuckDBConnection,+    DuckDBDataChunk,     DuckDBDatabase,     DuckDBErrorType,     DuckDBPreparedStatement,@@ -67,7 +67,7 @@     fromString = Query . Text.pack  -- | Tracks the lifetime of a DuckDB database and connection pair.-newtype Connection = Connection { connectionState :: IORef ConnectionState }+newtype Connection = Connection {connectionState :: IORef ConnectionState}  -- | Internal connection lifecycle state. data ConnectionState@@ -136,12 +136,13 @@  instance Exception SQLError -toSQLError :: Exception e => e -> SQLError-toSQLError ex = SQLError-    { sqlErrorMessage = Text.pack (show ex)-    , sqlErrorType = Nothing-    , sqlErrorQuery = Nothing-    }+toSQLError :: (Exception e) => e -> SQLError+toSQLError ex =+    SQLError+        { sqlErrorMessage = Text.pack (show ex)+        , sqlErrorType = Nothing+        , sqlErrorQuery = Nothing+        }  -- | Shared error value used when an operation targets a closed connection. connectionClosedError :: SQLError

@@ -1,8 +1,10 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}  {- | Module      : Database.DuckDB.Simple.ToField@@ -14,15 +16,19 @@ module Database.DuckDB.Simple.ToField (     FieldBinding,     ToField (..),+    DuckDBColumnType (..),     NamedParam (..),+    duckdbColumnType,     bindFieldBinding,     renderFieldBinding, ) where  import Control.Exception (bracket, throwIO) import Control.Monad (when)+import Data.Bits (complement) import qualified Data.ByteString as BS import Data.Int (Int16, Int32, Int64)+import Data.Proxy (Proxy (..)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Foreign as TextForeign@@ -31,6 +37,7 @@ import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..), timeOfDayToTime, utc, utcToLocalTime) import Data.Word (Word16, Word32, Word64, Word8) import Database.DuckDB.FFI+import Database.DuckDB.Simple.FromField (BigNum (..), toBigNumBytes, BitString(..)) import Database.DuckDB.Simple.Internal (     SQLError (..),     Statement (..),@@ -39,9 +46,12 @@ import Database.DuckDB.Simple.Types (Null (..)) import Foreign.C.String (peekCString) import Foreign.C.Types (CDouble (..))+import Foreign.Marshal (fromBool) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Storable (poke)+import Numeric.Natural (Natural)+import qualified Data.UUID as UUID  -- | Represents a named parameter binding using the @:=@ operator. data NamedParam where@@ -55,6 +65,14 @@     , fieldBindingDisplay :: !String     } +-- | Types that map to a concrete DuckDB column type when used with 'ToField'.+class DuckDBColumnType a where+    duckdbColumnTypeFor :: Proxy a -> Text++-- | Report the DuckDB column type that best matches a given 'ToField' instance.+duckdbColumnType :: forall a. (DuckDBColumnType a) => Proxy a -> Text+duckdbColumnType = duckdbColumnTypeFor+ -- | Apply a 'FieldBinding' to the given statement/index. bindFieldBinding :: Statement -> DuckDBIdx -> FieldBinding -> IO () bindFieldBinding stmt idx FieldBinding{fieldBindingAction} = fieldBindingAction stmt idx@@ -71,12 +89,13 @@         }  -- | Types that can be used as positional parameters.-class ToField a where+class (DuckDBColumnType a) => ToField a where     toField :: a -> FieldBinding  instance ToField Null where     toField Null = nullBinding "NULL" + instance ToField Bool where     toField value =         mkFieldBinding (show value) $ \stmt idx ->@@ -94,20 +113,33 @@ instance ToField Int64 where     toField = intBinding +instance ToField BigNum where+    toField = bignumBinding++instance ToField UUID.UUID where+    toField = uuidBinding++instance ToField Integer where+    toField :: Integer -> FieldBinding+    toField = toField . BigNum++instance ToField Natural where+    toField = toField . BigNum . toInteger+ instance ToField Word where     toField value = uint64Binding (fromIntegral value)  instance ToField Word16 where-    toField value = uint16Binding value+    toField = uint16Binding  instance ToField Word32 where-    toField value = uint32Binding value+    toField = uint32Binding  instance ToField Word64 where-    toField value = uint64Binding value+    toField = uint64Binding  instance ToField Word8 where-    toField value = uint8Binding value+    toField = uint8Binding  instance ToField Double where     toField value =@@ -139,6 +171,12 @@                 TextForeign.withCString (Text.pack str) $ \cstr ->                     bindDuckValue stmt idx (c_duckdb_create_varchar cstr) +instance DuckDBColumnType BitString where+    duckdbColumnTypeFor _ = "BIT"++instance ToField BitString where+    toField = bitBinding+ instance ToField BS.ByteString where     toField bs =         mkFieldBinding@@ -190,6 +228,81 @@                 { fieldBindingDisplay = "Just " <> renderFieldBinding binding                 } +instance DuckDBColumnType Null where+    duckdbColumnTypeFor _ = "NULL"++instance DuckDBColumnType Bool where+    duckdbColumnTypeFor _ = "BOOLEAN"++instance DuckDBColumnType Int where+    duckdbColumnTypeFor _ = "BIGINT"++instance DuckDBColumnType Int16 where+    duckdbColumnTypeFor _ = "SMALLINT"++instance DuckDBColumnType Int32 where+    duckdbColumnTypeFor _ = "INTEGER"++instance DuckDBColumnType Int64 where+    duckdbColumnTypeFor _ = "BIGINT"++instance DuckDBColumnType BigNum where+    duckdbColumnTypeFor _ = "BIGNUM"++instance DuckDBColumnType UUID.UUID where+    duckdbColumnTypeFor _ = "UUID"++instance DuckDBColumnType Integer where+    duckdbColumnTypeFor _ = "BIGNUM"++instance DuckDBColumnType Natural where+    duckdbColumnTypeFor _ = "BIGNUM"++instance DuckDBColumnType Word where+    duckdbColumnTypeFor _ = "UBIGINT"++instance DuckDBColumnType Word8 where+    duckdbColumnTypeFor _ = "UTINYINT"++instance DuckDBColumnType Word16 where+    duckdbColumnTypeFor _ = "USMALLINT"++instance DuckDBColumnType Word32 where+    duckdbColumnTypeFor _ = "UINTEGER"++instance DuckDBColumnType Word64 where+    duckdbColumnTypeFor _ = "UBIGINT"++instance DuckDBColumnType Double where+    duckdbColumnTypeFor _ = "DOUBLE"++instance DuckDBColumnType Float where+    duckdbColumnTypeFor _ = "FLOAT"++instance DuckDBColumnType Text where+    duckdbColumnTypeFor _ = "TEXT"++instance DuckDBColumnType String where+    duckdbColumnTypeFor _ = "TEXT"++instance DuckDBColumnType BS.ByteString where+    duckdbColumnTypeFor _ = "BLOB"++instance DuckDBColumnType Day where+    duckdbColumnTypeFor _ = "DATE"++instance DuckDBColumnType TimeOfDay where+    duckdbColumnTypeFor _ = "TIME"++instance DuckDBColumnType LocalTime where+    duckdbColumnTypeFor _ = "TIMESTAMP"++instance DuckDBColumnType UTCTime where+    duckdbColumnTypeFor _ = "TIMESTAMPTZ"++instance (DuckDBColumnType a) => DuckDBColumnType (Maybe a) where+    duckdbColumnTypeFor _ = duckdbColumnTypeFor (Proxy :: Proxy a)+ -- | Helper for binding 'Null' values. nullBinding :: String -> FieldBinding nullBinding repr =@@ -232,6 +345,80 @@         (show value)         \stmt idx ->             bindDuckValue stmt idx (c_duckdb_create_uint8 value)++uuidBinding :: UUID.UUID -> FieldBinding+uuidBinding uuid =+    mkFieldBinding+        (show uuid)+        \stmt idx ->+            bindDuckValue stmt idx $+              alloca $ \ptr -> do+                let (upper, lower) = UUID.toWords64 uuid+                poke ptr DuckDBUHugeInt+                    { duckDBUHugeIntLower = lower+                    , duckDBUHugeIntUpper = upper+                    }+                c_duckdb_create_uuid ptr++bitBinding :: BitString -> FieldBinding+bitBinding (BitString padding bits) =+    mkFieldBinding+        (show (BitString padding bits))+        \stmt idx ->+            let w_padding = (fromIntegral padding :: Word8):BS.unpack bits+            in bindDuckValue stmt idx $+                  if BS.null bits+                        then alloca \ptr -> do+                            poke+                                ptr+                                DuckDBBit+                                    { duckDBBitData = nullPtr+                                    , duckDBBitSize = 0+                                    }+                            c_duckdb_create_bit ptr+                        else+                            BS.useAsCStringLen (BS.pack w_padding) \(rawPtr, len) ->+                            alloca \ptr -> do+                                poke+                                    ptr+                                    DuckDBBit+                                        { duckDBBitData = castPtr rawPtr+                                        , duckDBBitSize = fromIntegral len+                                        }+                                c_duckdb_create_bit ptr++bignumBinding :: BigNum -> FieldBinding+bignumBinding (BigNum big) =+    mkFieldBinding+        (show big)+        \stmt idx ->+            bindDuckValue stmt idx $+                let neg = fromBool (big < 0)+                    big_num_bytes =+                        BS.pack $+                            if big < 0+                                then map complement (drop 3 $ toBigNumBytes big)+                                else drop 3 $ toBigNumBytes big+                 in if BS.null big_num_bytes+                        then alloca \ptr -> do+                            poke+                                ptr+                                DuckDBBignum+                                    { duckDBBignumData = nullPtr+                                    , duckDBBignumSize = 0+                                    , duckDBBignumIsNegative = neg+                                    }+                            c_duckdb_create_bignum ptr+                        else BS.useAsCStringLen big_num_bytes \(rawPtr, len) ->+                            alloca \ptr -> do+                                poke+                                    ptr+                                    DuckDBBignum+                                        { duckDBBignumData = castPtr rawPtr+                                        , duckDBBignumSize = fromIntegral len+                                        , duckDBBignumIsNegative = neg+                                        }+                                c_duckdb_create_bignum ptr  encodeDay :: Day -> IO DuckDBDate encodeDay day =

@@ -11,14 +11,18 @@ module Main (main) where  import Control.Applicative ((<|>))-import Control.Exception (ErrorCall, Exception, try)+import Control.Exception (ErrorCall, Exception, SomeException, displayException, fromException, try) import Control.Monad (replicateM_) import qualified Data.ByteString as BS import Data.IORef (atomicModifyIORef', newIORef)-import Data.Int (Int64)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.List (sortOn)+import qualified Data.Map.Strict as Map+import Data.Proxy (Proxy (..))+import Data.String (fromString) import qualified Data.Text as Text import Data.Time.Calendar (fromGregorian)-import Data.Time.Clock (UTCTime (..))+import Data.Time.Clock (UTCTime (..), secondsToDiffTime) import Data.Time.LocalTime (     LocalTime (..),     TimeOfDay (..),@@ -28,17 +32,30 @@     utc,  ) import Data.Word (Word16, Word32, Word64, Word8)+import Data.Ratio ((%)) import Database.DuckDB.Simple import Database.DuckDB.Simple.FromField (+    BigNum (..),+    BitString (..),+    bsFromBool,+    DecimalValue (..),     Field (..),+    FieldValue (..),     IntervalValue (..),     TimeWithZone (..),+    fromBigNumBytes,     returnError,+    toBigNumBytes,  )+import Database.DuckDB.Simple.Ok (Ok (..)) import GHC.Generics (Generic)+import Numeric.Natural (Natural) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit-import Database.DuckDB.Simple.Ok (Ok(..))+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@@ -73,18 +90,18 @@                     let normalized = Text.toLower txt                      in if normalized == expected                             then Ok ()-                            else returnError  ConversionFailed fld "failed to match exact string"+                            else returnError ConversionFailed fld "failed to match exact string"  newtype NonEmptyText = NonEmptyText Text.Text     deriving (Eq, Show)  nonEmptyTextParser :: FieldParser NonEmptyText nonEmptyTextParser f@Field{} =-    case fromField f  of+    case fromField f of         Errors err -> Errors err         Ok txt             | Text.null txt ->-                returnError  ConversionFailed f "NonEmptyText requires a non-empty string"+                returnError ConversionFailed f "NonEmptyText requires a non-empty string"             | otherwise -> Ok (NonEmptyText txt)  instance FromField NonEmptyText where@@ -321,11 +338,255 @@                 assertEqual "yes/no parsing" [YesNo False, YesNo True] rows         ] +data DuckDBExpectation+    = ExpectEquals FieldValue+    | ExpectSatisfies (FieldValue -> Assertion)+    | ExpectException (SomeException -> Assertion)++data DuckDBExpression+    = CastExpression Text.Text Text.Text+    | DirectExpression Text.Text++data DuckDBCastCase = DuckDBCastCase+    { castLabel :: String+    , castExpression :: DuckDBExpression+    , castExpectation :: DuckDBExpectation+    , castExpectFailureReason :: Maybe String+    }++duckdbTypeCastTests :: TestTree+duckdbTypeCastTests =+    testGroup+        "duckdb type casts"+        (map buildCase duckdbCastCases)+  where+    buildCase DuckDBCastCase{castLabel, castExpression, castExpectation, castExpectFailureReason} =+        let base =+                testCase castLabel $+                    withConnection ":memory:" \conn -> do+                        let sql =+                                Query+                                    (case castExpression of+                                        CastExpression expressionValue expressionType ->+                                            Text.concat ["SELECT CAST(", expressionValue, " AS ", expressionType, ")"]+                                        DirectExpression expressionSQL ->+                                            Text.concat ["SELECT ", expressionSQL]+                                    )+                        result <- try (query_ conn sql) :: IO (Either SomeException [Only FieldValue])+                        runExpectation castLabel castExpectation result+                        maybe (pure ()) assertFailure castExpectFailureReason+         in maybe base (\reason -> expectFailBecause reason base) castExpectFailureReason++runExpectation :: String -> DuckDBExpectation -> Either SomeException [Only FieldValue] -> Assertion+runExpectation label expectation outcome =+    case expectation of+        ExpectEquals expected ->+            case outcome of+                Right [Only fieldValue] ->+                    assertEqual (label <> " result mismatch") expected fieldValue+                Right other ->+                    assertFailure (label <> " expected single row, got " <> show other)+                Left err ->+                    assertFailure (label <> " expected success, but query failed: " <> displayException err)+        ExpectSatisfies predicate ->+            case outcome of+                Right [Only fieldValue] ->+                    predicate fieldValue+                Right other ->+                    assertFailure (label <> " expected single row, got " <> show other)+                Left err ->+                    assertFailure (label <> " expected success, but query failed: " <> displayException err)+        ExpectException predicate ->+            case outcome of+                Left err ->+                    predicate err+                Right rows ->+                    assertFailure (label <> " expected failure, but query succeeded with " <> show rows)++duckdbCastCases :: [DuckDBCastCase]+duckdbCastCases =+    [ successCase "BOOLEAN" (quoted "true") "BOOLEAN" (ExpectEquals (FieldBool True))+    , successCase "TINYINT" (quotedValue tinyIntValue) "TINYINT" (ExpectEquals (FieldInt8 tinyIntValue))+    , successCase "SMALLINT" (quotedValue smallIntValue) "SMALLINT" (ExpectEquals (FieldInt16 smallIntValue))+    , successCase "INTEGER" (quotedValue intValue) "INTEGER" (ExpectEquals (FieldInt32 intValue))+    , successCase "BIGINT" (quotedValue bigIntValue) "BIGINT" (ExpectEquals (FieldInt64 bigIntValue))+    , successCase "UTINYINT" (quotedValue uTinyValue) "UTINYINT" (ExpectEquals (FieldWord8 uTinyValue))+    , successCase "USMALLINT" (quotedValue uSmallValue) "USMALLINT" (ExpectEquals (FieldWord16 uSmallValue))+    , successCase "UINTEGER" (quotedValue uIntValue) "UINTEGER" (ExpectEquals (FieldWord32 uIntValue))+    , successCase "UBIGINT" (quotedValue uBigValue) "UBIGINT" (ExpectEquals (FieldWord64 uBigValue))+    , successCase "FLOAT" (quoted "3.25") "FLOAT" (ExpectEquals (FieldFloat floatValue))+    , successCase "DOUBLE" (quoted "2.5") "DOUBLE" (ExpectEquals (FieldDouble doubleValue))+    , successCase "TIMESTAMP" (quoted "2024-01-02 03:04:05.123456") "TIMESTAMP" (ExpectEquals (FieldTimestamp timestampLocalTimeMicros))+    , successCase "DATE" (quoted "2024-10-12") "DATE" (ExpectEquals (FieldDate dateValue))+    , successCase "TIME" (quoted "14:30:15.123456") "TIME" (ExpectEquals (FieldTime timeValue))+    , successCase "INTERVAL" (quoted "1 day") "INTERVAL" (ExpectEquals (FieldInterval intervalValue))+    , successCase "HUGEINT" (quotedValue hugeIntLiteral) "HUGEINT" (ExpectEquals (FieldHugeInt hugeIntLiteral))+    , successCase "UHUGEINT" (quotedValue uHugeIntLiteral) "UHUGEINT" (ExpectEquals (FieldUHugeInt uHugeIntLiteral))+    , successCase "VARCHAR" (quoted varcharText) "VARCHAR" (ExpectEquals (FieldText varcharText))+    , successCase "BLOB" (quoted "duckdb") "BLOB" (ExpectEquals (FieldBlob blobValue))+    , successCase "DECIMAL" (quoted "12345.6789") "DECIMAL(18,4)" (ExpectEquals (FieldDecimal decimalValue))+    , successCase "TIMESTAMP_S" (quoted "2024-01-02 03:04:05") "TIMESTAMP_S" (ExpectEquals (FieldTimestamp timestampLocalTimeSeconds))+    , successCase "TIMESTAMP_MS" (quoted "2024-01-02 03:04:05.123") "TIMESTAMP_MS" (ExpectEquals (FieldTimestamp timestampLocalTimeMillis))+    , successCase "TIMESTAMP_NS" (quoted "2024-01-02 03:04:05.123456789") "TIMESTAMP_NS" (ExpectEquals (FieldTimestamp timestampLocalTimeNanos))+    , successCase "ENUM" (quoted "beta") "ENUM('alpha','beta')" (ExpectEquals (FieldEnum 1))+    , successCase "LIST" (quoted "[1,2,3]") "INTEGER[]" (ExpectEquals (FieldList listElements))+    , successDirect "MAP" "MAP(['a','b'], [1,2])" (expectMapEntries mapPairs)+    , successCase "TIMETZ" (quoted "03:04:05+02:30") "TIME WITH TIME ZONE" (ExpectEquals (FieldTimeTZ timeWithZoneValue))+    , successCase "TIMESTAMPTZ" (quoted "2024-01-02 03:04:05+02:30") "TIMESTAMP WITH TIME ZONE" (ExpectEquals (FieldTimestampTZ timestampTzUtc))+    , successCase "BIGNUM" (quoted bigNumLiteralText) "BIGNUM" (ExpectEquals (FieldBigNum (BigNum bigNumLiteral)))+    , successCase "UUID" (quoted $ UUID.toText uuid) "UUID" (ExpectEquals (FieldUUID uuid))+    , successCase "BIT" (quoted $ Text.pack $ show bits) "BIT" (ExpectEquals (FieldBit bits))+     -- 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 "unsupported DuckDB type")+      -- not implemented yet+    , failCaseWith "STRUCT" (quoted "{\"a\":1,\"b\":2}") "STRUCT(a INTEGER, b INTEGER)" "STRUCT decoding unsupported" (expectErrorCallContaining "STRUCT columns are not supported")+    , failCaseWith "ARRAY" (quoted "[1,2,3]") "INTEGER[3]" "ARRAY decoding unsupported" (expectErrorCallContaining "unsupported DuckDB type")+    , failCaseWith "UNION" (quoted "1") "UNION(\"value\" INTEGER)" "UNION casts unsupported" (expectSQLErrorContaining "UNION")+    -- 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")+    , failCaseOK "SQLNULL" "NULL" "SQLNULL" (expectSQLErrorContaining "SQLNULL")+    ]+  where+    bits = BitString 7 $ BS.pack [1, 255]+    quoted t = Text.concat ["'", t, "'"]+    quotedValue v = quoted (valueText v)+    valueText :: (Show a) => a -> Text.Text+    valueText = Text.pack . show+    successCase label value ty expectation =+        DuckDBCastCase+            { castLabel = label+            , castExpression = CastExpression value ty+            , castExpectation = expectation+            , castExpectFailureReason = Nothing+            }+    successDirect label expr expectation =+        DuckDBCastCase+            { castLabel = label+            , castExpression = DirectExpression expr+            , 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+            , castExpression = CastExpression value ty+            , castExpectation = expectation+            , castExpectFailureReason = Nothing+            }+    expectMapEntries expectedPairs =+        ExpectSatisfies $ \fieldValue ->+            case fieldValue of+                FieldMap actualPairs ->+                    let normalize pairs = sortOn (mapKey . fst) pairs+                        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)+    expectSQLErrorContaining :: Text.Text -> DuckDBExpectation+    expectSQLErrorContaining needle =+        ExpectException $ \err ->+            case fromException err :: Maybe SQLError of+                Just sqlErr ->+                    let message = sqlErrorMessage sqlErr+                        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+    secondsWithFraction whole numerator denominator =+        fromIntegral whole + numerator % denominator+    tinyIntValue :: Int8+    tinyIntValue = 42+    smallIntValue :: Int16+    smallIntValue = 32000+    intValue :: Int32+    intValue = 2147483647+    bigIntValue :: Int64+    bigIntValue = 9223372036854775807+    uTinyValue :: Word8+    uTinyValue = 200+    uSmallValue :: Word16+    uSmallValue = 60000+    uIntValue :: Word32+    uIntValue = maxBound+    uBigValue :: Word64+    uBigValue = maxBound+    floatValue :: Float+    floatValue = 3.25+    doubleValue :: Double+    doubleValue = 2.5+    timestampDay = fromGregorian 2024 1 2+    timestampLocalTimeMicros =+        LocalTime timestampDay (TimeOfDay 3 4 (fromRational (secondsWithFraction 5 123456 1000000)))+    timestampLocalTimeSeconds =+        LocalTime timestampDay (TimeOfDay 3 4 5)+    timestampLocalTimeMillis =+        LocalTime timestampDay (TimeOfDay 3 4 (fromRational (secondsWithFraction 5 123 1000)))+    timestampLocalTimeNanos =+        LocalTime timestampDay (TimeOfDay 3 4 (fromRational (secondsWithFraction 5 123456789 1000000000)))+    dateValue = fromGregorian 2024 10 12+    timeValue =+        TimeOfDay 14 30 (fromRational (secondsWithFraction 15 123456 1000000))+    intervalValue =+        IntervalValue{intervalMonths = 0, intervalDays = 1, intervalMicros = 0}+    decimalValue =+        DecimalValue{decimalWidth = 18, decimalScale = 4, decimalInteger = 123456789}+    listElements =+        [FieldInt32 1, FieldInt32 2, FieldInt32 3]+    mapPairs =+        [ (FieldText (Text.pack "a"), FieldInt32 1)+        , (FieldText (Text.pack "b"), FieldInt32 2)+        ]+    uuid :: UUID.UUID+    uuid = fromJust $ UUID.fromText "123e4567-e89b-12d3-a456-426614174000"+    timeWithZoneValue =+        TimeWithZone{timeWithZoneTime = TimeOfDay 3 4 5, timeWithZoneZone = minutesToTimeZone 150}+    timestampTzUtc =+        UTCTime timestampDay (secondsToDiffTime 2045)+    bigNumLiteral :: Integer+    bigNumLiteral = 1234567890123456789012345678901234567890+    bigNumLiteralText = valueText bigNumLiteral+    varcharText :: Text.Text+    varcharText = "Hello, DuckDB"+    blobValue = bsFromString "duckdb"+    hugeIntLiteral :: Integer+    hugeIntLiteral = (2 ^ (120 :: Int)) + 123456789+    uHugeIntLiteral :: Integer+    uHugeIntLiteral = (2 ^ (128 :: Int)) - 1+    literalText :: Text.Text+    literalText = "literal"+ typeTests :: TestTree typeTests =     testGroup         "types"-        [ testCase "round-trips date/time/timestamp" $+        [ duckdbTypeCastTests+        , testCase "round-trips date/time/timestamp" $             withConnection ":memory:" \conn -> do                 _ <- execute_ conn "CREATE TABLE temporals (d DATE, t TIME, ts TIMESTAMP)"                 let dayVal = fromGregorian 2024 10 12@@ -366,6 +627,79 @@                 [Only (hugeOut :: Integer)] <-                     query_ conn "SELECT 170141183460469231731687303715884105727::HUGEINT"                 assertEqual "hugeint" hugeValue hugeOut+        , testCase "decodes huge integers as Natural" $+            withConnection ":memory:" \conn -> do+                let hugeValue = 170141183460469231731687303715884105727 :: Natural+                [Only (naturalOut :: Natural)] <-+                    query_ conn "SELECT 170141183460469231731687303715884105727::HUGEINT"+                assertEqual "hugeint natural" hugeValue naturalOut+        , testCase "decodes unsigned huge integers as Natural" $+            withConnection ":memory:" \conn -> do+                let uhValue = 170141183460469231731687303715884105727 :: Natural+                [Only (naturalOut :: Natural)] <-+                    query_ conn "SELECT 170141183460469231731687303715884105727::UHUGEINT"+                assertEqual "uhugeint natural" uhValue naturalOut+        , testCase "FromField Integer consumes FieldBigNum" $ do+            let original = 1234567899876543210123456789 :: Integer+                bigField =+                    Field+                        { fieldName = "big"+                        , fieldIndex = 0+                        , fieldValue = FieldBigNum (BigNum original)+                        }+            case (fromField bigField :: Ok Integer) of+                Ok result -> assertEqual "FieldBigNum Integer" original result+                Errors err -> assertFailure ("unexpected parse failure: " <> show err)+        , testCase "FromField Natural rejects negative FieldBigNum" $ do+            let bigValue = BigNum (-5)+                bigField =+                    Field+                        { fieldName = "big"+                        , fieldIndex = 0+                        , fieldValue = FieldBigNum bigValue+                        }+            case (fromField bigField :: Ok Natural) of+                Errors _ -> pure ()+                Ok result -> assertFailure ("expected failure, got " <> show result)+        , testCase "BigNum conversions round-trip Integer" $ do+            let original = (2 ^ (200 :: Int)) + 8675309 :: Integer+                converted = toBigNumBytes original+            assertEqual "round-trip Integer" original (fromBigNumBytes converted)+        , testProperty "fromBigNumBytes . toBigNumBytes is identity" \(n :: Integer) ->+            fromBigNumBytes (toBigNumBytes n) === n+        , testCase "selects BIGNUM values as BigNum" $+            withConnection ":memory:" \conn -> do+                _ <- execute_ conn "CREATE TABLE bignums (val BIGNUM)"+                let bigValues :: [Integer]+                    bigValues =+                        [ (2 ^ (200 :: Int)) + 8675309+                        , 0+                        , negate ((2 ^ (180 :: Int)) + 12345)+                        ]+                rows <- concat <$> mapM (\bv -> query_ conn $ fromString $ "SELECT CAST('" <> show bv <> "' AS BIGNUM)") bigValues+                --  query_ conn "SELECT val FROM bignums ORDER BY rowid" :: IO [Only BigNum]+                assertEqual "BIGNUM results" (fmap (Only . BigNum) bigValues) rows+        , testCase "round-trips BIGNUM values through the database" $+            withConnection ":memory:" \conn -> do+                _ <- execute_ conn "CREATE TABLE bignum_roundtrip (val BIGNUM)"+                let ints =+                        [ (2 ^ (200 :: Int)) + 8675309+                        , 0+                        , negate ((2 ^ (180 :: Int)) + 12345)+                        ]+                _ <- executeMany conn "INSERT INTO bignum_roundtrip VALUES (?)" (fmap (Only . BigNum) ints)+                rows <- query_ conn "SELECT val FROM bignum_roundtrip ORDER BY rowid" :: IO [Only Integer]+                assertEqual "BIGNUM round-trip" (fmap Only ints) rows+        , testCase "duckdbColumnType reports BIGNUM for Integer" $+            assertEqual+                "duckdbColumnType Integer"+                (Text.pack "BIGNUM")+                (duckdbColumnType (Proxy :: Proxy Integer))+        , testCase "duckdbColumnType preserves Maybe parameter" $+            assertEqual+                "duckdbColumnType Maybe Word16"+                (Text.pack "USMALLINT")+                (duckdbColumnType (Proxy :: Proxy (Maybe Word16)))         , testCase "decodes interval components" $             withConnection ":memory:" \conn -> do                 [Only intervalVal] <-@@ -380,9 +714,10 @@             withConnection ":memory:" \conn -> do                 [Only decimalAsDouble] <-                     (query_ conn "SELECT CAST(12345.6789 AS DECIMAL(18,4))" :: IO [Only Double])+                let diff = abs (decimalAsDouble - 12345.6789)                 assertBool-                    "decimal as double"-                    (abs (decimalAsDouble - 12345.6789) < 1e-6)+                    ("decimal as double: " <> show diff)+                    (diff < 1e-4)         , testCase "decodes time with time zone" $             withConnection ":memory:" \conn -> do                 [Only tzVal] <- query_ conn "SELECT TIMETZ '14:30:15+02:30'"@@ -390,6 +725,17 @@                     expectedZone = minutesToTimeZone 150                 assertEqual "timetz time" expectedTime (timeWithZoneTime tzVal)                 assertEqual "timetz zone" expectedZone (timeWithZoneZone tzVal)+        , testCase "decodes list columns into Haskell lists" $+            withConnection ":memory:" \conn -> do+                [Only (listOut :: [Int])] <-+                    query_ conn "SELECT LIST_VALUE(1, 2, 3)::INTEGER[]"+                assertEqual "list decode" [1, 2, 3] listOut+        , testCase "decodes map columns into strict Map" $+            withConnection ":memory:" \conn -> do+                [Only (mapOut :: Map.Map Text.Text Int)] <-+                    query_ conn "SELECT MAP(['a', 'b']::TEXT[], [1, 2]::INTEGER[])"+                let expected = Map.fromList [(Text.pack "a", 1), (Text.pack "b", 2)]+                assertEqual "map decode" expected mapOut         , testCase "decodes timestamp with time zone as UTC" $             withConnection ":memory:" \conn -> do                 [Only utcVal] <-@@ -409,6 +755,34 @@                 assertThrows                     (query_ conn "SELECT name FROM nonempty" :: IO [Only NonEmptyText])                     (Text.isInfixOf "NonEmptyText requires a non-empty string" . sqlErrorMessage)+        , testCase "round-trips uuid payloads" $+            withConnection ":memory:" \conn -> do+                _ <- execute_ conn "CREATE TABLE uuids (uuid UUID)"+                let uuidTexts =+                        [ "123e4567-e89b-12d3-a456-426614174000"+                        , "923e4567-e89b-12d3-a456-426614174000"+                        , "ffffffff-ffff-ffff-ffff-ffffffffffff"+                        ]+                    maybeUUIDs = traverse UUID.fromText uuidTexts+                uuids <-+                    case maybeUUIDs of+                        Nothing -> assertFailure "invalid UUID literal in test data" >> pure []+                        Just parsed -> pure parsed+                _ <- executeMany conn "INSERT INTO uuids VALUES (?)" (fmap Only uuids)+                rows <- query_ conn "SELECT uuid FROM uuids ORDER BY rowid" :: IO [Only UUID.UUID]+                assertEqual "uuid round-trip" (fmap Only uuids) rows+        , testCase "round-trips bitstring payloads" $+            withConnection ":memory:" \conn -> do+                _ <- execute_ conn "CREATE TABLE bits (bit BIT)"+                let bitValues =+                        [ bsFromBool [True]+                        , bsFromBool [False, False, False, True, True, True, False, True, False]+                        , bsFromBool [False, False, False, False, True, True, True, False, True, False]+                        , bsFromBool [True, False, False, False, True, True, True, False, True, False]+                        ]+                _ <- executeMany conn "INSERT INTO bits VALUES (?)" (fmap Only bitValues)+                rows <- query_ conn "SELECT bit FROM bits ORDER BY rowid" :: IO [Only BitString]+                assertEqual "bit round-trip" (fmap Only bitValues) rows         ]  streamingTests :: TestTree