duckdb-simple 0.1.0.0 → 0.1.1.0

raw patch · 4 files changed

+86/−81 lines, 4 filesdep ~duckdb-ffiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: duckdb-ffi

API changes (from Hackage documentation)

Files

• duckdb-simple.cabal +2/−2
• src/Database/DuckDB/Simple/FromField.hs +77/−63
• src/Database/DuckDB/Simple/FromRow.hs +4/−5
• test/Spec.hs +3/−11

@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               duckdb-simple-version:            0.1.0.0+version:            0.1.1.0 license:            MPL-2.0 license-file:       LICENSE author:             Matthias Pall Gissurarson@@ -42,7 +42,7 @@   build-depends:       base >=4.14 && <5     , bytestring >= 0.11 && <0.12-    , duckdb-ffi >= 0.1.4 && <0.1.5+    , duckdb-ffi >= 1.4 && <1.5     , text >= 2.0 && <2.1     , transformers >= 0.6 && <0.7     , time >= 1.12 && <1.13

@@ -17,7 +17,7 @@     ResultError (..),     FieldParser,     FromField (..),-    left+    returnError ) where  import Control.Exception (Exception, SomeException (..))@@ -96,15 +96,18 @@ -- | 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@@ -115,9 +118,6 @@  instance Exception ResultError --- From sqlite-simple:-left :: Exception a => a -> Ok b-left = Errors . (:[]) . SomeException   -- | Parser used by 'FromField' instances and utilities such as@@ -135,102 +135,105 @@     fromField Field{fieldValue} = Ok fieldValue  instance FromField Null where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldNull -> Ok Null-            other -> left (Incompatible (fieldValueTypeName other) "Null" "expected NULL")+            _ ->  returnError Incompatible f "expected NULL"  instance FromField Bool where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldBool b -> Ok b             FieldInt i -> Ok (i /= 0)-            other -> left (Incompatible (fieldValueTypeName other) "Bool" "invalid type for boolean")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Int8 where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldInt i -> Ok (fromIntegral i)-            other -> left (Incompatible (fieldValueTypeName other) "Int8" "invalid type for Int8")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Int64 where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldInt i -> Ok (fromIntegral i)-            other -> left (Incompatible (fieldValueTypeName other) "Int64" "invalid type for Int64")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Int32 where-    fromField field@Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of-            FieldInt i -> boundedIntegral field i-            other -> left (Incompatible (fieldValueTypeName other) "Int32" "invalid type for integer")+            FieldInt i -> boundedIntegral f i+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Int16 where-    fromField field@Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of-            FieldInt i -> boundedIntegral field i-            other -> left (Incompatible (fieldValueTypeName other) "Int16" "invalid type for integer")+            FieldInt i -> boundedIntegral f i+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Int where-    fromField field@Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of-            FieldInt i -> boundedIntegral field i-            other -> left (Incompatible (fieldValueTypeName other) "Int" "invalid type for integer")+            FieldInt i -> boundedIntegral f i+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Word64 where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldInt i                 | i >= 0 -> Ok (fromIntegral i)                 | otherwise ->-                    left $-                        ConversionFailed (fieldValueTypeName fieldValue) "Word64" $-                                 Text.pack "negative value cannot be converted to unsigned integer"+                     returnError ConversionFailed f "negative value cannot be converted to unsigned integer"             FieldWord w -> Ok (fromIntegral w)-            other -> left (Incompatible (fieldValueTypeName other) "Word64" "invalid type for Word64")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Word32 where-    fromField field@Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldInt i-                | i >= 0 -> boundedIntegral field i+                | i >= 0 -> boundedIntegral f i                 | otherwise ->-                    left $-                        ConversionFailed (fieldValueTypeName fieldValue) "Word32" $-                                 Text.pack "negative value cannot be converted to unsigned integer"+                    returnError ConversionFailed f "negative value cannot be converted to unsigned integer"             FieldWord w -> Ok (fromIntegral w)-            other -> left (Incompatible (fieldValueTypeName other) "Word32" "invalid type for Word32")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Word16 where-    fromField field@Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldInt i-                | i >= 0 -> boundedIntegral field i+                | i >= 0 -> boundedIntegral f i                 | otherwise ->-                    left $-                        ConversionFailed (fieldValueTypeName fieldValue) "Word16" $-                                 Text.pack "negative value cannot be converted to unsigned integer"+                    returnError ConversionFailed f "negative value cannot be converted to unsigned integer"             FieldWord w -> Ok (fromIntegral w)-            other -> left (Incompatible (fieldValueTypeName other) "Word16" "invalid type for Word16")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Word8 where-    fromField field@Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldInt i-                | i >= 0 -> boundedIntegral field i+                | i >= 0 -> boundedIntegral f i                 | otherwise ->-                    left $-                        ConversionFailed (fieldValueTypeName fieldValue) "Word8" $-                                 Text.pack "negative value cannot be converted to unsigned integer"+                    returnError ConversionFailed f "negative value cannot be converted to unsigned integer"             FieldWord w -> Ok (fromIntegral w)-            other -> left (Incompatible (fieldValueTypeName other) "Word8" "invalid type for Word8")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Double where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldDouble d -> Ok d             FieldInt i -> Ok (fromIntegral i)-            other -> left (Incompatible (fieldValueTypeName other) "Double" "invalid type for double")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Float where     fromField field =@@ -239,48 +242,49 @@             Ok d -> Ok (realToFrac d)  instance FromField Text where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldText t -> Ok t             FieldInt i -> Ok (Text.pack (show i))             FieldDouble d -> Ok (Text.pack (show d))             FieldBool b -> Ok (if b then Text.pack "1" else Text.pack "0")-            FieldNull ->-                left $ UnexpectedNull (fieldValueTypeName fieldValue) "Text" $ Text.pack "unexpected null value"-            other -> left (Incompatible (fieldValueTypeName other) "Text" "invalid type for text")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField String where     fromField field = Text.unpack <$> fromField field  instance FromField BS.ByteString where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldBlob bs -> Ok bs             FieldText t -> Ok (TextEncoding.encodeUtf8 t)-            FieldNull ->-                left $ UnexpectedNull (fieldValueTypeName fieldValue) "ByteString" $ Text.pack "unexpected null value"-            other -> left (Incompatible (fieldValueTypeName other) "ByteString" "invalid type for blob")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField Day where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldDate day -> Ok day             FieldTimestamp LocalTime{localDay} -> Ok localDay-            other -> left (Incompatible (fieldValueTypeName other) "Day" "invalid type for date")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField TimeOfDay where-    fromField Field{fieldValue} =+    fromField f@Field{fieldValue} =         case fieldValue of             FieldTime tod -> Ok tod             FieldTimestamp LocalTime{localTimeOfDay} -> Ok localTimeOfDay-            other -> left (Incompatible (fieldValueTypeName other) "TimeOfDay" "invalid type for time")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""  instance FromField LocalTime where-    fromField Field{ fieldValue} =+    fromField f@Field{ fieldValue} =         case fieldValue of             FieldTimestamp ts -> Ok ts             FieldDate day -> Ok (LocalTime day midnight)-            other -> left (Incompatible (fieldValueTypeName other) "LocalTime" "invalid type for timestamp")+            FieldNull -> returnError UnexpectedNull f ""+            _ -> returnError Incompatible f ""       where         midnight = TimeOfDay 0 0 0 @@ -296,12 +300,22 @@  -- | Helper for bounded integral conversions. boundedIntegral :: forall a. (Integral a, Bounded a, Typeable a) => Field -> Int -> Ok a-boundedIntegral Field{fieldValue} i+boundedIntegral f@Field{} i     | toInteger i < toInteger (minBound :: a) =-        left $ ConversionFailed (fieldValueTypeName fieldValue) (Text.pack $ show (typeRep (Proxy :: Proxy a))) $ Text.pack "integer value out of bounds"+        returnError ConversionFailed f "integer value out of bounds"     | toInteger i > toInteger (maxBound :: a) =-        left $ ConversionFailed (fieldValueTypeName fieldValue) (Text.pack $ show (typeRep (Proxy :: Proxy a))) $ Text.pack "integer value out of bounds"+        returnError ConversionFailed f "integer value out of bounds"     | otherwise = Ok (fromIntegral i)++-- | 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]+  fieldValueTypeName :: FieldValue -> Text fieldValueTypeName = \case

