generic-persistence 0.6.0 → 0.7.0.0

raw patch · 23 files changed

+785/−492 lines, 23 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +36/−7
• Setup.hs +2/−1
• generic-persistence.cabal +5/−5
• src/Database/GP.hs +16/−9
• src/Database/GP/Conn.hs +9/−15
• src/Database/GP/Entity.hs +22/−26
• src/Database/GP/GenericPersistence.hs +44/−27
• src/Database/GP/GenericPersistenceSafe.hs +110/−59
• src/Database/GP/Query.hs +19/−20
• src/Database/GP/SqlGenerator.hs +94/−56
• src/Database/GP/TypeInfo.hs +1/−1
• test/ConnSpec.hs +12/−23
• test/DemoSpec.hs +2/−2
• test/EmbeddedSpec.hs +2/−4
• test/EnumSpec.hs +2/−4
• test/ExceptionsSpec.hs +79/−37
• test/GenericPersistenceSpec.hs +117/−35
• test/OneToManySafeSpec.hs +24/−25
• test/OneToManySpec.hs +17/−17
• test/PostgresQuerySpec.hs +34/−36
• test/PostgresSpec.hs +72/−31
• test/QuerySpec.hs +41/−33
• test/ReferenceSpec.hs +25/−19

@@ -1,5 +1,6 @@ # GenericPersistence - A Haskell Persistence Layer using Generics +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) [![Actions Status](https://github.com/thma/generic-persistence/workflows/Haskell%20CI/badge.svg)](https://github.com/thma/generic-persistence/actions) [![codecov](https://codecov.io/gh/thma/generic-persistence/graph/badge.svg?token=DBCFLEA8JZ)](https://codecov.io/gh/thma/generic-persistence) [![Available on Hackage](https://img.shields.io/hackage/v/generic-persistence.svg?style=flat)](https://github.com/thma/generic-persistence)@@ -14,6 +15,7 @@ - [Status](#status) - [Available on Hackage](#available-on-hackage) - [Short demo](#short-demo)+- [Real world examples](#real-world-examples) - [Deal with runtime exceptions or use total functions? Your choice!](#deal-with-runtime-exceptions-or-use-total-functions-your-choice)   - [Exceptions in the default API](#exceptions-in-the-default-api)   - [Total functions in the safe API](#total-functions-in-the-safe-api)@@ -155,6 +157,31 @@   disconnect conn ``` +## Real world examples++To learn how to use the library in more complex scenarios, I recommend looking at the following examples:++### Building a REST service with Servant and GenericPersistence++[This example](https://github.com/thma/servant-gp) shows how to use servant to build a REST API that provides CRUD operations for a medium-complex data model.+GenericPersistence is used to execute the CRUD operation against a SQLite database.+A Swagger UI is provided to interact with the API.++### Building a REST service with Scotty and GenericPersistence+[This example](https://github.com/thma/scotty-gp-service) shows how to use Scotty to build a REST API that provides CRUD operations for a simple data model.+GenericPersistence is used to execute the CRUD operation against a SQLite database.+This example also demonstrate how a paging mechanism can be implemented with GenericPersistence.+The code also shows how to use GenericPersistence to manage BearerTokens for validating incoming requests.++### The Elephantine library review++The Elephantine library review provides a good overview of the different libraries available for working with PostgreSQL in Haskell. It also contains a section on *Generic-Persistence*:++[How to use PostgreSQL with Haskell. Elephantine Library Review 2023](https://github.com/Zelenya/elephants#generic-persistence)++In this review all libraries are compared by implementing the same real world application scenario with each library. The source code for *Generic-Persistence* can be found [here](https://github.com/Zelenya/elephants/blob/main/src/Elephants/GenericPersistence.hs).++ ## Deal with runtime exceptions or use total functions? Your choice!  GenericPersistence provides two different APIs for accessing the database:@@ -454,18 +481,18 @@   fromRow :: Conn -> [SqlValue] -> IO Article   fromRow conn row = do         authorById <- fromJust <$> selectById conn (row !! 2)  -- load author by foreign key-    return $ rawArticle {author = authorById}                -- add author to article+    return $ rawArticle {author = authorById}              -- add author to article     where-      rawArticle = Article (col 0) (col 1)                   -- create article from row, -                           (Author (col 2) "" "") (col 3)    -- using a dummy author+      rawArticle = Article (col 0) (col 1)                 -- create article from row, +                           (Author (col 2) "" "") (col 3)  -- using a dummy author         where           col i = fromSql (row !! i)    toRow :: Conn -> Article -> IO [SqlValue]   toRow conn a = do-    persist conn (author a)                                  -- persist author first-    return [toSql (articleID a), toSql (title a),            -- return row for article table where -            toSql $ authorID (author a), toSql (year a)]     -- authorID is foreign key to author table +    upsert conn (author a)                                  -- persist author first+    return [toSql (articleID a), toSql (title a),           -- return row for article table where +            toSql $ authorID (author a), toSql (year a)]    -- authorID is foreign key to author table  ```  Persisting the `Author`as a side effect in `toRow` may sound like an *interesting* idea...@@ -518,7 +545,7 @@    toRow :: Conn -> Author -> IO [SqlValue]   toRow conn a = do-    mapM_ (persist conn) (articles a)                     -- persist all articles of this author (update or insert)+    mapM_ (upsert conn) (articles a)                      -- persist all articles of this author (update or insert)     return [toSql (authorID a),                           -- return the author as a list of SqlValues             toSql (name a), toSql (address a)] ```@@ -683,3 +710,5 @@  You'll find a more complete example in the [servant-gp repo](https://github.com/thma/servant-gp/blob/main/src/ServerUtils.hs#L45). There I have set up a sample REST service based on Servant that uses *Generic-Persistence* and a connection pool to manage the database connections.++

@@ -1,2 +1,3 @@-import Distribution.Simple+import           Distribution.Simple+ main = defaultMain

@@ -1,12 +1,12 @@ cabal-version:      1.12 name:               generic-persistence-version:            0.6.0+version:            0.7.0.0 license:            BSD3 license-file:       LICENSE-copyright:          2023 Thomas Mahler+copyright:          2023,2024 Thomas Mahler maintainer:         thma@apache.org author:             Thomas Mahler-tested-with:        ghc ==9.2.5 ghc ==9.4.4+tested-with:        ghc ==9.2 ghc ==9.4 ghc ==9.6 ghc ==9.8 homepage:           https://github.com/thma/generic-persistence#readme bug-reports:        https://github.com/thma/generic-persistence/issues synopsis:           Database persistence using generics@@ -37,7 +37,7 @@     default-language:   GHC2021     default-extensions:         DuplicateRecordFields DeriveAnyClass DerivingStrategies-        OverloadedRecordDot TemplateHaskell QuasiQuotes+        OverloadedRecordDot TemplateHaskell QuasiQuotes LambdaCase      ghc-options:         -Wall -Wcompat -Widentities -Wincomplete-record-updates@@ -76,7 +76,7 @@     default-language:   GHC2021     default-extensions:         DuplicateRecordFields DeriveAnyClass DerivingStrategies-        OverloadedRecordDot TemplateHaskell QuasiQuotes+        OverloadedRecordDot TemplateHaskell QuasiQuotes LambdaCase      ghc-options:         -Wall -Wcompat -Widentities -Wincomplete-record-updates

@@ -1,19 +1,25 @@ module Database.GP   ( selectById,     select,+    count,     entitiesFromRows,     sql,     persist,+    upsert,     insert,     insertMany,     update,     updateMany,     delete,+    deleteById,     deleteMany,-    setupTableFor,-    Conn(..),+    deleteManyById,+    setupTable,+    defaultSqliteMapping,+    defaultPostgresMapping,+    Conn (..),     connect,-    Database(..),+    Database (..),     TxHandling (..),     ConnectionPool,     createConnPool,@@ -25,7 +31,7 @@     maybeFieldTypeFor,     TypeInfo (..),     typeInfo,-    PersistenceException(..),+    PersistenceException (..),     WhereClauseExpr,     Field,     field,@@ -49,7 +55,7 @@     SortOrder (..),     limit,     limitOffset,-    NonEmpty(..),+    NonEmpty (..),     SqlValue,     fromSql,     toSql,@@ -59,12 +65,13 @@     rollback,     withTransaction,     runRaw,-    disconnect+    disconnect,   ) where  -- We are just re-exporting from the GenericPersistence module. import           Database.GP.GenericPersistence-import           Database.HDBC (SqlValue, fromSql, toSql, quickQuery, run, -                                commit, rollback, withTransaction,-                                IConnection(runRaw, disconnect))+import           Database.HDBC                  (IConnection (disconnect, runRaw),+                                                 SqlValue, commit, fromSql,+                                                 quickQuery, rollback, run,+                                                 toSql, withTransaction)

@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase                #-} module Database.GP.Conn   ( Conn (..),     connect,@@ -27,24 +26,18 @@ --  This module also defines a ConnectionPool type, which provides basic connection pooling functionality.  -- | A wrapper around an HDBC IConnection.-data Conn = forall conn.-  IConnection conn =>-  Conn-  { -    -- | If True, the GenericPersistence functions will commit the transaction after each operation.-    implicitCommit :: Bool,-    -- | The wrapped connection-    connection     :: conn-  }+data Conn = forall conn. IConnection conn => +  Conn +    Bool -- | If True, the GenericPersistence functions will commit the transaction after each operation.+    conn -- | The wrapped HDBC IConnection -data TxHandling = AutoCommit | ExplicitCommit  +data TxHandling = AutoCommit | ExplicitCommit  -- | a smart constructor for the Conn type.-connect :: forall conn. IConnection conn => TxHandling -> conn ->  Conn+connect :: forall conn. IConnection conn => TxHandling -> conn -> Conn connect = \case   AutoCommit     -> Conn True   ExplicitCommit -> Conn False-    -- | allows to execute a function that requires an `IConnection` argument on a `Conn`. withWConn :: forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b@@ -72,8 +65,9 @@ type ConnectionPool = Pool Conn  -- | Creates a connection pool.-createConnPool :: IConnection conn =>-  -- | the transaction mode +createConnPool ::+  IConnection conn =>+  -- | the transaction mode   TxHandling ->   -- | the connection string   String ->

@@ -13,8 +13,8 @@     GToRow,     GFromRow,     maybeFieldTypeFor,-    Conn(..),-    TxHandling(..),+    Conn (..),+    TxHandling (..),     maybeIdFieldIndex,     fieldIndex,   )@@ -23,36 +23,32 @@ import           Data.Char            (toLower) import           Data.Convertible import           Data.Kind+import           Data.List            (elemIndex) import           Data.Typeable        (Proxy (..), TypeRep)+import           Database.GP.Conn import           Database.GP.TypeInfo import           Database.HDBC        (SqlValue) import           GHC.Generics import           GHC.TypeNats-import           Database.GP.Conn-import Data.List (elemIndex) -{- | This is the Entity class. It is a type class that is used to define the mapping-between a Haskell product type in record notation and a database table.-The class has a default implementation for all methods.-The default implementation uses the type information to determine a simple 1:1 mapping.--That means that-- the type name is used as the table name and the-- field names are used as the column names.-- A field named '<lowercase typeName>ID' is used as the primary key field.--The default implementation can be overridden by defining a custom instance for a type.--Please note the following constraints, which apply to all valid Entity type,-but that are not explicitely encoded in the type class definition:--- The type must be a product type in record notation.-- The type must have exactly one constructor.-- There must be single primary key field, compund primary keys are not supported.---}--+-- | This is the Entity class. It is a type class that is used to define the mapping+-- between a Haskell product type in record notation and a database table.+-- The class has a default implementation for all methods.+-- The default implementation uses the type information to determine a simple 1:1 mapping.+--+-- That means that+-- - the type name is used as the table name and the+-- - field names are used as the column names.+-- - A field named '<lowercase typeName>ID' is used as the primary key field.+--+-- The default implementation can be overridden by defining a custom instance for a type.+--+-- Please note the following constraints, which apply to all valid Entity type,+-- but that are not explicitely encoded in the type class definition:+--+-- - The type must be a product type in record notation.+-- - The type must have exactly one constructor.+-- - There must be single primary key field, compound primary keys are not supported. class (Generic a, HasConstructor (Rep a), HasSelectors (Rep a)) => Entity a where   -- | Converts a database row to a value of type 'a'.   fromRow :: Conn -> [SqlValue] -> IO a