@@ -30,7 +30,7 @@ ) where  import Control.Applicative (Alternative (..))-import Control.Exception (Exception, SomeException, fromException, toException)+import Control.Exception (Exception, SomeException (SomeException), fromException, toException) import Control.Monad (MonadPlus, replicateM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)@@ -121,7 +121,7 @@      in case runStateT (runReaderT (runRowParser parser) context) initialState of             Ok (value, (columnCount, _))                 | columnCount == length fields -> Ok value-                | otherwise -> left (ColumnOutOfBounds (columnCount + 1))+                | otherwise -> Errors [SomeException $ ColumnOutOfBounds (columnCount + 1)]             Errors errs ->  Errors errs  instance FromRow () where@@ -256,8 +256,7 @@ renderError = \case     Incompatible{errSQLType, errHaskellType} ->             Text.concat-                [ "duckdb-simple: column "-                , " has type "+                [ "duckdb-simple: column has type "                 , errSQLType                 , " but expected "                 , errHaskellType@@ -265,7 +264,7 @@     UnexpectedNull{errSQLType} ->             Text.concat                 [ "duckdb-simple: column "-                , " is NULL but expected "+                , "is NULL but expected "                 , errSQLType                 ]     ConversionFailed{errMessage} ->

@@ -21,7 +21,7 @@ import Data.Time.Clock (UTCTime) import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..), localTimeToUTC, utc) import Database.DuckDB.Simple-import Database.DuckDB.Simple.FromField (Field (..), left)+import Database.DuckDB.Simple.FromField (Field (..), returnError) import GHC.Generics (Generic) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit@@ -60,11 +60,7 @@                     let normalized = Text.toLower txt                      in if normalized == expected                             then Ok ()-                            else left $-                                ConversionFailed-                                    (Text.pack "TEXT")-                                    (Text.pack "YesNo")-                                    "failed to match exact string"+                            else returnError  ConversionFailed fld "failed to match exact string"  newtype NonEmptyText = NonEmptyText Text.Text     deriving (Eq, Show)@@ -75,11 +71,7 @@         Errors err -> Errors err         Ok txt             | Text.null txt ->-                left $-                    ConversionFailed-                        (Text.pack "TEXT")-                        (Text.pack "NonEmptyText")-                        (Text.pack "NonEmptyText requires a non-empty string")+                returnError  ConversionFailed f "NonEmptyText requires a non-empty string"             | otherwise -> Ok (NonEmptyText txt)  instance FromField NonEmptyText where