@@ -1,20 +1,27 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+ module Database.GP.GenericPersistence   ( selectById,     select,+    count,     entitiesFromRows,     sql,     persist,+    upsert,     insert,     insertMany,     update,     updateMany,     delete,+    deleteById,     deleteMany,-    setupTableFor,-    Conn(..),+    deleteManyById,+    setupTable,+    defaultSqliteMapping,+    defaultPostgresMapping,+    Conn (..),     connect,-    Database(..),+    Database (..),     TxHandling (..),     ConnectionPool,     createConnPool,@@ -26,7 +33,7 @@     maybeFieldTypeFor,     TypeInfo (..),     typeInfo,-    PersistenceException(..),+    PersistenceException (..),     WhereClauseExpr,     Field,     field,@@ -39,9 +46,9 @@     (<=.),     (<>.),     like,-    --contains,+    -- contains,     between,-    in',  +    in',     isNull,     not',     sqlFun,@@ -51,16 +58,16 @@     SortOrder (..),     limit,     limitOffset,-    NonEmpty(..)+    NonEmpty (..),   ) where  import           Control.Exception---import           Control.Monad                      (when) import           Data.Convertible                   (Convertible) import           Database.GP.Conn import           Database.GP.Entity-import           Database.GP.GenericPersistenceSafe (PersistenceException, sql, setupTableFor)+import           Database.GP.GenericPersistenceSafe (PersistenceException,+                                                     setupTable, sql) import qualified Database.GP.GenericPersistenceSafe as GpSafe import           Database.GP.SqlGenerator import           Database.GP.TypeInfo@@ -86,16 +93,6 @@     Left ex                        -> throw ex     Right entity                   -> pure $ Just entity --- | This function retrieves all entities of type `a` from a database.---  The function takes an HDBC connection as parameter.---  The type `a` is determined by the context of the function call.--- retrieveAll :: forall a. (Entity a) => Conn -> IO [a]--- retrieveAll conn = do---   eitherExRow <- GpSafe.retrieveAll @a conn---   case eitherExRow of---     Left ex    -> throw ex---     Right rows -> pure rows- -- | This function retrieves all entities of type `a` that match some query criteria. --   The function takes an HDBC connection and a `WhereClauseExpr` as parameters. --   The type `a` is determined by the context of the function call.@@ -108,6 +105,13 @@     Left ex        -> throw ex     Right entities -> pure entities +count :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO Int+count conn whereClause = do+  eitherExCount <- GpSafe.count @a conn whereClause+  case eitherExCount of+    Left ex   -> throw ex+    Right cnt -> pure cnt+ fromEitherExOrA :: IO (Either PersistenceException a) -> IO a fromEitherExOrA ioEitherExUnit = do   eitherExUnit <- ioEitherExUnit@@ -127,9 +131,18 @@ -- The function takes an HDBC connection and an entity as parameters. -- The entity is either inserted or updated, depending on whether it already exists in the database. -- The required SQL statements are generated dynamically using Haskell generics and reflection+-- deprecated: use upsert instead+{-# DEPRECATED persist "use upsert instead" #-} persist :: forall a. (Entity a) => Conn -> a -> IO ()-persist = (fromEitherExOrA .) . GpSafe.persist+persist = upsert +-- | A function that upserts an entity into a database.+-- The function takes an HDBC connection and an entity as parameters.+-- The entity is either inserted or updated, depending on whether it already exists in the database.+-- The required SQL statements are generated dynamically using Haskell generics and reflection+upsert :: forall a. (Entity a) => Conn -> a -> IO ()+upsert = (fromEitherExOrA .) . GpSafe.upsert+ -- | A function that explicitely inserts an entity into a database. insert :: forall a. (Entity a) => Conn -> a -> IO a insert = (fromEitherExOrA .) . GpSafe.insert@@ -155,16 +168,20 @@ delete :: forall a. (Entity a) => Conn -> a -> IO () delete = (fromEitherExOrA .) . GpSafe.delete +-- | A function that deletes an entity from a database.+--   The function takes an HDBC connection and an entity id as parameters.+deleteById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> id -> IO ()+deleteById = (fromEitherExOrA .) . GpSafe.deleteById @a+ -- | A function that deletes a list of entities from a database. --   The function takes an HDBC connection and a list of entities as parameters. --   The delete-statement is compiled only once and then executed for each entity. deleteMany :: forall a. (Entity a) => Conn -> [a] -> IO () deleteMany = (fromEitherExOrA .) . GpSafe.deleteMany --- -- | set up a table for a given entity type. The table is dropped (if existing) and recreated.--- --   The function takes an HDBC connection as parameter.--- setupTableFor :: forall a. (Entity a) => Conn -> IO ()--- setupTableFor conn = do---   runRaw conn $ dropTableStmtFor @a---   runRaw conn $ createTableStmtFor @a (db conn)---   when (implicitCommit conn) $ commit conn+-- | A function that deletes a list of entities from a database.+--   The function takes an HDBC connection and a list of entity ids as parameters.+deleteManyById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> [id] -> IO ()+deleteManyById = (fromEitherExOrA .) . GpSafe.deleteManyById @a++

@@ -1,24 +1,28 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DeriveAnyClass      #-}-{-# OPTIONS_GHC -Wno-orphans     #-}-{-# LANGUAGE LambdaCase          #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module Database.GP.GenericPersistenceSafe   ( selectById,     select,+    count,     entitiesFromRows,     sql,     persist,+    upsert,     insert,     insertMany,     update,     updateMany,     delete,+    deleteById,     deleteMany,-    setupTableFor,-    Conn(..),+    deleteManyById,+    setupTable,+    defaultSqliteMapping,+    defaultPostgresMapping,+    Conn (..),     connect,-    Database(..),+    Database (..),     TxHandling (..),     ConnectionPool,     createConnPool,@@ -30,7 +34,7 @@     maybeFieldTypeFor,     TypeInfo (..),     typeInfo,-    PersistenceException(..),+    PersistenceException (..),     WhereClauseExpr,     Field,     field,@@ -55,36 +59,36 @@     limit,     limitOffset,     fieldIndex,-    handleDuplicateInsert+    handleDuplicateInsert,+    removeAutoIncIdField,   ) where -import           Control.Exception        (Exception, SomeException, try)-import           Control.Monad            (when)-import           Data.Convertible         (ConvertResult, Convertible)-import           Data.Convertible.Base    (Convertible (safeConvert))-import           Data.List                (isInfixOf)+import           Control.Exception         (Exception, SomeException, try)+import           Control.Monad             (when)+import           Data.Convertible          (ConvertResult, Convertible)+import           Data.Convertible.Base     (Convertible (safeConvert))+import           Data.List                 (isInfixOf) import           Database.GP.Conn import           Database.GP.Entity import           Database.GP.SqlGenerator import           Database.GP.TypeInfo import           Database.HDBC-import           Text.RawString.QQ import           Language.Haskell.TH.Quote (QuasiQuoter)--{- |- This is the "safe" version of the module Database.GP.GenericPersistence. It uses Either to return errors.-- This module defines RDBMS Persistence operations for Record Data Types that are instances of 'Data'.- I call instances of such a data type Entities.+import           Text.RawString.QQ         (r) - The Persistence operations are using Haskell generics to provide compile time reflection capabilities.- HDBC is used to access the RDBMS.--}+-- |+-- This is the "safe" version of the module Database.GP.GenericPersistence. It uses Either to return errors.+--+-- This module defines RDBMS Persistence operations for Record Data Types that are instances of 'Data'.+-- I call instances of such a data type Entities.+--+-- The Persistence operations are using Haskell generics to provide compile time reflection capabilities.+-- HDBC is used to access the RDBMS.  -- | exceptions that may occur during persistence operations-data PersistenceException =-    EntityNotFound String+data PersistenceException+  = EntityNotFound String   | DuplicateInsert String   | DatabaseError String   | NoUniqueKey String@@ -97,7 +101,7 @@ -- An error is thrown if there are more than one entity with the given id. selectById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> id -> IO (Either PersistenceException a) selectById conn idx = do-  --print stmt+  -- print stmt   eitherExResultRows <- try $ quickQuery conn stmt [eid]   case eitherExResultRows of     Left ex -> return $ Left $ fromException ex@@ -118,15 +122,14 @@ fromException :: SomeException -> PersistenceException fromException ex = DatabaseError $ show ex - -- | This function retrieves all entities of type `a` that match some query criteria. --   The function takes an HDBC connection and a `WhereClauseExpr` as parameters. --   The type `a` is determined by the context of the function call. --   The function returns a (possibly empty) list of all matching entities.---   The `WhereClauseExpr` is typically constructed using any tiny query dsl based on infix operators.+--   The `WhereClauseExpr` is typically constructed using a tiny query dsl based on infix operators. select :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO (Either PersistenceException [a]) select conn whereClause = do-  --print stmt+  -- print stmt   eitherExRows <- tryPE $ quickQuery conn stmt values   case eitherExRows of     Left ex          -> return $ Left ex@@ -135,6 +138,21 @@     stmt = selectFromStmt @a whereClause     values = whereClauseValues whereClause +-- | This function retrieves the number of entities of type `a` that match some query criteria.+--   The function takes an HDBC connection and a `WhereClauseExpr` as parameters.+--   The type `a` is determined by the context of the function call.+--   The function returns the number of all matching entities.+--   The `WhereClauseExpr` is typically constructed using a tiny query dsl based on infix operators.+count :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO (Either PersistenceException Int)+count conn whereClause = do+  eitherExRows <- tryPE $ quickQuery conn stmt values+  case eitherExRows of+    Left ex          -> return $ Left ex+    Right resultRows -> return $ Right $ fromSql $ head $ head resultRows -- using head twice is safe here+  where+    stmt = countStmtFor @a whereClause+    values = whereClauseValues whereClause+ -- | This function converts a list of database rows, represented as a `[[SqlValue]]` to a list of entities. --   The function takes an HDBC connection and a list of database rows as parameters. --   The type `a` is determined by the context of the function call.@@ -148,39 +166,49 @@ -- The function takes an HDBC connection and an entity as parameters. -- The entity is either inserted or updated, depending on whether it already exists in the database. -- The required SQL statements are generated dynamically using Haskell generics and reflection+upsert :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())+upsert conn entity = do+  eitherExOrA <- try $ do+    row <- toRow conn entity+    _ <- quickQuery' conn (upsertStmtFor @a) (row <> row)+    commitIfAutoCommit conn+  case eitherExOrA of+    Left ex -> return $ Left $ fromException ex+    Right _ -> return $ Right ()++-- | A function that persists an entity to a database.+-- The function takes an HDBC connection and an entity as parameters.+-- The entity is either inserted or updated, depending on whether it already exists in the database.+-- The required SQL statements are generated dynamically using Haskell generics and reflection+-- deprecated: use upsert instead+{-# DEPRECATED persist "use upsert instead" #-} persist :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())-persist conn entity = do-  eitherExRes <- try $ do-    eid <- idValue conn entity-    let stmt = selectFromStmt @a byIdColumn-    quickQuery conn stmt [eid] >>=-      \case-        []           -> insert conn entity >> return (Right ())-        [_singleRow] -> update conn entity-        _            -> return $ Left $ NoUniqueKey $ "More than one entity found for id " ++ show eid-  case eitherExRes of-    Left ex   -> return $ Left $ fromException ex-    Right res -> return res+persist = upsert + -- | A function that commits a transaction if the connection is in auto commit mode. --   The function takes an HDBC connection as parameter. commitIfAutoCommit :: Conn -> IO ()-commitIfAutoCommit conn = when (implicitCommit conn) $ commit conn+commitIfAutoCommit (Conn autoCommit conn) = when autoCommit $ commit conn  -- | A function that explicitely inserts an entity into a database.+--   The function takes an HDBC connection and an entity as parameters.+--   The entity, as retrieved from the database, is returned as a Right value if the entity was successfully inserted.+--   (this allows to handle automatically updated fields like auto-incremented primary keys)+--   If the entity could not be inserted, a Left value is returned, containing a PersistenceException. insert :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException a) insert conn entity = do   eitherExOrA <- try $ do     row <- toRow conn entity-    [singleRow] <- quickQuery' conn (insertReturningStmtFor @a) (removeIdField @a row)+    [singleRow] <- quickQuery' conn (insertReturningStmtFor @a) (removeAutoIncIdField @a row)     commitIfAutoCommit conn     fromRow @a conn singleRow   case eitherExOrA of     Left ex -> return $ Left $ handleDuplicateInsert ex-    Right a -> return $ Right a    +    Right a -> return $ Right a -removeIdField :: forall a. (Entity a) => [SqlValue] -> [SqlValue]-removeIdField row =+removeAutoIncIdField :: forall a. (Entity a) => [SqlValue] -> [SqlValue]+removeAutoIncIdField row =   if autoIncrement @a     then case maybeIdFieldIndex @a of       Nothing      -> row@@ -188,9 +216,11 @@     else row  handleDuplicateInsert :: SomeException -> PersistenceException-handleDuplicateInsert ex = -  if "UNIQUE constraint failed" `isInfixOf` show ex ||-     "duplicate key value violates unique constraint" `isInfixOf` show ex+handleDuplicateInsert ex =+  if "UNIQUE constraint failed"+    `isInfixOf` show ex+    || "duplicate key value violates unique constraint"+    `isInfixOf` show ex     then DuplicateInsert "Entity already exists in DB, use update instead"     else fromException ex @@ -209,14 +239,14 @@   eitherExUnit <- try $ do     rows <- mapM (toRow conn) entities     stmt <- prepare conn (insertStmtFor @a)-    executeMany stmt (map (removeIdField @a) rows)+    executeMany stmt (map (removeAutoIncIdField @a) rows)     commitIfAutoCommit conn   case eitherExUnit of     Left ex -> return $ Left $ handleDuplicateInsert ex     Right _ -> return $ Right () - -- | A function that explicitely updates an entity in a database.+--  The function takes an HDBC connection and an entity as parameters. update :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ()) update conn entity = do   eitherExUnit <- try $ do@@ -260,6 +290,30 @@     Left ex      -> return $ Left $ fromException ex     Right result -> return result +-- | A function that deletes an entity from a database by its id.+--   The function takes an HDBC connection and an entity id as parameters.+deleteById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> id -> IO (Either PersistenceException ())+deleteById conn idx = do+  eitherExRes <- try $ do+    let eid = toSql idx+    rowCount <- run conn (deleteStmtFor @a) [eid]+    if rowCount == 0+      then return (Left (EntityNotFound (constructorName (typeInfo @a) ++ " " ++ show eid ++ " does not exist")))+      else do+        commitIfAutoCommit conn+        return $ Right ()+  case eitherExRes of+    Left ex      -> return $ Left $ fromException ex+    Right result -> return result++-- | A function that deletes a list of entities from a database by their ids.+--   The function takes an HDBC connection and a list of entity ids as parameters.+deleteManyById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> [id] -> IO (Either PersistenceException ())+deleteManyById conn ids = tryPE $ do+  stmt <- prepare conn (deleteStmtFor @a)+  executeMany stmt (map ((: []) . toSql) ids)+  commitIfAutoCommit conn+ -- | A function that deletes a list of entities from a database. --   The function takes an HDBC connection and a list of entities as parameters. --   The delete-statement is compiled only once and then executed for each entity.@@ -271,15 +325,12 @@   commitIfAutoCommit conn  -- | set up a table for a given entity type. The table is dropped (if existing) and recreated.---   The function takes an HDBC connection as parameter.-setupTableFor :: forall a. (Entity a) => Database -> Conn -> IO ()-setupTableFor db conn = do-  --print stmt+--   The function takes an HDBC connection and a column type mapping as parameters.+setupTable :: forall a. (Entity a) => Conn -> ColumnTypeMapping -> IO ()+setupTable conn mapping = do   runRaw conn $ dropTableStmtFor @a-  runRaw conn $ stmt -- createTableStmtFor @a (db conn)+  runRaw conn $ createTableStmtFor @a mapping   commitIfAutoCommit conn-  where-    stmt = createTableStmtFor @a db   -- | A function that returns the primary key value of an entity as a SqlValue. --   The function takes an HDBC connection and an entity as parameters.@@ -290,7 +341,7 @@   where     idFieldIndex = fieldIndex @a (idField @a) --- an alias for a simple quasiqouter+-- | an alias for a simple quasiqouter sql :: QuasiQuoter sql = r 

@@ -29,7 +29,7 @@     SortOrder (..),     limit,     limitOffset,-    NonEmpty(..)+    NonEmpty (..),   ) where @@ -45,12 +45,12 @@  import           Data.Convertible   (Convertible) import           Data.List          (intercalate)+import           Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE import           Database.GP.Entity (Entity, columnNameFor, idField) import           Database.HDBC      (SqlValue, toSql)-import qualified Data.List.NonEmpty as NE-import           Data.List.NonEmpty (NonEmpty(..)) -data CompareOp = Eq | Gt | Lt | GtEq | LtEq | NotEq | Like +data CompareOp = Eq | Gt | Lt | GtEq | LtEq | NotEq | Like  data Field = Field [String] String @@ -69,7 +69,7 @@   | Limit WhereClauseExpr Int   | LimitOffset WhereClauseExpr Int Int -data SortOrder = ASC | DESC +data SortOrder = ASC | DESC   deriving (Show)  field :: String -> Field@@ -85,7 +85,7 @@ (||.) :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr (||.) = Or -infixl 4 =., >., <., >=., <=., <>., `like`, `between`, `in'` +infixl 4 =., >., <., >=., <=., <>., `like`, `between`, `in'`  (=.), (>.), (<.), (>=.), (<=.), (<>.), like :: (Convertible b SqlValue) => Field -> b -> WhereClauseExpr a =. b = Where a Eq (toSql b)@@ -126,12 +126,11 @@ orderBy = OrderBy  limit :: WhereClauseExpr -> Int -> WhereClauseExpr-limit = Limit +limit = Limit  limitOffset :: WhereClauseExpr -> (Int, Int) -> WhereClauseExpr limitOffset c (offset, lim) = LimitOffset c offset lim - whereClauseExprToSql :: forall a. (Entity a) => WhereClauseExpr -> String whereClauseExprToSql (Where f op _) = columnToSql @a f ++ " " ++ opToSql op ++ " ?" whereClauseExprToSql (And e1 e2) = "(" ++ whereClauseExprToSql @a e1 ++ ") AND (" ++ whereClauseExprToSql @a e2 ++ ")"@@ -145,22 +144,22 @@ whereClauseExprToSql (WhereIsNull f) = columnToSql @a f ++ " IS NULL" whereClauseExprToSql All = "1=1" whereClauseExprToSql (ById _eid) = idColumn @a ++ " = ?"-whereClauseExprToSql ByIdColumn  = idColumn @a ++ " = ?"+whereClauseExprToSql ByIdColumn = idColumn @a ++ " = ?" whereClauseExprToSql (OrderBy clause pairs) = whereClauseExprToSql @a clause ++ " ORDER BY " ++ renderedPairs pairs   where     renderedPairs :: NonEmpty (Field, SortOrder) -> String-    renderedPairs ne = intercalate ", " (NE.toList (NE.map (\(f,order) -> columnToSql @a f ++ " " ++ show order) ne))+    renderedPairs ne = intercalate ", " (NE.toList (NE.map (\(f, order) -> columnToSql @a f ++ " " ++ show order) ne)) whereClauseExprToSql (Limit clause x) = whereClauseExprToSql @a clause ++ " LIMIT " ++ show x-whereClauseExprToSql (LimitOffset clause offset lim) = whereClauseExprToSql @a clause ++ " LIMIT " ++ show lim ++ " OFFSET " ++ show offset -    +whereClauseExprToSql (LimitOffset clause offset lim) = whereClauseExprToSql @a clause ++ " LIMIT " ++ show lim ++ " OFFSET " ++ show offset+ opToSql :: CompareOp -> String-opToSql Eq       = "="-opToSql Gt       = ">"-opToSql Lt       = "<"-opToSql GtEq     = ">="-opToSql LtEq     = "<="-opToSql NotEq    = "<>"-opToSql Like     = "LIKE"+opToSql Eq    = "="+opToSql Gt    = ">"+opToSql Lt    = "<"+opToSql GtEq  = ">="+opToSql LtEq  = "<="+opToSql NotEq = "<>"+opToSql Like  = "LIKE"  columnToSql :: forall a. (Entity a) => Field -> String columnToSql = expandFunctions @a@@ -168,7 +167,7 @@ idColumn :: forall a. (Entity a) => String idColumn = columnNameFor @a (idField @a) -expandFunctions :: forall a. (Entity a) => Field -> String -- -> String+expandFunctions :: forall a. (Entity a) => Field -> String expandFunctions (Field [] name) = columnNameFor @a name expandFunctions (Field (f : fs) name) = f ++ "(" ++ expandFunctions @a (Field fs name) ++ ")" 

@@ -1,11 +1,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE LambdaCase          #-}  module Database.GP.SqlGenerator   ( insertStmtFor,     insertReturningStmtFor,     updateStmtFor,+    upsertStmtFor,     selectFromStmt,+    countStmtFor,     deleteStmtFor,     createTableStmtFor,     dropTableStmtFor,@@ -35,14 +36,17 @@     SortOrder (..),     limit,     limitOffset,-    NonEmpty(..),+    NonEmpty (..),     Database (..),+    defaultSqliteMapping,+    defaultPostgresMapping,+    ColumnTypeMapping,   ) where  import           Data.List          (intercalate)-import Database.GP.Entity-import Database.GP.Query+import           Database.GP.Entity+import           Database.GP.Query  -- | --  This module defines some basic SQL statements for Record Data Types that are instances of 'Entity'.@@ -57,34 +61,52 @@   "INSERT INTO "     ++ tableName @a     ++ " ("-    ++ intercalate ", " insertColumns+    ++ intercalate ", " insertCols     ++ ") VALUES ("-    ++ intercalate ", " (params (length insertColumns))+    ++ intercalate ", " (params (length insertCols))     ++ ");"   where+    insertCols = insertColumns @a++upsertStmtFor :: forall a. Entity a => String+upsertStmtFor =+  "INSERT INTO "+    ++ tableName @a+    ++ " ("+    ++ intercalate ", " insertCols+    ++ ") VALUES ("+    ++ intercalate ", " (params (length insertCols))+    ++ ") ON CONFLICT ("+    ++ idColumn @a+    ++ ") DO UPDATE SET "+    ++ intercalate ", " updatePairs+    ++ ";"+  where+    insertCols = columnNamesFor @a+    updatePairs = map (++ " = ?") insertCols++insertColumns :: forall a. Entity a => [String]+insertColumns = +  if autoIncrement @a+    then filter (/= idColumn @a) columns+    else columns +  where     columns = columnNamesFor @a-    insertColumns = if autoIncrement @a -                  then filter (/= idColumn @a) columns -                  else columns  insertReturningStmtFor :: forall a. Entity a => String insertReturningStmtFor =   "INSERT INTO "     ++ tableName @a     ++ " ("-    ++ intercalate ", " insertColumns+    ++ intercalate ", " insertCols     ++ ") VALUES ("-    ++ intercalate ", " (params (length insertColumns))+    ++ intercalate ", " (params (length insertCols))     ++ ") RETURNING "-    ++ returnColumns+    ++ returnCols     ++ ";"   where-    columns = columnNamesFor @a  -    insertColumns = if autoIncrement @a -                      then filter (/= idColumn @a) columns -                      else columns-    returnColumns = intercalate ", " columns-+    insertCols = insertColumns @a+    returnCols = intercalate ", " (columnNamesFor @a)  columnNamesFor :: forall a. Entity a => [String] columnNamesFor = map snd fieldColumnPairs@@ -117,6 +139,17 @@     ++ whereClauseExprToSql @a whereClauseExpr     ++ ";" +-- | A function that returns an SQL count statement for an entity. Type 'a' must be an instance of Entity.+--   The function takes a where clause expression as parameter. This expression is used to filter the result set.+countStmtFor :: forall a. (Entity a) => WhereClauseExpr -> String+countStmtFor whereClauseExpr =+  "SELECT COUNT(*) FROM "+    ++ tableName @a+    ++ " WHERE "+    ++ whereClauseExprToSql @a whereClauseExpr+    ++ ";"++-- | A function that returns an SQL delete statement for an entity. Type 'a' must be an instance of Entity. deleteStmtFor :: forall a. (Entity a) => String deleteStmtFor =   "DELETE FROM "@@ -125,58 +158,63 @@     ++ idColumn @a     ++ " = ?;" --- | An enumeration of the supported database types.-data Database = Postgres | SQLite -- | Oracle | MSSQL | MySQL-  deriving (Show, Eq)+-- | An enumeration of the supported database types. +data Database = Postgres | SQLite -createTableStmtFor :: forall a. (Entity a) => Database -> String-createTableStmtFor dbServer =+-- | A function that returns an SQL create table statement for an entity type. Type 'a' must be an instance of Entity.+createTableStmtFor :: forall a. (Entity a) => ColumnTypeMapping -> String+createTableStmtFor columnTypeMapping =   "CREATE TABLE "     ++ tableName @a     ++ " ("-    ++ intercalate ", " (map (\(f, c) -> c ++ " " ++ columnTypeFor @a dbServer f ++ optionalPK f) (fieldsToColumns @a))+    ++ intercalate ", " (map (\(f, c) -> c ++ " " ++ columnTypeFor @a columnTypeMapping f ++ optionalPK f) (fieldsToColumns @a))     ++ ");"   where-    optionalPK f = if isIdField @a f -                    then case dbServer of-                      SQLite   -> " PRIMARY KEY AUTOINCREMENT"-                      Postgres -> " PRIMARY KEY"-                    else ""+    optionalPK f = if isIdField @a f then " PRIMARY KEY" else ""  isIdField :: forall a. (Entity a) => String -> Bool isIdField f = f == idField @a  -- | A function that returns the column type for a field of an entity.--- TODO: Support other databases than just SQLite and Postgres.-columnTypeFor :: forall a. (Entity a) => Database -> String -> String-columnTypeFor dbDialect fieldName =-  case dbDialect of-    SQLite   -> columnTypeForSQLite fType-    Postgres -> if isIdField @a fieldName -                  then "serial"-                  else columnTypeForPostgres fType+--   The function takes a column type mapping function as parameter.+--   This function is used to map Haskell field types to SQL column types.+columnTypeFor :: forall a. (Entity a) => ColumnTypeMapping -> String -> String+columnTypeFor columnTypeMapping fieldName = columnTypeMapping fType   where-    maybeFType = maybeFieldTypeFor @a fieldName-    fType = maybe "OTHER" show maybeFType-  -    columnTypeForSQLite :: String -> String-    columnTypeForSQLite = \case  -        "Int"    -> "INTEGER"-        "[Char]" -> "TEXT"-        "Double" -> "REAL"-        "Float"  -> "REAL"-        "Bool"   -> "INT"-        _        -> "TEXT"+    fType = +      if isIdField @a fieldName +        then "primaryKey"+        else maybe "OTHER" show $ maybeFieldTypeFor @a fieldName -    columnTypeForPostgres :: String -> String-    columnTypeForPostgres = \case  -        "Int"    -> "numeric"-        "[Char]" -> "varchar"-        "Double" -> "numeric"-        "Float"  -> "numeric"-        "Bool"   -> "boolean"-        _        -> "varchar"+-- | A type alias for mapping a Haskell field type to a SQL column type.+--   this type can be used to define custom mappings for field types.+type ColumnTypeMapping = String -> String +-- | The default mapping for SQLite databases.+--   This mapping is used when no custom mapping is provided.+defaultSqliteMapping :: ColumnTypeMapping+defaultSqliteMapping = \case+  "primaryKey" -> "INTEGER"+  "Int"    -> "INTEGER"+  "[Char]" -> "TEXT"+  "Double" -> "REAL"+  "Float"  -> "REAL"+  "Bool"   -> "INT"+  _        -> "TEXT"++-- | The default mapping for Postgres databases.+--   This mapping is used when no custom mapping is provided.+defaultPostgresMapping :: ColumnTypeMapping+defaultPostgresMapping = \case+  "primaryKey" -> "serial"+  "Int"    -> "numeric"+  "[Char]" -> "varchar"+  "Double" -> "numeric"+  "Float"  -> "numeric"+  "Bool"   -> "boolean"+  _        -> "varchar"++-- | This function generates a DROP TABLE statement for an entity type. dropTableStmtFor :: forall a. (Entity a) => String dropTableStmtFor =   "DROP TABLE IF EXISTS "

@@ -34,7 +34,7 @@     { constructorName = gConstrName (undefined :: a),       fieldNames = map fst (gSelectors (undefined :: a)),       fieldTypes = map snd (gSelectors (undefined :: a))-    } +    }  -- Generic implementations gConstrName :: (HasConstructor (Rep a), Generic a) => a -> String

@@ -1,6 +1,3 @@--- allows automatic derivation from Entity type class-{-# LANGUAGE DeriveAnyClass #-}- module ConnSpec   ( test,     spec,@@ -8,13 +5,13 @@ where  import           Database.GP+import           Database.HDBC import           Database.HDBC.Sqlite3 import           GHC.Generics import           Test.Hspec-import Database.HDBC  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -22,7 +19,7 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Article SQLite conn+  setupTable @Article conn defaultSqliteMapping   return conn  data Article = Article@@ -36,9 +33,9 @@ spec = do   describe "Connection Handling" $ do     it "can work with embedded connection" $ do-      Conn{implicitCommit=ic, connection=conn} <- prepareDB+      (Conn ic conn) <- prepareDB       ic `shouldBe` True-      +       runRaw conn "DROP TABLE IF EXISTS Person;"       let conn' = connect AutoCommit conn @@ -47,9 +44,9 @@      it "can handle rollback" $ do       conn <- prepareDB-      let conn' = conn{implicitCommit=False}+      let conn' = connect ExplicitCommit conn       let article = Article 1 "Hello" 2023-      +       _ <- insert conn' article       allArticles <- select conn' allEntries :: IO [Article]       allArticles `shouldBe` [article]@@ -59,10 +56,10 @@      it "provide the IConnection methods" $ do       conn <- prepareDB-      allTables <- getTables conn +      allTables <- getTables conn       allTables `shouldContain` ["Article"] -      desc <- describeTable conn "Article" +      desc <- describeTable conn "Article"       length desc `shouldBe` 3        let driverName = hdbcDriverName conn@@ -83,14 +80,6 @@       let txSupport = dbTransactionSupport conn       txSupport `shouldBe` True -      clonedConn <- clone conn-      implicitCommit clonedConn `shouldBe` implicitCommit conn-----      -      -      --+      let (Conn autoCommit _) = conn+      (Conn clonedAutoCommit _) <- clone conn+      clonedAutoCommit `shouldBe` autoCommit

@@ -9,8 +9,8 @@ import           Database.GP import           Database.HDBC.Sqlite3 (connectSqlite3) import           GHC.Generics-import           Test.Hspec import           Prelude               hiding (print)+import           Test.Hspec  -- `test` is here so that this module can be run from GHCi on its own.  It is -- not needed for automatic spec discovery.@@ -41,7 +41,7 @@       conn <- connect AutoCommit <$> connectSqlite3 "sqlite.db"        -- initialize Person table-      setupTableFor @Person SQLite conn+      setupTable @Person conn defaultSqliteMapping        alice <- insert conn Person {name = "Alice", age = 25, address = "Elmstreet 1"}       print alice

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveAnyClass #-}- module EmbeddedSpec   ( test,     spec,@@ -13,7 +11,7 @@ import           Test.Hspec  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -21,7 +19,7 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Article SQLite conn+  setupTable @Article conn defaultSqliteMapping   return conn  data Article = Article

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveAnyClass #-}- module EnumSpec   ( test,     spec,@@ -14,7 +12,7 @@ import           Test.Hspec  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -22,7 +20,7 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Book SQLite conn+  setupTable @Book conn defaultSqliteMapping   return conn  data Book = Book

@@ -1,21 +1,18 @@--- allows automatic derivation from Entity type class-{-# LANGUAGE DeriveAnyClass #-}- module ExceptionsSpec   ( test,     spec,   ) where +import           Control.Exception import           Database.GP.GenericPersistenceSafe+import           Database.HDBC import           Database.HDBC.Sqlite3 import           GHC.Generics import           Test.Hspec-import           Database.HDBC-import           Control.Exception  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -23,7 +20,7 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Article SQLite conn+  setupTable @Article conn defaultSqliteMapping   return conn  data Article = Article@@ -35,20 +32,21 @@  instance Entity Article where   autoIncrement = False+  idField = "articleID"  data Bogus = Bogus-  { bogusID :: Int,+  { bogusID    :: Int,     bogusTitle :: String,-    bogusYear :: Int+    bogusYear  :: Int   }   deriving (Generic, Show, Eq)  instance Entity Bogus where   tableName = "Article" --  fieldsToColumns :: [(String, String)]                  -- ommitting the articles field, -  fieldsToColumns =                                      -- as this can not be mapped to a single column+  fieldsToColumns :: [(String, String)] -- ommitting the articles field,+  fieldsToColumns =+    -- as this can not be mapped to a single column     [ ("bogusID", "articleID"),       ("bogusTitle", "title"),       ("bogusYear", "year")@@ -57,7 +55,6 @@   fromRow :: Conn -> [SqlValue] -> IO Bogus   fromRow _conn _row = throw $ DatabaseError "can't create bogus" - yearField :: Field yearField = field "year" @@ -76,39 +73,35 @@       eitherExRes <- insert conn article :: IO (Either PersistenceException Article)       case eitherExRes of         Left di@(DuplicateInsert _msg) -> show di `shouldContain` "Entity already exists"-        _                          -> expectationFailure "Expected DuplicateInsert exception"+        _ -> expectationFailure "Expected DuplicateInsert exception"     it "detects duplicate inserts in insertMany" $ do       conn <- prepareDB       _ <- insert conn article-      eitherExRes <- insertMany conn [article,article] :: IO (Either PersistenceException ())+      eitherExRes <- insertMany conn [article, article] :: IO (Either PersistenceException ())       case eitherExRes of         Left (DuplicateInsert msg) -> msg `shouldContain` "Entity already exists"-        _                          -> expectationFailure "Expected DuplicateInsert exception"-    it "detects duplicate inserts in persist" $ do-      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-      runRaw conn "CREATE TABLE article (articleID INTEGER, title TEXT, year INTEGER)"-      _ <- insert conn article-      _ <- insert conn article{title="another title"}-      eitherExRes <- persist conn article :: IO (Either PersistenceException ())+        _ -> expectationFailure "Expected DuplicateInsert exception"+    it "returns () for successful upsert" $ do+      conn <- prepareDB+      eitherExRes <- upsert conn article :: IO (Either PersistenceException ())       case eitherExRes of-        Left (NoUniqueKey msg) -> msg `shouldContain` "More than one entity found for id SqlInt64 1"-        Left pe                -> expectationFailure $ "Expected NoUniqueKey exception, got " ++ show pe-        _                      -> expectationFailure "Expected NoUniqueKey exception"+        Right () -> expectationSuccess+        _        -> expectationFailure "Expected ()"     it "detects missing entities in selectById" $ do       conn <- prepareDB       eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Article)       case eitherExRes of         Left (EntityNotFound msg) -> msg `shouldContain` "not found"-        _                         -> expectationFailure "Expected EntityNotFound exception"+        _ -> expectationFailure "Expected EntityNotFound exception"     it "detects non unique entities in selectById" $ do       conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       runRaw conn "CREATE TABLE article (articleID INTEGER, title TEXT, year INTEGER)"       _ <- insert conn article-      _ <- insert conn article{title="another title"}+      _ <- insert conn article {title = "another title"}       eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Article)       case eitherExRes of         Left (NoUniqueKey msg) -> msg `shouldContain` "More than one Article found for id SqlString \"1\""-        _                      -> expectationFailure "Expected DuplicateEntity exception"+        _ -> expectationFailure "Expected DuplicateEntity exception"      it "detects bogus data in selectById" $ do       conn <- prepareDB@@ -116,36 +109,48 @@       eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Bogus)       case eitherExRes of         Left (DatabaseError msg) -> msg `shouldContain` "can't create bogus"-        Left pe                  -> expectationFailure $ "Expected DatabaseError exception, got " ++ show pe-        _                        -> expectationFailure "Expected DatabaseError exception"+        Left pe -> expectationFailure $ "Expected DatabaseError exception, got " ++ show pe+        _ -> expectationFailure "Expected DatabaseError exception"      it "detects missing entities in update" $ do       conn <- prepareDB       eitherExRes <- update conn article :: IO (Either PersistenceException ())       case eitherExRes of         Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"-        _                         -> expectationFailure "Expected EntityNotFound exception"+        _ -> expectationFailure "Expected EntityNotFound exception"     it "detects missing entities in delete" $ do       conn <- prepareDB       eitherExRes <- delete conn article :: IO (Either PersistenceException ())       case eitherExRes of         Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"-        _                         -> expectationFailure "Right: Expected EntityNotFound exception"+        _ -> expectationFailure "Right: Expected EntityNotFound exception"+    it "detects missing entities in deleteById" $ do+      conn <- prepareDB+      eitherExRes <- deleteById @Article conn "1" :: IO (Either PersistenceException ())+      case eitherExRes of+        Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"+        _ -> expectationFailure "Expected EntityNotFound exception"+    it "detects general db issues in deleteById" $ do+      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+      eitherExRes <- deleteById @Article conn "1" :: IO (Either PersistenceException ())+      case eitherExRes of+        Left (DatabaseError msg) -> msg `shouldContain` "SqlError"+        _ -> expectationFailure "Expected DatabaseError exception"     it "detects general backend issues" $ do       conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       eitherExRes <- update conn article :: IO (Either PersistenceException ())       case eitherExRes of         Left (DatabaseError msg) -> msg `shouldContain` "SqlError"-        _                        -> expectationFailure "Expected DatabaseError exception"+        _ -> expectationFailure "Expected DatabaseError exception"     it "has no leaking backend exceptions" $ do       conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       _ <- update conn article :: IO (Either PersistenceException ())       _ <- insert conn article :: IO (Either PersistenceException Article)-      _ <- persist conn article :: IO (Either PersistenceException ())+      _ <- upsert conn article :: IO (Either PersistenceException ())       _ <- delete conn article :: IO (Either PersistenceException ())       _ <- selectById conn "1" :: IO (Either PersistenceException Article)       _ <- select conn allEntries :: IO (Either PersistenceException [Article])-      _ <- select conn (yearField =. "2023")  :: IO (Either PersistenceException [Article])+      _ <- select conn (yearField =. "2023") :: IO (Either PersistenceException [Article])       _ <- insertMany conn [article] :: IO (Either PersistenceException ())       _ <- updateMany conn [article] :: IO (Either PersistenceException ())       _ <- deleteMany conn [article] :: IO (Either PersistenceException ())@@ -164,5 +169,42 @@       print index `shouldThrow` errorCall "expectJust Field unknown is not present in type Article"      it "handles duplicate insert exceptions" $ do-      handleDuplicateInsert (toException $ EntityNotFound "24" ) `shouldBe` DatabaseError "EntityNotFound \"24\""-    +      handleDuplicateInsert (toException $ EntityNotFound "24") `shouldBe` DatabaseError "EntityNotFound \"24\""++    it "handles autoincrement edge cases" $ do+      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+      let article' = Article 200 "title" 2023+          expectedRow = [SqlInt64 200, SqlString "title", SqlInt64 2023]+      articleRow <- toRow conn article'+      articleRow `shouldBe` expectedRow+      -- Article is defined with autoIncrement = False+      removeAutoIncIdField @Article articleRow `shouldBe` expectedRow++      -- ArticleWithoutPK is defined with autoIncrement = True, but has no primary key field+      let articleWithoutPK = ArticleWithoutPK "title" 2023+          rowWithoutPK = [SqlString "title", SqlInt64 2023]+      articleRowWithoutPK <- toRow conn articleWithoutPK+      removeAutoIncIdField @ArticleWithoutPK articleRowWithoutPK `shouldBe` rowWithoutPK++      -- ArticleWithPKatEnd is defined with autoIncrement = True and has a primary key field as last column+      let articleWithPKatEnd = ArticleWithPKatEnd "title" 2023 200+          expectedRow2 = [SqlString "title", SqlInt64 2023]+      articleRowWithPKatEnd <- toRow conn articleWithPKatEnd+      removeAutoIncIdField @ArticleWithPKatEnd articleRowWithPKatEnd `shouldBe` expectedRow2++data ArticleWithoutPK = ArticleWithoutPK+  { title1 :: String,+    year1  :: Int+  }+  deriving (Generic, Show, Entity, Eq)++data ArticleWithPKatEnd = ArticleWithPKatEnd+  { title2     :: String,+    year2      :: Int,+    articleID2 :: Int+  }+  deriving (Generic, Show, Eq)++instance Entity ArticleWithPKatEnd where+  autoIncrement = True+  idField = "articleID2"

@@ -1,6 +1,6 @@--- allows automatic derivation from Entity type class-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-missing-fields #-}  module GenericPersistenceSpec   ( test,@@ -8,15 +8,15 @@   ) where +import           Control.Exception import           Database.GP.GenericPersistence import           Database.HDBC import           Database.HDBC.Sqlite3-import           GHC.Generics hiding (Selector)+import           GHC.Generics                   hiding (Selector) import           Test.Hspec-import           Control.Exception  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -24,8 +24,10 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Person SQLite conn-  setupTableFor @Book SQLite conn+  setupTable @Person conn defaultSqliteMapping+  setupTable @Book conn defaultSqliteMapping+  setupTable @Car conn defaultSqliteMapping+  setupTable @Boat conn defaultSqliteMapping   return conn  -- | A data type with several fields, using record syntax.@@ -38,14 +40,27 @@   deriving (Generic, Show, Eq)  instance Entity Person where-  autoIncrement = False +  autoIncrement = False  data Car = Car-  { carID :: Int,-    carType  :: String+  { carID   :: Int,+    carType :: String   }-  deriving (Generic, Entity, Show, Eq)+  deriving (Generic, Show, Eq) +instance Entity Car where+  autoIncrement = True+  idField = "carID"++data Boat = Boat+  { boatID :: Int,+    boatType :: String+  }+  deriving (Generic, Show, Eq)++instance Entity Boat where+  autoIncrement = False+ data Book = Book   { book_id  :: Int,     title    :: String,@@ -60,8 +75,13 @@  instance Entity Book where   idField = "book_id"-  fieldsToColumns = [("book_id", "bookId"), ("title", "bookTitle"), ("author", "bookAuthor"), -                     ("year", "bookYear"), ("category", "bookCategory")]+  fieldsToColumns =+    [ ("book_id", "bookId"),+      ("title", "bookTitle"),+      ("author", "bookAuthor"),+      ("year", "bookYear"),+      ("category", "bookCategory")+    ]   tableName = "BOOK_TBL"   fromRow _c row = pure $ Book (col 0) (col 1) (col 2) (col 3) (col 4)     where@@ -99,17 +119,28 @@       head allPersons `shouldBe` bob       person' <- selectById conn (1 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just bob+    it "retrieves the number of selected Entities" $ do+      conn <- prepareDB+      insertMany conn manyPersons+      countPersons <- count @Person conn allEntries+      countPersons `shouldBe` 6+    it "signals if counting fails" $ do+      conn <- connect AutoCommit <$> connectSqlite3 ":memory:" -- no tables in db+      eitherEA <- try (count @Person conn allEntries)+      case eitherEA of+        Left (DatabaseError msg) -> msg `shouldContain` "no such table: Person"+        _ -> expectationFailure "Expected DatabaseError"     it "selectById returns Nothing if no Entity was found" $ do       conn <- prepareDB       person' <- selectById conn (1 :: Int) :: IO (Maybe Person)       person' `shouldBe` Nothing-    it "selectById throws a DatabaseError if things go wrong in the DB" $ do +    it "selectById throws a DatabaseError if things go wrong in the DB" $ do       conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       eitherEA <- try (selectById conn (1 :: Int) :: IO (Maybe Person))       case eitherEA of         Left (DatabaseError msg) -> msg `shouldContain` "no such table: Person"-        Left  _ -> expectationFailure "Expected DatabaseError"-        Right _ -> expectationFailure "Expected DatabaseError"  +        Left _                   -> expectationFailure "Expected DatabaseError"+        Right _                  -> expectationFailure "Expected DatabaseError"     it "retrieves Entities using user implementation" $ do       conn <- prepareDB       let hobbit = Book 1 "The Hobbit" "J.R.R. Tolkien" 1937 Fiction@@ -120,35 +151,60 @@       length allBooks `shouldBe` 3       head allBooks `shouldBe` hobbit       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)-      book' `shouldBe` Just hobbit     +      book' `shouldBe` Just hobbit     it "select returns Nothing if no Entity was found" $ do       conn <- prepareDB       allPersons' <- select @Person conn allEntries       allPersons' `shouldBe` []-    it "select throws a DatabaseError if things go wrong" $ do +    it "select throws a DatabaseError if things go wrong" $ do       conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       eitherEA <- try (select @Person conn allEntries)       case eitherEA of         Left (DatabaseError msg) -> msg `shouldContain` "no such table: Person"-        Left  _ -> expectationFailure "Expected DatabaseError"-        Right _ -> expectationFailure "Expected DatabaseError"  -    it "can materialize Entities from user defined SQL queries" $ do +        Left _                   -> expectationFailure "Expected DatabaseError"+        Right _                  -> expectationFailure "Expected DatabaseError"+    it "can materialize Entities from user defined SQL queries" $ do       conn <- prepareDB       insertMany conn manyPersons-      let stmt = [sql|-                    SELECT * -                    FROM Person +      let stmt =+            [sql|+                    SELECT *+                    FROM Person                     WHERE age >= ?                     ORDER BY age ASC                     |]       resultRows <- quickQuery conn stmt [toSql (40 :: Int)]       allPersons <- entitiesFromRows @Person conn resultRows       length allPersons `shouldBe` 3+    it "can upsert Entities with AutoIncrement" $ do+      conn <- prepareDB+      let car = Car 1 "Honda Jazz"+      -- insert the car+      upsert conn car+      car' <- selectById conn (1 :: Int) :: IO (Maybe Car)+      car' `shouldBe` Just car+      -- now update the car +      let car2 = Car 1 "Honda Civic"+      upsert conn car2+      car2' <- selectById conn (1 :: Int) :: IO (Maybe Car)+      car2' `shouldBe` Just car2+    it "can upsert Entities without autoIncrement" $ do+      conn <- prepareDB+      let boat = Boat 1 "Sailboat"+      -- insert the boat+      upsert conn boat+      boat' <- selectById conn (1 :: Int) :: IO (Maybe Boat)+      boat' `shouldBe` Just boat+      -- now update the boat +      let boat2 = Boat 1 "Motorboat"+      upsert conn boat2+      boat2' <- selectById conn (1 :: Int) :: IO (Maybe Boat)+      boat2' `shouldBe` Just boat2     it "persists new Entities using Generics" $ do       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0-      persist conn person+      upsert conn person       allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 1       person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)@@ -162,13 +218,13 @@       length allbooks' `shouldBe` 1       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book-    it "persist throws an exception if things go wrong" $ do +    it "persist throws an exception if things go wrong" $ do       conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       eitherEA <- try (persist conn book)       case eitherEA of         Left (DatabaseError msg) -> msg `shouldContain` "no such table: BOOK_TBL"-        Left  _ -> expectationFailure "Expected DatabaseError"-        Right _ -> expectationFailure "Expected DatabaseError" +        Left _ -> expectationFailure "Expected DatabaseError"+        Right _ -> expectationFailure "Expected DatabaseError"     it "persists existing Entities using Generics" $ do       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]@@ -188,7 +244,7 @@       length allbooks' `shouldBe` 1       eitherEA <- try $ persist conn book {year = 1938} :: IO (Either PersistenceException ())       case eitherEA of-        Left  _ -> expectationFailure "should not throw an exception"+        Left _  -> expectationFailure "should not throw an exception"         Right x -> x `shouldBe` ()       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book {year = 1938}@@ -196,15 +252,14 @@       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0-      _ <-  insert conn person+      _ <- insert conn person       allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 1       person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just person     it "inserts Entities with autoincrement handling" $ do       conn <- prepareDB-      _ <- run conn "CREATE TABLE Car (carID INTEGER PRIMARY KEY AUTOINCREMENT, carType TEXT);" []-      myCar@(Car carId _) <- insert conn (Car 0 "Honda Jazz")+      myCar@(Car carId _) <- insert conn Car {carType = "Honda Jazz"}       myCar' <- selectById conn carId :: IO (Maybe Car)       myCar' `shouldBe` Just myCar     it "inserts many Entities re-using a single prepared stmt" $ do@@ -214,6 +269,12 @@       insertMany conn manyPersons       allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 6+    it "inserts many alsodoes autoincrement handling" $ do+      conn <- prepareDB+      insertMany conn [Car {carType = "Honda Jazz"}]+      [Car carId typ] <- select @Car conn allEntries+      typ `shouldBe` "Honda Jazz"+      carId `shouldBe` 1     it "updates many Entities re-using a single prepared stmt" $ do       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]@@ -231,11 +292,32 @@       length allPersons `shouldBe` 0       insertMany conn manyPersons       allPersons' <- select conn allEntries :: IO [Person]-      length allPersons' `shouldBe` 6   +      length allPersons' `shouldBe` 6       deleteMany conn allPersons'       allPersons'' <- select conn allEntries :: IO [Person]       length allPersons'' `shouldBe` 0 +    it "deletes a single entity by a given id" $ do+      conn <- prepareDB+      insertMany conn manyPersons+      res <- deleteById @Person conn (6 :: Int)+      res `shouldBe` ()+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 5+    it "signals if deleting by id fails" $ do+      conn <- prepareDB+      eitherEA <- try (deleteById @Person conn (6 :: Int))+      case eitherEA of+        Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"+        _ -> expectationFailure "Expected EntityNotFound exception"++    it "deletes multiple entities by a list of ids" $ do+      conn <- prepareDB+      insertMany conn manyPersons+      deleteManyById @Person conn ([2,4,6] :: [Int])+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 3+     it "inserts Entities using user implementation" $ do       conn <- prepareDB       allbooks <- select conn allEntries :: IO [Book]@@ -274,9 +356,9 @@       allBooks' <- select conn allEntries :: IO [Book]       length allBooks' `shouldBe` 0     it "provides a Connection Pool" $ do-      connPool <- sqlLitePool ":memory:" +      connPool <- sqlLitePool ":memory:"       withResource connPool $ \conn -> do-        setupTableFor @Person SQLite conn+        setupTable @Person conn defaultSqliteMapping         _ <- insert conn person         allPersons <- select conn allEntries :: IO [Person]         length allPersons `shouldBe` 1

@@ -1,21 +1,18 @@--- allows automatic derivation from Entity type class-{-# LANGUAGE DeriveAnyClass #-}- module OneToManySafeSpec   ( test,     spec,   ) where +import           Data.Either                        (fromRight) import           Database.GP.GenericPersistenceSafe import           Database.HDBC import           Database.HDBC.Sqlite3 import           GHC.Generics import           Test.Hspec-import           Data.Either                    (fromRight)  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl -- test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -23,8 +20,8 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Article SQLite conn-  setupTableFor @Author SQLite conn+  setupTable @Article conn defaultSqliteMapping+  setupTable @Author conn defaultSqliteMapping   return conn  data Article = Article@@ -36,7 +33,7 @@   deriving (Generic, Show, Eq)  instance Entity Article where-  autoIncrement = False +  autoIncrement = False  data Author = Author   { authorID :: Int,@@ -47,8 +44,9 @@   deriving (Generic, Show, Eq)  instance Entity Author where-  fieldsToColumns :: [(String, String)]                  -- ommitting the articles field, -  fieldsToColumns =                                      -- as this can not be mapped to a single column+  fieldsToColumns :: [(String, String)] -- ommitting the articles field,+  fieldsToColumns =+    -- as this can not be mapped to a single column     [ ("authorID", "authorID"),       ("name", "name"),       ("address", "address")@@ -56,18 +54,21 @@    fromRow :: Conn -> [SqlValue] -> IO Author   fromRow conn row = do-    let authID = head row                                 -- authorID is the first column-    articlesBy <- (fromRight []) <$> select @Article conn (field "authorId" =. authID) -- retrieve all articles by this author-    return rawAuthor {articles = articlesBy}              -- add the articles to the author+    let authID = head row -- authorID is the first column+    articlesBy <- fromRight [] <$> select @Article conn (field "authorId" =. authID) -- retrieve all articles by this author+    return rawAuthor {articles = articlesBy} -- add the articles to the author     where-      rawAuthor = Author (col 0) (col 1) (col 2) []       -- create the author from row (w/o articles)-      col i = fromSql (row !! i)                          -- helper function to convert SqlValue to Haskell type+      rawAuthor = Author (col 0) (col 1) (col 2) [] -- create the author from row (w/o articles)+      col i = fromSql (row !! i) -- helper function to convert SqlValue to Haskell type    toRow :: Conn -> Author -> IO [SqlValue]   toRow conn a = do-    mapM_ (persist conn) (articles a)                     -- persist all articles of this author (update or insert)-    return [toSql (authorID a),                           -- return the author as a list of SqlValues-            toSql (name a), toSql (address a)]+    mapM_ (persist conn) (articles a) -- persist all articles of this author (update or insert)+    return+      [ toSql (authorID a), -- return the author as a list of SqlValues+        toSql (name a),+        toSql (address a)+      ]   autoIncrement = False  article1 :: Article@@ -127,7 +128,7 @@         Left _ -> fail "should not happen"         Right author -> do           length (articles author) `shouldBe` 2-      +       _ <- persist conn arthur {address = "New York"}       eitherPeAuthor' <- selectById @Author conn "2"       eitherPeAuthor' `shouldBe` Right arthur {address = "New York"}@@ -141,10 +142,10 @@       eitherPeUnit <- delete conn arthur       case eitherPeUnit of         Left (DatabaseError msg) -> msg `shouldContain` "no such table: Author"-        _ -> fail "should not happen"+        _                        -> fail "should not happen"     it "insertMany works with references" $ do       conn <- prepareDB-      let authors = [arthur, arthur{name="Bob", authorID=3, articles=[]}]+      let authors = [arthur, arthur {name = "Bob", authorID = 3, articles = []}]       eitherPeUnit <- insertMany conn authors       eitherPeUnit `shouldBe` Right ()       eitherPeAuthors <- select @Author conn allEntries@@ -158,7 +159,7 @@       eitherPeAuthor `shouldBe` Right arthur {address = "New York"}     it "updateMany works with references" $ do       conn <- prepareDB-      let authors = [arthur, arthur{name="Bob", authorID=3, articles=[]}]+      let authors = [arthur, arthur {name = "Bob", authorID = 3, articles = []}]       _ <- insertMany conn authors       eitherPeUnit <- updateMany conn (map (\a -> a {address = "New York"}) authors)       eitherPeUnit `shouldBe` Right ()@@ -166,11 +167,9 @@       eitherPeAuthors `shouldBe` Right (map (\a -> a {address = "New York"}) authors)     it "deleteMany works with references" $ do       conn <- prepareDB-      let authors = [arthur, arthur{name="Bob", authorID=3, articles=[]}]+      let authors = [arthur, arthur {name = "Bob", authorID = 3, articles = []}]       _ <- insertMany conn authors       eitherPeUnit <- deleteMany conn authors       eitherPeUnit `shouldBe` Right ()       eitherPeAuthors <- select @Author conn allEntries       eitherPeAuthors `shouldBe` Right []--

@@ -1,6 +1,3 @@--- allows automatic derivation from Entity type class-{-# LANGUAGE DeriveAnyClass #-}- module OneToManySpec   ( test,     spec,@@ -15,7 +12,7 @@ import           Test.Hspec  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl -- test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -23,8 +20,8 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Article SQLite conn-  setupTableFor @Author SQLite conn+  setupTable @Article conn defaultSqliteMapping+  setupTable @Author conn defaultSqliteMapping   return conn  data Article = Article@@ -36,7 +33,7 @@   deriving (Generic, Show, Eq)  instance Entity Article where-  autoIncrement = False   +  autoIncrement = False  data Author = Author   { authorID :: Int,@@ -47,8 +44,9 @@   deriving (Generic, Show, Eq)  instance Entity Author where-  fieldsToColumns :: [(String, String)]                  -- ommitting the articles field, -  fieldsToColumns =                                      -- as this can not be mapped to a single column+  fieldsToColumns :: [(String, String)] -- ommitting the articles field,+  fieldsToColumns =+    -- as this can not be mapped to a single column     [ ("authorID", "authorID"),       ("name", "name"),       ("address", "address")@@ -57,19 +55,21 @@    fromRow :: Conn -> [SqlValue] -> IO Author   fromRow conn row = do-    let authID = head row                                 -- authorID is the first column+    let authID = head row -- authorID is the first column     articlesBy <- select conn (field "authorId" =. authID) -- retrieve all articles by this author-    return rawAuthor {articles = articlesBy}              -- add the articles to the author+    return rawAuthor {articles = articlesBy} -- add the articles to the author     where-      rawAuthor = Author (col 0) (col 1) (col 2) []       -- create the author from row (w/o articles)-      col i = fromSql (row !! i)                          -- helper function to convert SqlValue to Haskell type+      rawAuthor = Author (col 0) (col 1) (col 2) [] -- create the author from row (w/o articles)+      col i = fromSql (row !! i) -- helper function to convert SqlValue to Haskell type    toRow :: Conn -> Author -> IO [SqlValue]   toRow conn a = do-    mapM_ (persist conn) (articles a)                     -- persist all articles of this author (update or insert)-    return [toSql (authorID a),                           -- return the author as a list of SqlValues-            toSql (name a), toSql (address a)]-+    mapM_ (persist conn) (articles a) -- persist all articles of this author (update or insert)+    return+      [ toSql (authorID a), -- return the author as a list of SqlValues+        toSql (name a),+        toSql (address a)+      ]  article1 :: Article article1 =

@@ -1,9 +1,8 @@-{-# LANGUAGE DeriveAnyClass #-}-module PostgresQuerySpec -( test-, spec-)-where +module PostgresQuerySpec+  ( test,+    spec,+  )+where  import           Database.GP import           Database.GP.SqlGenerator@@ -12,15 +11,15 @@ import           Test.Hspec  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec  prepareDB :: IO Conn prepareDB = do-  conn <- connect ExplicitCommit <$> connectPostgreSQL  "host=localhost dbname=postgres user=postgres password=admin port=5431" -  setupTableFor @Person Postgres conn+  conn <- connect ExplicitCommit <$> connectPostgreSQL "host=localhost dbname=postgres user=postgres password=admin port=5431"+  setupTable @Person conn defaultPostgresMapping    insertMany conn [alice, bob, charlie]   commit conn@@ -36,7 +35,7 @@   deriving (Generic, Show, Eq)  instance Entity Person where-  autoIncrement = False +  autoIncrement = False  alice, bob, charlie, dave :: Person bob = Person 1 "Bob" 36 "West Street 79"@@ -50,10 +49,10 @@ addressField = field "address"  lower :: Field -> Field-lower = sqlFun "LOWER";+lower = sqlFun "LOWER"  upper :: Field -> Field-upper = sqlFun "UPPER";+upper = sqlFun "UPPER"  spec :: Spec spec = do@@ -64,12 +63,12 @@       length one `shouldBe` 1       head one `shouldBe` bob       commit conn-    -- TODO: FIXME  +    -- TODO: FIXME     it "supports disjunction with ||." $ do       conn <- prepareDB       two <- select @Person conn (nameField =. "Bob" ||. ageField =. (25 :: Int))       length two `shouldBe` 2-      two `shouldContain` [alice,bob]+      two `shouldContain` [alice, bob]       commit conn     it "supports LIKE" $ do       conn <- prepareDB@@ -77,7 +76,7 @@       length three `shouldBe` 3       commit conn     it "supports NOT" $ do-      conn <- prepareDB  +      conn <- prepareDB       empty <- select conn (not' $ addressField `like` "West Street %") :: IO [Person]       length empty `shouldBe` 0       commit conn@@ -119,7 +118,7 @@       commit conn     it "supports SQL functions on columns" $ do       conn <- prepareDB-      peopleFromWestStreet <- select conn (lower(upper addressField) `like` "west street %") :: IO [Person]+      peopleFromWestStreet <- select conn (lower (upper addressField) `like` "west street %") :: IO [Person]       length peopleFromWestStreet `shouldBe` 3       commit conn     it "supports selection by id" $ do@@ -130,14 +129,14 @@       commit conn     it "supports ORDER BY" $ do       conn <- prepareDB-      sortedPersons <- select @Person conn (allEntries `orderBy` (ageField,ASC) :| [])+      sortedPersons <- select @Person conn (allEntries `orderBy` (ageField, ASC) :| [])       length sortedPersons `shouldBe` 3       sortedPersons `shouldBe` [alice, charlie, bob]       commit conn     it "supports multiple columns in ORDER BY" $ do       conn <- prepareDB       _ <- insert conn dave -- dave and charlie have the same age-      sortedPersons <- select @Person conn (allEntries `orderBy` (ageField,ASC) :| [(nameField,DESC)])+      sortedPersons <- select @Person conn (allEntries `orderBy` (ageField, ASC) :| [(nameField, DESC)])       length sortedPersons `shouldBe` 4       sortedPersons `shouldBe` [alice, dave, charlie, bob]       commit conn@@ -150,34 +149,33 @@     it "supports LIMIT OFFSET" $ do       conn <- prepareDB       _ <- insert conn dave-      limitedPersons <- select @Person conn (allEntries `limitOffset` (2,1))+      limitedPersons <- select @Person conn (allEntries `limitOffset` (2, 1))       length limitedPersons `shouldBe` 1       head limitedPersons `shouldBe` charlie       commit conn     it "can create column types for a SqlLite" $ do-      columnTypeFor @SomeRecord SQLite "someRecordID" `shouldBe` "INTEGER"-      columnTypeFor @SomeRecord SQLite "someRecordName" `shouldBe` "TEXT"-      columnTypeFor @SomeRecord SQLite "someRecordAge" `shouldBe` "REAL"-      columnTypeFor @SomeRecord SQLite "someRecordTax" `shouldBe` "REAL"-      columnTypeFor @SomeRecord SQLite "someRecordFlag" `shouldBe` "INT"-      columnTypeFor @SomeRecord SQLite "someRecordDate" `shouldBe` "TEXT"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordID" `shouldBe` "INTEGER"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordName" `shouldBe` "TEXT"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordAge" `shouldBe` "REAL"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordTax" `shouldBe` "REAL"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordFlag" `shouldBe` "INT"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordDate" `shouldBe` "TEXT"     it "can create column types for a Postgres" $ do-      columnTypeFor @SomeRecord Postgres "someRecordID" `shouldBe` "numeric"-      columnTypeFor @SomeRecord Postgres "someRecordName" `shouldBe` "varchar"-      columnTypeFor @SomeRecord Postgres "someRecordAge" `shouldBe` "numeric"-      columnTypeFor @SomeRecord Postgres "someRecordTax" `shouldBe` "numeric"-      columnTypeFor @SomeRecord Postgres "someRecordFlag" `shouldBe` "boolean"-      columnTypeFor @SomeRecord Postgres "someRecordDate" `shouldBe` "varchar"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordID" `shouldBe` "numeric"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordName" `shouldBe` "varchar"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordAge" `shouldBe` "numeric"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordTax" `shouldBe` "numeric"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordFlag" `shouldBe` "boolean"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordDate" `shouldBe` "varchar"     it "can create whereclauses" $ do       whereClauseValues byIdColumn `shouldBe` []-      + data SomeRecord = SomeRecord-  { someRecordID :: Int,+  { someRecordID   :: Int,     someRecordName :: String,-    someRecordAge :: Double,-    someRecordTax :: Float,+    someRecordAge  :: Double,+    someRecordTax  :: Float,     someRecordFlag :: Bool,     someRecordDate :: Integer   }   deriving (Generic, Entity, Show, Eq)-

@@ -1,5 +1,4 @@--- allows automatic derivation from Entity type class-{-# LANGUAGE DeriveAnyClass #-}+{-# OPTIONS_GHC -Wno-deprecations #-}  module PostgresSpec   ( test,@@ -7,24 +6,24 @@   ) where +import           Control.Exception import           Database.GP import           Database.HDBC.PostgreSQL-import           GHC.Generics hiding (Selector)+import           GHC.Generics             hiding (Selector) import           Test.Hspec-import           Control.Exception  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec  prepareDB :: IO Conn prepareDB = do-  con <- connect AutoCommit <$> connectPostgreSQL  "host=localhost dbname=postgres user=postgres password=admin port=5431" -  let conn = con{implicitCommit=False}-  setupTableFor @Person Postgres conn-  setupTableFor @Book Postgres conn+  conn <- connect ExplicitCommit <$> connectPostgreSQL "host=localhost dbname=postgres user=postgres password=admin port=5431"+  setupTable @Person conn defaultPostgresMapping+  setupTable @Book conn defaultPostgresMapping+  setupTable @Boat conn defaultPostgresMapping    _ <- run conn "DROP TABLE IF EXISTS Car;" []   _ <- run conn "CREATE TABLE Car (carID serial4 PRIMARY KEY, carType varchar);" []   commit conn@@ -40,14 +39,23 @@   deriving (Generic, Show, Eq)  instance Entity Person where-  autoIncrement = False   +  autoIncrement = False  data Car = Car-  { carID :: Int,-    carType  :: String+  { carID   :: Int,+    carType :: String   }   deriving (Generic, Entity, Show, Eq) +data Boat = Boat+  { boatID :: Int,+    boatType :: String+  }+  deriving (Generic, Show, Eq)++instance Entity Boat where+  autoIncrement = False+ data Book = Book   { book_id  :: Int,     title    :: String,@@ -62,8 +70,13 @@  instance Entity Book where   idField = "book_id"-  fieldsToColumns = [("book_id", "bookId"), ("title", "bookTitle"), ("author", "bookAuthor"), -                     ("year", "bookYear"), ("category", "bookCategory")]+  fieldsToColumns =+    [ ("book_id", "bookId"),+      ("title", "bookTitle"),+      ("author", "bookAuthor"),+      ("year", "bookYear"),+      ("category", "bookCategory")+    ]   tableName = "BOOK_TBL"   fromRow _c row = pure $ Book (col 0) (col 1) (col 2) (col 3) (col 4)     where@@ -111,15 +124,15 @@       person' <- selectById conn (1 :: Int) :: IO (Maybe Person)       person' `shouldBe` Nothing       commit conn-    it "selectById throws a DatabaseError if things go wrong in the DB" $ do +    it "selectById throws a DatabaseError if things go wrong in the DB" $ do       conn <- prepareDB       runRaw conn "DROP TABLE Person;"       commit conn       eitherEA <- try (selectById conn (1 :: Int) :: IO (Maybe Person))       case eitherEA of         Left (DatabaseError msg) -> msg `shouldContain` "does not exist"-        Left  _ -> expectationFailure "Expected DatabaseError"-        Right _ -> expectationFailure "Expected DatabaseError"  +        Left _                   -> expectationFailure "Expected DatabaseError"+        Right _                  -> expectationFailure "Expected DatabaseError"       rollback conn     it "retrieves Entities using user implementation" $ do       conn <- prepareDB@@ -132,22 +145,22 @@       length allBooks `shouldBe` 3       head allBooks `shouldBe` hobbit       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)-      book' `shouldBe` Just hobbit     +      book' `shouldBe` Just hobbit       commit conn     it "select returns Nothing if no Entity was found" $ do       conn <- prepareDB       allPersons' <- select @Person conn allEntries       allPersons' `shouldBe` []       commit conn-    it "select throws a DatabaseError if things go wrong" $ do +    it "select throws a DatabaseError if things go wrong" $ do       conn <- prepareDB       runRaw conn "DROP TABLE Person;"       commit conn       eitherEA <- try (select @Person conn allEntries)       case eitherEA of         Left (DatabaseError msg) -> msg `shouldContain` "does not exist"-        Left  _ -> expectationFailure "Expected DatabaseError"-        Right _ -> expectationFailure "Expected DatabaseError"  +        Left _                   -> expectationFailure "Expected DatabaseError"+        Right _                  -> expectationFailure "Expected DatabaseError"       rollback conn     it "persists new Entities using Generics" $ do       conn <- prepareDB@@ -171,24 +184,24 @@       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book       commit conn-    it "persist throws an exception if things go wrong" $ do +    it "persist throws an exception if things go wrong" $ do       conn <- prepareDB       runRaw conn "DROP TABLE BOOK_TBL;"       commit conn       eitherEA <- try (persist conn book)       case eitherEA of         Left (DatabaseError msg) -> msg `shouldContain` "does not exist"-        Left  _ -> expectationFailure "Expected DatabaseError"-        Right _ -> expectationFailure "Expected DatabaseError" +        Left _                   -> expectationFailure "Expected DatabaseError"+        Right _                  -> expectationFailure "Expected DatabaseError"     it "persists existing Entities using Generics" $ do       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0-      persist conn person+      upsert conn person       commit conn       allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 1-      persist conn person {age = 26}+      upsert conn person {age = 26}       commit conn       person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just person {age = 26}@@ -203,11 +216,39 @@       length allbooks' `shouldBe` 1       eitherEA <- try $ persist conn book {year = 1938} :: IO (Either PersistenceException ())       case eitherEA of-        Left  _ -> expectationFailure "should not throw an exception"+        Left _  -> expectationFailure "should not throw an exception"         Right x -> x `shouldBe` ()       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book {year = 1938}       commit conn+    it "can upsert Entities with AutoIncrement" $ do+      conn <- prepareDB+      let car = Car 1 "Honda Jazz"+      -- insert the car+      upsert conn car+      car' <- selectById conn (1 :: Int) :: IO (Maybe Car)+      car' `shouldBe` Just car+      -- now update the car +      let car2 = Car 1 "Honda Civic"+      upsert conn car2+      car2' <- selectById conn (1 :: Int) :: IO (Maybe Car)+      car2' `shouldBe` Just car2+      commit conn++    it "can upsert Entities without autoIncrement" $ do+      conn <- prepareDB+      let boat = Boat 1 "Sailboat"+      -- insert the boat+      upsert conn boat+      boat' <- selectById conn (1 :: Int) :: IO (Maybe Boat)+      boat' `shouldBe` Just boat+      -- now update the boat +      let boat2 = Boat 1 "Motorboat"+      upsert conn boat2+      boat2' <- selectById conn (1 :: Int) :: IO (Maybe Boat)+      boat2' `shouldBe` Just boat2+      commit conn+     it "inserts Entities using Generics" $ do       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]@@ -255,7 +296,7 @@       insertMany conn manyPersons       commit conn       allPersons' <- select conn allEntries :: IO [Person]-      length allPersons' `shouldBe` 6   +      length allPersons' `shouldBe` 6       deleteMany conn allPersons'       commit conn       allPersons'' <- select conn allEntries :: IO [Person]@@ -271,7 +312,7 @@       length allbooks' `shouldBe` 1       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book-      commit conn +      commit conn     it "updates Entities using Generics" $ do       conn <- prepareDB       _ <- insert conn person@@ -307,9 +348,9 @@       length allBooks' `shouldBe` 0       commit conn     it "provides a Connection Pool" $ do-      connPool <- postgreSQLPool "host=localhost dbname=postgres user=postgres password=admin port=5431" +      connPool <- postgreSQLPool "host=localhost dbname=postgres user=postgres password=admin port=5431"       withResource connPool $ \conn -> do-        setupTableFor @Person Postgres conn+        setupTable @Person conn defaultPostgresMapping         _ <- insert conn person         allPersons <- select conn allEntries :: IO [Person]         length allPersons `shouldBe` 1

@@ -1,18 +1,17 @@-{-# LANGUAGE DeriveAnyClass #-}-module QuerySpec -( test-, spec-)-where +module QuerySpec+  ( test,+    spec,+  )+where  import           Database.GP import           Database.GP.SqlGenerator-import Database.HDBC.Sqlite3 ( connectSqlite3 )+import           Database.HDBC.Sqlite3    (connectSqlite3) import           GHC.Generics import           Test.Hspec  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -20,7 +19,7 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Person SQLite conn+  setupTable @Person conn defaultSqliteMapping    insertMany conn [alice, bob, charlie]   return conn@@ -49,10 +48,10 @@ addressField = field "address"  lower :: Field -> Field-lower = sqlFun "LOWER";+lower = sqlFun "LOWER"  upper :: Field -> Field-upper = sqlFun "UPPER";+upper = sqlFun "UPPER"  spec :: Spec spec = do@@ -72,7 +71,7 @@       three <- select conn (addressField `like` "West Street %") :: IO [Person]       length three `shouldBe` 3     it "supports NOT" $ do-      conn <- prepareDB  +      conn <- prepareDB       empty <- select conn (not' $ addressField `like` "West Street %") :: IO [Person]       length empty `shouldBe` 0     it "supports fieldwise comparisons like >" $ do@@ -108,7 +107,7 @@       length allPersons `shouldBe` 3     it "supports SQL functions on columns" $ do       conn <- prepareDB-      peopleFromWestStreet <- select conn (lower(upper addressField) `like` "west street %") :: IO [Person]+      peopleFromWestStreet <- select conn (lower (upper addressField) `like` "west street %") :: IO [Person]       length peopleFromWestStreet `shouldBe` 3     it "supports selection by id" $ do       conn <- prepareDB@@ -117,13 +116,13 @@       head charlie' `shouldBe` charlie     it "supports ORDER BY" $ do       conn <- prepareDB-      sortedPersons <- select @Person conn (allEntries `orderBy` (ageField,ASC) :| [])+      sortedPersons <- select @Person conn (allEntries `orderBy` (ageField, ASC) :| [])       length sortedPersons `shouldBe` 3       sortedPersons `shouldBe` [alice, charlie, bob]     it "supports multiple columns in ORDER BY" $ do       conn <- prepareDB       _ <- insert conn dave -- dave and charlie have the same age-      sortedPersons <- select @Person conn (allEntries `orderBy` (ageField,ASC) :| [(nameField,DESC)])+      sortedPersons <- select @Person conn (allEntries `orderBy` (ageField, ASC) :| [(nameField, DESC)])       length sortedPersons `shouldBe` 4       sortedPersons `shouldBe` [alice, dave, charlie, bob]     it "supports LIMIT" $ do@@ -134,33 +133,42 @@     it "supports LIMIT OFFSET" $ do       conn <- prepareDB       _ <- insert conn dave-      limitedPersons <- select @Person conn (allEntries `limitOffset` (2,1))+      limitedPersons <- select @Person conn (allEntries `limitOffset` (2, 1))       length limitedPersons `shouldBe` 1       head limitedPersons `shouldBe` charlie     it "can create column types for a SqlLite" $ do-      columnTypeFor @SomeRecord SQLite "someRecordID" `shouldBe` "INTEGER"-      columnTypeFor @SomeRecord SQLite "someRecordName" `shouldBe` "TEXT"-      columnTypeFor @SomeRecord SQLite "someRecordAge" `shouldBe` "REAL"-      columnTypeFor @SomeRecord SQLite "someRecordTax" `shouldBe` "REAL"-      columnTypeFor @SomeRecord SQLite "someRecordFlag" `shouldBe` "INT"-      columnTypeFor @SomeRecord SQLite "someRecordDate" `shouldBe` "TEXT"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordID" `shouldBe` "INTEGER"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordName" `shouldBe` "TEXT"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordAge" `shouldBe` "REAL"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordTax" `shouldBe` "REAL"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordFlag" `shouldBe` "INT"+      columnTypeFor @SomeRecord defaultSqliteMapping "someRecordDate" `shouldBe` "TEXT"     it "can create column types for a Postgres" $ do-      columnTypeFor @SomeRecord Postgres "someRecordID" `shouldBe` "numeric"-      columnTypeFor @SomeRecord Postgres "someRecordName" `shouldBe` "varchar"-      columnTypeFor @SomeRecord Postgres "someRecordAge" `shouldBe` "numeric"-      columnTypeFor @SomeRecord Postgres "someRecordTax" `shouldBe` "numeric"-      columnTypeFor @SomeRecord Postgres "someRecordFlag" `shouldBe` "boolean"-      columnTypeFor @SomeRecord Postgres "someRecordDate" `shouldBe` "varchar"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordID" `shouldBe` "numeric"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordName" `shouldBe` "varchar"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordAge" `shouldBe` "numeric"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordTax" `shouldBe` "numeric"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordFlag" `shouldBe` "boolean"+      columnTypeFor @SomeRecord defaultPostgresMapping "someRecordDate" `shouldBe` "varchar"     it "can create whereclauses" $ do       whereClauseValues byIdColumn `shouldBe` []-      +    it "allows to write custom SQL queries" $ do+      conn <- prepareDB+      _ <- insert conn dave+      let stmt = [sql|+        SELECT * +        FROM person +        WHERE name = (?)|]+      persons <- entitiesFromRows @Person conn =<< quickQuery conn stmt [toSql "Dave"]+      length persons `shouldBe` 1+      head persons `shouldBe` dave+ data SomeRecord = SomeRecord-  { someRecordID :: Int,+  { someRecordID   :: Int,     someRecordName :: String,-    someRecordAge :: Double,-    someRecordTax :: Float,+    someRecordAge  :: Double,+    someRecordTax  :: Float,     someRecordFlag :: Bool,     someRecordDate :: Integer   }   deriving (Generic, Entity, Show, Eq)-

@@ -1,6 +1,3 @@--- allows automatic derivation from Entity type class-{-# LANGUAGE DeriveAnyClass #-}- module ReferenceSpec   ( test,     spec,@@ -15,7 +12,7 @@ import           Test.Hspec  -- `test` is here so that this module can be run from GHCi on its own.  It is--- not needed for automatic spec discovery. +-- not needed for automatic spec discovery. -- (start up stack repl --test to bring up ghci and have access to all the test functions) test :: IO () test = hspec spec@@ -23,8 +20,8 @@ prepareDB :: IO Conn prepareDB = do   conn <- connect AutoCommit <$> connectSqlite3 ":memory:"-  setupTableFor @Article SQLite conn-  setupTableFor @Author SQLite conn+  setupTable @Article conn defaultSqliteMapping+  setupTable @Author conn defaultSqliteMapping   return conn  data Article = Article@@ -43,35 +40,44 @@   deriving (Generic, Show, Eq)  instance Entity Author where-  autoIncrement = False +  autoIncrement = False  instance Entity Article where   autoIncrement :: Bool   autoIncrement = False-  -  fieldsToColumns :: [(String, String)]                      -- ommitting the author field,-  fieldsToColumns =                                          -- as this can not be mapped to a single column-    [ ("articleID", "articleID"),                            -- instead we invent a new column authorID         ++  fieldsToColumns :: [(String, String)] -- ommitting the author field,+  fieldsToColumns =+    -- as this can not be mapped to a single column+    [ ("articleID", "articleID"), -- instead we invent a new column authorID       ("title", "title"),       ("authorID", "authorID"),       ("year", "year")     ]    fromRow :: Conn -> [SqlValue] -> IO Article-  fromRow conn row = do    -    authorById <- fromJust <$> selectById conn (row !! 2)  -- load author by foreign key-    return $ rawArticle {author = authorById}                -- add author to article+  fromRow conn row = do+    authorById <- fromJust <$> selectById conn (row !! 2) -- load author by foreign key+    return $ rawArticle {author = authorById} -- add author to article     where-      rawArticle = Article (col 0) (col 1)                   -- create article from row, -                           (Author (col 2) "" "") (col 3)    -- using a dummy author+      rawArticle =+        Article+          (col 0)+          (col 1) -- create article from row,+          (Author (col 2) "" "")+          (col 3) -- using a dummy author         where           col i = fromSql (row !! i)    toRow :: Conn -> Article -> IO [SqlValue]   toRow conn a = do-    persist conn (author a)                                  -- persist author first-    return [toSql (articleID a), toSql (title a),            -- return row for article table where -            toSql $ authorID (author a), toSql (year a)]     -- authorID is foreign key to author table +    persist conn (author a) -- persist author first+    return+      [ toSql (articleID a),+        toSql (title a), -- return row for article table where+        toSql $ authorID (author a),+        toSql (year a) -- authorID is foreign key to author table+      ]  article :: Article article =