generic-persistence 0.4.0.0 → 0.5.0

raw patch · 22 files changed

+1511/−305 lines, 22 filesdep +HDBC-postgresqldep +raw-strings-qqdep +template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: HDBC-postgresql, raw-strings-qq, template-haskell

API changes (from Hackage documentation)

Files

• README.md +126/−23
• generic-persistence.cabal +24/−6
• src/Database/GP.hs +22/−3
• src/Database/GP/Conn.hs +15/−14
• src/Database/GP/Entity.hs +1/−21
• src/Database/GP/GenericPersistence.hs +39/−63
• src/Database/GP/GenericPersistenceSafe.hs +56/−21
• src/Database/GP/Query.hs +63/−38
• src/Database/GP/SqlGenerator.hs +54/−11
• src/Database/GP/TypeInfo.hs +9/−14
• test/ConnSpec.hs +95/−0
• test/DemoSpec.hs +16/−8
• test/EmbeddedSpec.hs +2/−2
• test/EnumSpec.hs +2/−2
• test/ExceptionsSpec.hs +84/−17
• test/GenericPersistenceSpec.hs +63/−54
• test/OneToManySafeSpec.hs +174/−0
• test/OneToManySpec.hs +3/−3
• test/PostgresQuerySpec.hs +180/−0
• test/PostgresSpec.hs +317/−0
• test/QuerySpec.hs +163/−0
• test/ReferenceSpec.hs +3/−5

@@ -1,9 +1,34 @@ # GenericPersistence - A Haskell Persistence Layer using Generics  [![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)  ![GP Logo](https://github.com/thma/generic-persistence/blob/main/gp-logo-300.png?raw=true) +++## Table of Contents++- [Introduction](#introduction)+- [Status](#status)+- [Available on Hackage](#available-on-hackage)+- [Short demo](#short-demo)+- [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)+- [How it works](#how-it-works)+  - [Default Behaviour](#default-behaviour)+  - [Customizing The Default Behaviour](#customizing-the-default-behaviour)+- [Handling enumeration fields](#handling-enumeration-fields)+- [Handling embedded Objects](#handling-embedded-objects)+- [Handling 1:1 references](#handling-11-references)+- [Handling 1:N references](#handling-1n-references)+- [Performing queries with the Query DSL](#performing-queries-with-the-query-dsl)+- [Integrating user defined queries](#integrating-user-defined-queries)+- [The Conn ConnectionContext Type](#the-conn-connection-type)+- [Connection Pooling](#connection-pooling)+ ## Introduction  GenericPersistence is a small Haskell persistence layer for relational databases. @@ -14,7 +39,6 @@  It therefore provides means for inserting, updating, deleting and querying such entities into/from relational databases. - The main *design goal* is to minimize the *boilerplate* code required:  - no manual instantiation of type classes@@ -28,15 +52,20 @@  ## Status -The library is still work in progress. All test cases are green and it should be ready for early adopters.-But API changes are still possible and several things are still missing:+As of now there is full support for SQLite and PostgreSQL. +Support for other databases will be implemented on demand. -- auto-incrementing primary keys-- caching-- coding free support for 1:1 and 1:n relationships (using more generics magic)-- schema migration-- ...+### new features in v0.5 +- support for PostgreSQL+- support RETURNING statement for insert+- support for auto-incrementing primary keys+- entitiesFromRows now available in GP api also+- provide a simple quasi-qoter for defining sql queries+- expose some HDBC functions in the GP API+- explicit setting of transaction mode++ Feature requests, feedback and pull requests are welcome!  ## Available on Hackage@@ -68,10 +97,7 @@  module Main (main) where -import           Database.GP           (Database (SQLite), Entity, allEntries,-                                        connect, delete, insert, select,-                                        selectById, setupTableFor, update)-import           Database.HDBC         (disconnect)+import           Database.GP           import           Database.HDBC.Sqlite3 (connectSqlite3) import           GHC.Generics @@ -87,33 +113,101 @@  main :: IO () main = do-  -- connect to a database-  conn <- connect SQLite <$> connectSqlite3 "sqlite.db"+  -- connect to a database in auto commit mode+  conn <- connect AutoCommit <$> connectSqlite3 "sqlite.db"+   -- initialize Person table-  setupTableFor @Person conn+  setupTableFor @Person SQLite conn+   -- create a Person entity   let alice = Person {personID = 123456, name = "Alice", age = 25, address = "Elmstreet 1"}+   -- insert a Person into a database   insert conn alice+   -- update a Person   update conn alice {address = "Main Street 200"}+   -- select a Person from a database-  -- The result type must be provided by the call site, +  -- The result type must be provided by the call site,   -- as `selectById` has a polymorphic return type `IO (Maybe a)`.-  alice' <- selectById @Person conn "123456" +  alice' <- selectById @Person conn "123456"   print alice'+   -- select all Persons from a database. again, the result type must be provided.   allPersons <- select @Person conn allEntries   print allPersons++  -- select all Persons from a database, where age is under 30.+  allPersonsUnder30 <- select @Person conn ((field "age") <. (30 :: Int))+  print allPersonsUnder30+   -- delete a Person from a database   delete conn alice+   -- select all Persons from a database. Now it should be empty.-  allPersons' <- select conn allEntries :: IO [Person]+  allPersons' <- select @Person conn allEntries   print allPersons'+   -- close connection   disconnect conn ``` +## Deal with runtime exceptions or use total functions? Your choice!++GenericPersistence provides two different APIs for accessing the database:+- the default API (as shown in the above demo), which uses exceptions to signal errors+- the safe API, which uses `Either` to signal errors++### Exceptions in the default API+The default API is the easiest to use, but you will have to do exception handling to catch runtime errors. To use it you'll have to import the `Database.GP` module:++```haskell+import Database.GP +```++These are the exceptions that can be thrown:++```haskell+data PersistenceException =+    EntityNotFound String+  | DuplicateInsert String+  | DatabaseError String+  | NoUniqueKey String+  deriving (Show, Eq, Exception)+```++The `EntityNotFound` exception is thrown when you try to select an entity by its primary key, but no entity with the given primary key exists in the database.++The `DuplicateInsert` exception is thrown when you try to insert an entity into the database, but an entity with the same primary key already exists in the database.++The `DatabaseError` exception is thrown when the database backend returns an error.++The `NoUniqueKey` exception is thrown when you try to select an entity by its primary key, but multiple rows are returned by the database. This can happen if there is no primary key constraint defined on the underlying database column.++A real world example can be found in the [Servant GP - UserServer](https://github.com/thma/servant-gp/blob/main/src/UserServer.hs) module.++### Total functions in the safe API++The safe API is a bit more verbose, but it does not throw exceptions. To use it you'll have to import the `Database.GP.GenericPersistenceSafe` module:++```haskell+import Database.GP.GenericPersistenceSafe+```++This module provides the same function as `Database.GP`, but all functions return `Either PersistenceException a` instead of `IO a` or `IO (Maybe a)`.++```haskell+eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Person)+case eitherExRes of+  Left (EntityNotFound _) -> print "Entity not found"+  Right person            -> print person+```++This may look a bit verbose, but in actual code this may work out better, as `Either` allows pattern matching and chaining of computations with the `do` notation.++A real world example can be found in the [Servant GP - UserServerSafe](https://github.com/thma/servant-gp/blob/main/src/UserServerSafe.hs) module. The `UserServerSafe` module is a copy of the `UserServer` module, but it uses the safe API instead of the default API. As you can see, the code of `UserServerSafe` is actually a bit more compact than the code of UserServer. (In the default API, we have to deal with the special case of `selectById` returning `Nothing`.)+ ## How it works  In order to store Haskell data types in a relational database, we need to define a mapping between Haskell types and database tables.@@ -491,9 +585,19 @@ thirtySomethings <- select @Person conn (ageField `between` (30, 39)) ``` -You will find more examples in the [test suite](https://github.com/thma/generic-persistence/blob/main/test/GenericPersistenceSpec.hs#L116).+It is also possible to add `ORDER BY` and `LIMIT` clauses to the query: +```haskell+sortedPersons <- select @Person conn (allEntries `orderBy` [(ageField,ASC), (nameField,DESC)]) +limitedPersons <- select @Person conn (allEntries `limit` 25)++pageOfPersons <- select @Person conn (allEntries `limitOffset` (100,10))+```++You will find more examples in the [test suite](https://github.com/thma/generic-persistence/blob/main/test/QuerySpec.hs).++ ## Integrating user defined queries  As we have seen in the previous section, the library provides two functions `select` and `selectById` to query the database for entities.@@ -545,10 +649,10 @@ let conn = c {implicitCommit = False} ``` -## A simple Connection Pool+## Connection Pooling -The library provides a simple connection pool that can be used to manage a pool of database connections. -A connection pool will be used to manage the database connections in a multi-threaded environment where multiple threads may need to access the database at the same time. A typical use case is a REST service that uses a database to store its data. +The library provides a simple connection pool for managing database connections. +This is a must in multi-threaded environments where multiple threads may need to access the database at the same time. A typical use case is a REST service that uses a database to store its data.   The connection Pool is implemented based on the [resource-pool](https://hackage.haskell.org/package/resource-pool) library. `generic-persistence` exposes a `ConnectionPool` type and two function `createConnPool` and `withResource` to create and use a connection pool. @@ -572,4 +676,3 @@  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,6 +1,6 @@ cabal-version:      1.12 name:               generic-persistence-version:            0.4.0.0+version:            0.5.0 license:            BSD3 license-file:       LICENSE copyright:          2023 Thomas Mahler@@ -32,9 +32,13 @@         Database.GP.SqlGenerator         Database.GP.TypeInfo -    hs-source-dirs:   src-    other-modules:    Paths_generic_persistence-    default-language: GHC2021+    hs-source-dirs:     src+    other-modules:      Paths_generic_persistence+    default-language:   GHC2021+    default-extensions:+        DuplicateRecordFields DeriveAnyClass DerivingStrategies+        OverloadedRecordDot TemplateHaskell QuasiQuotes+     ghc-options:         -Wall -Wcompat -Widentities -Wincomplete-record-updates         -Wincomplete-uni-patterns -Wmissing-export-lists@@ -45,7 +49,9 @@         base >=4.7 && <5,         convertible <1.2,         generic-deriving <1.15,-        resource-pool <0.5+        raw-strings-qq <1.2,+        resource-pool <0.5,+        template-haskell <2.19  test-suite generic-persistence-test     type:               exitcode-stdio-1.0@@ -53,16 +59,25 @@     build-tool-depends: hspec-discover:hspec-discover >=2 && <3     hs-source-dirs:     test     other-modules:+        ConnSpec         DemoSpec         EmbeddedSpec         EnumSpec         ExceptionsSpec         GenericPersistenceSpec+        OneToManySafeSpec         OneToManySpec+        PostgresQuerySpec+        PostgresSpec+        QuerySpec         ReferenceSpec         Paths_generic_persistence      default-language:   GHC2021+    default-extensions:+        DuplicateRecordFields DeriveAnyClass DerivingStrategies+        OverloadedRecordDot TemplateHaskell QuasiQuotes+     ghc-options:         -Wall -Wcompat -Widentities -Wincomplete-record-updates         -Wincomplete-uni-patterns -Wmissing-export-lists@@ -71,6 +86,7 @@      build-depends:         HDBC <2.5,+        HDBC-postgresql <2.6,         HDBC-sqlite3 <2.4,         QuickCheck <2.15,         base >=4.7 && <5,@@ -79,4 +95,6 @@         generic-persistence,         hspec <2.10,         hspec-discover <2.10,-        resource-pool <0.5+        raw-strings-qq <1.2,+        resource-pool <0.5,+        template-haskell <2.19

@@ -2,18 +2,20 @@   ( selectById,     select,     entitiesFromRows,+    sql,     persist,     insert,+    insertReturning,     insertMany,     update,     updateMany,     delete,     deleteMany,     setupTableFor,-    idValue,     Conn(..),     connect,     Database(..),+    TxHandling (..),     ConnectionPool,     createConnPool,     withResource,@@ -22,7 +24,6 @@     GFromRow,     columnNameFor,     maybeFieldTypeFor,-    toString,     TypeInfo (..),     typeInfo,     PersistenceException(..),@@ -38,15 +39,33 @@     (<=.),     (<>.),     like,-    contains,     between,     in',     isNull,     not',     sqlFun,     allEntries,+    byId,+    orderBy,+    SortOrder (..),+    limit,+    limitOffset,+    NonEmpty(..),+    SqlValue,+    fromSql,+    toSql,+    quickQuery,+    run,+    commit,+    rollback,+    withTransaction,+    runRaw,+    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))

@@ -1,7 +1,8 @@+{-# LANGUAGE LambdaCase                #-} module Database.GP.Conn   ( Conn (..),     connect,-    Database (..),+    TxHandling (..),     ConnectionPool,     createConnPool,     withResource,@@ -29,25 +30,25 @@ data Conn = forall conn.   IConnection conn =>   Conn-  { -- | The database type-    db             :: Database,+  {      -- | If True, the GenericPersistence functions will commit the transaction after each operation.     implicitCommit :: Bool,     -- | The wrapped connection     connection     :: conn   } --- | An enumeration of the supported database types.-data Database = Postgres | MySQL | SQLite | Oracle | MSSQL-  deriving (Show, Eq, Enum)+data TxHandling = AutoCommit | ExplicitCommit    -- | a smart constructor for the Conn type.-connect :: forall conn. IConnection conn => Database -> conn -> Conn-connect db = Conn db True+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-withWConn (Conn _db _ic conn) f = f conn+withWConn (Conn _ic conn) f = f conn  -- | manually implement the IConnection type class for the Conn type. instance IConnection Conn where@@ -57,7 +58,7 @@   runRaw w = withWConn w runRaw   run w = withWConn w run   prepare w = withWConn w prepare-  clone w@(Conn db ic _) = withWConn w (clone >=> return . Conn db ic)+  clone w@(Conn ic _) = withWConn w (clone >=> return . Conn ic)   hdbcDriverName w = withWConn w hdbcDriverName   hdbcClientVer w = withWConn w hdbcClientVer   proxiedClientName w = withWConn w proxiedClientName@@ -72,8 +73,8 @@  -- | Creates a connection pool. createConnPool :: IConnection conn =>-  -- | the database type e.g. Postgres, MySQL, SQLite-  Database ->+  -- | the transaction mode +  TxHandling ->   -- | the connection string   String ->   -- | a function that takes a connection string and returns an IConnection@@ -84,9 +85,9 @@   Int ->   -- | the resulting connection pool   IO ConnectionPool-createConnPool db connectString connectFun idle numConns = newPool poolConfig+createConnPool txHandling connectString connectFun idle numConns = newPool poolConfig   where     freshConnection :: IO Conn-    freshConnection = connect db <$> connectFun connectString+    freshConnection = connect txHandling <$> connectFun connectString     poolConfig :: PoolConfig Conn     poolConfig = defaultPoolConfig freshConnection disconnect idle numConns

@@ -9,13 +9,12 @@ module Database.GP.Entity   ( Entity (..),     columnNameFor,-    toString,     gtoRow,     GToRow,     GFromRow,     maybeFieldTypeFor,     Conn(..),-    Database(..),+    TxHandling(..),   ) where @@ -27,7 +26,6 @@ import           Database.HDBC        (SqlValue) import           GHC.Generics import           GHC.TypeNats-import           Generics.Deriving.Show (GShow' (..), gshowsPrecdefault) import           Database.GP.Conn  {- | This is the Entity class. It is a type class that is used to define the mapping@@ -117,24 +115,10 @@     fieldsAndTypes :: TypeInfo a -> [(String, TypeRep)]     fieldsAndTypes ti = zip (fieldNames ti) (fieldTypes ti) --- | Returns a string representation of a value of type 'a'.-toString :: forall a. (Generic a, GShow' (Rep a)) => a -> String-toString = gshow-  where-    gshows :: a -> ShowS-    gshows = gshowsPrecdefault 0--    gshow :: a -> String-    gshow x = gshows x ""- -- generics based implementations for gFromRow and gToRow--- toRow class GToRow f where   gtoRow :: f a -> [SqlValue] -instance GToRow U1 where-  gtoRow U1 = mempty- instance (Convertible a SqlValue) => GToRow (K1 i a) where   gtoRow (K1 a) = pure $ convert a @@ -144,12 +128,8 @@ instance GToRow a => GToRow (M1 i c a) where   gtoRow (M1 a) = gtoRow a --- fromRow class GFromRow f where   gfromRow :: [SqlValue] -> f a--instance GFromRow U1 where-  gfromRow = pure U1  instance (Convertible SqlValue a) => GFromRow (K1 i a) where   gfromRow = K1 <$> convert . head

@@ -3,18 +3,20 @@   ( selectById,     select,     entitiesFromRows,+    sql,     persist,     insert,+    insertReturning,     insertMany,     update,     updateMany,     delete,     deleteMany,     setupTableFor,-    idValue,     Conn(..),     connect,     Database(..),+    TxHandling (..),     ConnectionPool,     createConnPool,     withResource,@@ -23,7 +25,6 @@     GFromRow,     columnNameFor,     maybeFieldTypeFor,-    toString,     TypeInfo (..),     typeInfo,     PersistenceException(..),@@ -39,7 +40,7 @@     (<=.),     (<>.),     like,-    contains,+    --contains,     between,     in',       isNull,@@ -47,16 +48,20 @@     sqlFun,     allEntries,     byId,+    orderBy,+    SortOrder (..),+    limit,+    limitOffset,+    NonEmpty(..)   ) where  import           Control.Exception-import           Control.Monad                      (when)+--import           Control.Monad                      (when) import           Data.Convertible                   (Convertible)-import           Data.List                          (elemIndex) import           Database.GP.Conn import           Database.GP.Entity-import           Database.GP.GenericPersistenceSafe (PersistenceException)+import           Database.GP.GenericPersistenceSafe (PersistenceException, sql, setupTableFor) import qualified Database.GP.GenericPersistenceSafe as GpSafe import           Database.GP.SqlGenerator import           Database.GP.TypeInfo@@ -104,95 +109,66 @@     Left ex        -> throw ex     Right entities -> pure entities --- | 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.---   The function returns a (possibly empty) list of all matching entities.---   The function is used internally by `retrieveAll` and `retrieveAllWhere`.---   But it can also be used to convert the result of a custom SQL query to a list of entities.-entitiesFromRows :: forall a. (Entity a) => Conn -> [[SqlValue]] -> IO [a]-entitiesFromRows conn rows = do-  eitherExEntities <- GpSafe.entitiesFromRows @a conn rows-  case eitherExEntities of-    Left ex        -> throw ex-    Right entities -> pure entities--fromEitherExUnit :: IO (Either PersistenceException ()) -> IO ()-fromEitherExUnit ioEitherExUnit = do+fromEitherExOrA :: IO (Either PersistenceException a) -> IO a+fromEitherExOrA ioEitherExUnit = do   eitherExUnit <- ioEitherExUnit   case eitherExUnit of     Left ex -> throw ex-    Right _ -> pure ()+    Right a -> pure a +-- | A function that constructs a list of entities from a list of rows.+--   The function takes an HDBC connection and a list of rows as parameters.+--   The type `a` is determined by the context of the function call.+--   The function returns a list of entities.+--   This can be useful if you want to use your own SQL queries.+entitiesFromRows :: forall a. (Entity a) => Conn -> [[SqlValue]] -> IO [a]+entitiesFromRows = (fromEitherExOrA .) . GpSafe.entitiesFromRows+ -- | 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 persist :: forall a. (Entity a) => Conn -> a -> IO ()-persist = (fromEitherExUnit .) . GpSafe.persist+persist = (fromEitherExOrA .) . GpSafe.persist  -- | A function that explicitely inserts an entity into a database. insert :: forall a. (Entity a) => Conn -> a -> IO ()-insert = (fromEitherExUnit .) . GpSafe.insert+insert = (fromEitherExOrA .) . GpSafe.insert +insertReturning :: forall a. (Entity a) => Conn -> a -> IO a+insertReturning = (fromEitherExOrA .) . GpSafe.insertReturning+ -- | A function that inserts a list of entities into a database. --   The function takes an HDBC connection and a list of entities as parameters. --   The insert-statement is compiled only once and then executed for each entity. insertMany :: forall a. (Entity a) => Conn -> [a] -> IO ()-insertMany = (fromEitherExUnit .) . GpSafe.insertMany+insertMany = (fromEitherExOrA .) . GpSafe.insertMany  -- | A function that explicitely updates an entity in a database. update :: forall a. (Entity a) => Conn -> a -> IO ()-update = (fromEitherExUnit .) . GpSafe.update+update = (fromEitherExOrA .) . GpSafe.update  -- | A function that updates a list of entities in a database. --   The function takes an HDBC connection and a list of entities as parameters. --   The update-statement is compiled only once and then executed for each entity. updateMany :: forall a. (Entity a) => Conn -> [a] -> IO ()-updateMany = (fromEitherExUnit .) . GpSafe.updateMany+updateMany = (fromEitherExOrA .) . GpSafe.updateMany  -- | A function that deletes an entity from a database. --   The function takes an HDBC connection and an entity as parameters. delete :: forall a. (Entity a) => Conn -> a -> IO ()-delete = (fromEitherExUnit .) . GpSafe.delete+delete = (fromEitherExOrA .) . GpSafe.delete  -- | 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 = (fromEitherExUnit .) . 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 returns the primary key value of an entity as a SqlValue.---   The function takes an HDBC connection and an entity as parameters.-idValue :: forall a. (Entity a) => Conn -> a -> IO SqlValue-idValue conn x = do-  sqlValues <- toRow conn x-  return (sqlValues !! idFieldIndex)-  where-    idFieldIndex = fieldIndex @a (idField @a)---- | returns the index of a field of an entity.---   The index is the position of the field in the list of fields of the entity.---   If no such field exists, an error is thrown.---   The function takes an field name as parameters,---   the type of the entity is determined by the context.-fieldIndex :: forall a. (Entity a) => String -> Int-fieldIndex fieldName =-  expectJust-    ("Field " ++ fieldName ++ " is not present in type " ++ constructorName ti)-    (elemIndex fieldName fieldList)-  where-    ti = typeInfo @a-    fieldList = fieldNames ti+deleteMany = (fromEitherExOrA .) . GpSafe.deleteMany -expectJust :: String -> Maybe a -> a-expectJust _ (Just x)  = x-expectJust err Nothing = error ("expectJust " ++ err)+-- -- | 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

@@ -7,18 +7,20 @@   ( selectById,     select,     entitiesFromRows,+    sql,     persist,     insert,+    insertReturning,     insertMany,     update,     updateMany,     delete,     deleteMany,     setupTableFor,-    idValue,     Conn(..),     connect,     Database(..),+    TxHandling (..),     ConnectionPool,     createConnPool,     withResource,@@ -27,7 +29,6 @@     GFromRow,     columnNameFor,     maybeFieldTypeFor,-    toString,     TypeInfo (..),     typeInfo,     PersistenceException(..),@@ -43,7 +44,6 @@     (<=.),     (<>.),     like,-    contains,     between,     in',     isNull,@@ -51,6 +51,12 @@     sqlFun,     allEntries,     byId,+    orderBy,+    SortOrder (..),+    limit,+    limitOffset,+    fieldIndex,+    handleDuplicateInsert   ) where @@ -64,6 +70,8 @@ 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.@@ -90,6 +98,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   eitherExResultRows <- try $ quickQuery conn stmt [eid]   case eitherExResultRows of     Left ex -> return $ Left $ fromException ex@@ -104,8 +113,7 @@         _ -> return $ Left $ NoUniqueKey $ "More than one " ++ constructorName ti ++ " found for id " ++ show eid   where     ti = typeInfo @a-    --stmt = selectStmtFor @a-    stmt = selectFromStmt @a (byId idx)+    stmt = selectFromStmt @a byIdColumn     eid = toSql idx  fromException :: SomeException -> PersistenceException@@ -119,6 +127,7 @@ --   The `WhereClauseExpr` is typically constructed using any tiny query dsl based on infix operators. select :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO (Either PersistenceException [a]) select conn whereClause = do+  --print stmt   eitherExRows <- tryPE $ quickQuery conn stmt values   case eitherExRows of     Left ex          -> return $ Left ex@@ -144,32 +153,51 @@ persist conn entity = do   eitherExRes <- try $ do     eid <- idValue conn entity-    let stmt = selectFromStmt @a (byId eid)-    --idValue conn entity >>= \eid ->+    let stmt = selectFromStmt @a byIdColumn     quickQuery conn stmt [eid] >>=       \case         []           -> insert conn entity         [_singleRow] -> update conn entity-        _            -> error $ "More than one entity found for id " ++ show eid+        _            -> 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 +-- | 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+ -- | A function that explicitely inserts an entity into a database. insert :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ()) insert conn entity = do   eitherExUnit <- try $ do     row <- toRow conn entity     _rowcount <- run conn (insertStmtFor @a) row-    when (implicitCommit conn) $ commit conn+    commitIfAutoCommit conn   case eitherExUnit of     Left ex -> return $ Left $ handleDuplicateInsert ex     Right _ -> return $ Right () +insertReturning :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException a)+insertReturning conn entity = do+  eitherExUnit <- try $ do+    row <- toRow conn entity+    rowInserted <- quickQuery conn (insertReturningStmtFor @a) (tail row)+    --commitIfAutoCommit conn+    case rowInserted of+      [singleRow] -> fromRow conn singleRow+      _     -> error "insertReturning: more than one row inserted"+  case eitherExUnit of+    Left ex -> return $ Left $ handleDuplicateInsert ex+    Right a -> return $ Right a    + handleDuplicateInsert :: SomeException -> PersistenceException-handleDuplicateInsert ex = if "UNIQUE constraint failed" `isInfixOf` show ex-  then DuplicateInsert "Entity already exists in DB, use update instead"-  else fromException 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  tryPE :: IO a -> IO (Either PersistenceException a) tryPE action = do@@ -187,7 +215,7 @@     rows <- mapM (toRow conn) entities     stmt <- prepare conn (insertStmtFor @a)     executeMany stmt rows-    when (implicitCommit conn) $ commit conn+    commitIfAutoCommit conn   case eitherExUnit of     Left ex -> return $ Left $ handleDuplicateInsert ex     Right _ -> return $ Right ()@@ -203,7 +231,7 @@     if rowcount == 0       then return (Left (EntityNotFound (constructorName (typeInfo @a) ++ " " ++ show eid ++ " does not exist")))       else do-        when (implicitCommit conn) $ commit conn+        commitIfAutoCommit conn         return $ Right ()   case eitherExUnit of     Left ex      -> return $ Left $ fromException ex@@ -219,7 +247,7 @@   stmt <- prepare conn (updateStmtFor @a)   -- the update statement has one more parameter than the row: the id value for the where clause   executeMany stmt (zipWith (\l x -> l ++ [x]) rows eids)-  when (implicitCommit conn) $ commit conn+  commitIfAutoCommit conn  -- | A function that deletes an entity from a database. --   The function takes an HDBC connection and an entity as parameters.@@ -231,7 +259,7 @@     if rowCount == 0       then return (Left (EntityNotFound (constructorName (typeInfo @a) ++ " " ++ show eid ++ " does not exist")))       else do-        when (implicitCommit conn) $ commit conn+        commitIfAutoCommit conn         return $ Right ()   case eitherExRes of     Left ex      -> return $ Left $ fromException ex@@ -245,15 +273,18 @@   eids <- mapM (idValue conn) entities   stmt <- prepare conn (deleteStmtFor @a)   executeMany stmt (map (: []) eids)-  when (implicitCommit conn) $ commit conn+  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) => Conn -> IO ()-setupTableFor conn = do+setupTableFor :: forall a. (Entity a) => Database -> Conn -> IO ()+setupTableFor db conn = do+  --print stmt   runRaw conn $ dropTableStmtFor @a-  runRaw conn $ createTableStmtFor @a (db conn)-  when (implicitCommit conn) $ commit conn+  runRaw conn $ stmt -- createTableStmtFor @a (db conn)+  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.@@ -281,6 +312,10 @@ expectJust :: String -> Maybe a -> a expectJust _ (Just x)  = x expectJust err Nothing = error ("expectJust " ++ err)++-- an alias for a simple quasiqouter+sql :: QuasiQuoter+sql = r  -- | These instances are needed to make the Convertible type class work with Enum types out of the box. --   This is needed because the Convertible type class is used to convert SqlValues to Haskell types.

@@ -15,7 +15,6 @@     (<=.),     (<>.),     like,-    contains,     between,     in',     isNull,@@ -25,6 +24,12 @@     allEntries,     idColumn,     byId,+    byIdColumn,+    orderBy,+    SortOrder (..),+    limit,+    limitOffset,+    NonEmpty(..)   ) where @@ -42,12 +47,12 @@ import           Data.List          (intercalate) 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 | Contains-  deriving (Show, Eq)+data CompareOp = Eq | Gt | Lt | GtEq | LtEq | NotEq | Like   data Field = Field [String] String-  deriving (Show, Eq)  data WhereClauseExpr   = Where Field CompareOp SqlValue@@ -59,14 +64,17 @@   | Not WhereClauseExpr   | All   | ById SqlValue-  deriving (Show, Eq)+  | ByIdColumn+  | OrderBy WhereClauseExpr (NonEmpty (Field, SortOrder))+  | Limit WhereClauseExpr Int+  | LimitOffset WhereClauseExpr Int Int +data SortOrder = ASC | DESC +  deriving (Show)+ field :: String -> Field field = Field [] -getName :: Field -> String-getName (Field _fns n) = n- infixl 3 &&.  (&&.) :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr@@ -77,7 +85,7 @@ (||.) :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr (||.) = Or -infixl 4 =., >., <., >=., <=., <>., `like`, `between`, `in'`, `contains`+infixl 4 =., >., <., >=., <=., <>., `like`, `between`, `in'`   (=.), (>.), (<.), (>=.), (<=.), (<>.), like :: (Convertible b SqlValue) => Field -> b -> WhereClauseExpr a =. b = Where a Eq (toSql b)@@ -88,9 +96,6 @@ a <>. b = Where a NotEq (toSql b) a `like` b = Where a Like (toSql b) -contains :: Convertible a SqlValue => Field -> a -> WhereClauseExpr-a `contains` b = Where a Contains (toSql b)- between :: (Convertible a1 SqlValue, Convertible a2 SqlValue) => Field -> (a1, a2) -> WhereClauseExpr a `between` (b, c) = WhereBetween a (toSql b, toSql c) @@ -109,47 +114,63 @@ byId :: (Convertible a SqlValue) => a -> WhereClauseExpr byId = ById . toSql +byIdColumn :: WhereClauseExpr+byIdColumn = ByIdColumn+ sqlFun :: String -> Field -> Field sqlFun fun (Field funs name) = Field (fun : funs) name -whereClauseExprToSql :: forall a. (Entity a) => WhereClauseExpr -> String-whereClauseExprToSql (Where f op _) = column ++ " " ++ opToSql op ++ " ?"-  where-    column = expandFunctions f $ columnNameFor @a (getName f)+infixl 1 `orderBy` -    opToSql :: CompareOp -> String-    opToSql Eq       = "="-    opToSql Gt       = ">"-    opToSql Lt       = "<"-    opToSql GtEq     = ">="-    opToSql LtEq     = "<="-    opToSql NotEq    = "<>"-    opToSql Like     = "LIKE"-    opToSql Contains = "CONTAINS"+orderBy :: WhereClauseExpr -> NonEmpty (Field, SortOrder) -> WhereClauseExpr+orderBy = OrderBy++limit :: WhereClauseExpr -> Int -> WhereClauseExpr+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 ++ ")" whereClauseExprToSql (Or e1 e2) = "(" ++ whereClauseExprToSql @a e1 ++ ") OR (" ++ whereClauseExprToSql @a e2 ++ ")"+whereClauseExprToSql (Not (WhereIsNull f)) = columnToSql @a f ++ " IS NOT NULL" whereClauseExprToSql (Not e) = "NOT (" ++ whereClauseExprToSql @a e ++ ")"-whereClauseExprToSql (WhereBetween f (_v1, _v2)) = column ++ " BETWEEN ? AND ?"-  where-    column = expandFunctions f $ columnNameFor @a (getName f)-whereClauseExprToSql (WhereIn f v) = column ++ " IN (" ++ args ++ ")"+whereClauseExprToSql (WhereBetween f (_v1, _v2)) = columnToSql @a f ++ " BETWEEN ? AND ?"+whereClauseExprToSql (WhereIn f v) = columnToSql @a f ++ " IN (" ++ args ++ ")"   where-    column = expandFunctions f $ columnNameFor @a (getName f)     args = intercalate ", " (params (length v))-whereClauseExprToSql (WhereIsNull f) = column ++ " IS NULL"-  where-    column = expandFunctions f $ columnNameFor @a (getName f)+whereClauseExprToSql (WhereIsNull f) = columnToSql @a f ++ " IS NULL" whereClauseExprToSql All = "1=1"-whereClauseExprToSql (ById _eid) = column ++ " = ?"+whereClauseExprToSql (ById _eid) = idColumn @a ++ " = ?"+whereClauseExprToSql ByIdColumn  = idColumn @a ++ " = ?"+whereClauseExprToSql (OrderBy clause pairs) = whereClauseExprToSql @a clause ++ " ORDER BY " ++ renderedPairs pairs   where-    column = idColumn @a+    renderedPairs :: NonEmpty (Field, SortOrder) -> String+    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 +    +opToSql :: CompareOp -> String+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+ idColumn :: forall a. (Entity a) => String idColumn = columnNameFor @a (idField @a) -expandFunctions :: Field -> String -> String-expandFunctions (Field [] _name) col = col-expandFunctions (Field (f : fs) name) col = f ++ "(" ++ expandFunctions (Field fs name) col ++ ")"+expandFunctions :: forall a. (Entity a) => Field -> String -- -> String+expandFunctions (Field [] name) = columnNameFor @a name+expandFunctions (Field (f : fs) name) = f ++ "(" ++ expandFunctions @a (Field fs name) ++ ")"  whereClauseValues :: WhereClauseExpr -> [SqlValue] whereClauseValues (Where _ _ v) = [toSql v]@@ -161,6 +182,10 @@ whereClauseValues (WhereIsNull _) = [] whereClauseValues All = [] whereClauseValues (ById eid) = [toSql eid]+whereClauseValues ByIdColumn = []+whereClauseValues (OrderBy clause _) = whereClauseValues clause+whereClauseValues (Limit clause _) = whereClauseValues clause+whereClauseValues (LimitOffset clause _ _) = whereClauseValues clause  params :: Int -> [String] params n = replicate n "?"

@@ -1,12 +1,15 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE LambdaCase          #-}  module Database.GP.SqlGenerator   ( insertStmtFor,+    insertReturningStmtFor,     updateStmtFor,     selectFromStmt,     deleteStmtFor,     createTableStmtFor,     dropTableStmtFor,+    columnTypeFor,     WhereClauseExpr,     Field,     field,@@ -20,7 +23,6 @@     (<=.),     (<>.),     like,-    contains,     between,     in',     isNull,@@ -28,6 +30,13 @@     sqlFun,     allEntries,     byId,+    byIdColumn,+    orderBy,+    SortOrder (..),+    limit,+    limitOffset,+    NonEmpty(..),+    Database (..),   ) where @@ -55,6 +64,23 @@   where     columns = columnNamesFor @a +insertReturningStmtFor :: forall a. Entity a => String+insertReturningStmtFor =+  "INSERT INTO "+    ++ tableName @a+    ++ " ("+    ++ intercalate ", " insertColumns+    ++ ") VALUES ("+    ++ intercalate ", " (params (length insertColumns))+    ++ ") RETURNING "+    ++ returnColumns+    ++ ";"+  where+    columns = columnNamesFor @a  +    insertColumns = filter (/= idColumn @a) columns +    returnColumns = intercalate ", " columns -- ++ ")" ++ columnNamesFor :: forall a. Entity a => [String] columnNamesFor = map snd fieldColumnPairs   where@@ -94,6 +120,10 @@     ++ idColumn @a     ++ " = ?;" +-- | An enumeration of the supported database types.+data Database = Postgres | SQLite -- | Oracle | MSSQL | MySQL+  deriving (Show, Eq)+ createTableStmtFor :: forall a. (Entity a) => Database -> String createTableStmtFor dbServer =   "CREATE TABLE "@@ -106,20 +136,33 @@     optionalPK f = if isIdField f then " PRIMARY KEY" else ""  -- | A function that returns the column type for a field of an entity.--- TODO: Support other databases than just SQLite.+-- TODO: Support other databases than just SQLite and Postgres. columnTypeFor :: forall a. (Entity a) => Database -> String -> String-columnTypeFor SQLite fieldName =-  case fType of-    "Int"    -> "INTEGER"-    "String" -> "TEXT"-    "Double" -> "REAL"-    "Float"  -> "REAL"-    "Bool"   -> "INT"-    _        -> "TEXT"+columnTypeFor dbDialect fieldName =+  case dbDialect of+    SQLite   -> columnTypeForSQLite fType+    Postgres -> columnTypeForPostgres fType   where     maybeFType = maybeFieldTypeFor @a fieldName     fType = maybe "OTHER" show maybeFType-columnTypeFor other _ = error $ "Schema creation for " ++ show other ++ " not implemented yet"+  +    columnTypeForSQLite :: String -> String+    columnTypeForSQLite = \case  +        "Int"    -> "INTEGER"+        "[Char]" -> "TEXT"+        "Double" -> "REAL"+        "Float"  -> "REAL"+        "Bool"   -> "INT"+        _        -> "TEXT"++    columnTypeForPostgres :: String -> String+    columnTypeForPostgres = \case  +        "Int"    -> "numeric"+        "[Char]" -> "varchar"+        "Double" -> "numeric"+        "Float"  -> "numeric"+        "Bool"   -> "boolean"+        _        -> "varchar"  dropTableStmtFor :: forall a. (Entity a) => String dropTableStmtFor =

@@ -23,7 +23,6 @@     fieldNames      :: [String],     fieldTypes      :: [SomeTypeRep]   }-  deriving (Show)  -- | this function is a smart constructor for TypeInfo objects. --   It takes a value of type `a` and returns a `TypeInfo a` object.@@ -32,15 +31,12 @@ typeInfo :: forall a. (HasConstructor (Rep a), HasSelectors (Rep a), Generic a) => TypeInfo a typeInfo =   TypeInfo-    { constructorName = gConstrName x,-      fieldNames = map fst (gSelectors x),-      fieldTypes = map snd (gSelectors x)-    }-  where-    x = undefined :: a+    { 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 gConstrName = genericConstrName . from @@ -50,15 +46,14 @@ instance HasConstructor f => HasConstructor (D1 c f) where   genericConstrName (M1 x) = genericConstrName x -instance (HasConstructor x, HasConstructor y) => HasConstructor (x :+: y) where-  genericConstrName (L1 l) = genericConstrName l-  genericConstrName (R1 r) = genericConstrName r+-- instance (HasConstructor x, HasConstructor y) => HasConstructor (x :+: y) where+--   genericConstrName (L1 l) = genericConstrName l+--   genericConstrName (R1 r) = genericConstrName r  instance Constructor c => HasConstructor (C1 c f) where   genericConstrName = conName  -- field names & types- gSelectors :: forall a. (HasSelectors (Rep a)) => a -> [(String, SomeTypeRep)] gSelectors _x = selectors @(Rep a) @@ -78,5 +73,5 @@ instance (HasSelectors a, HasSelectors b) => HasSelectors (a :*: b) where   selectors = selectors @a ++ selectors @b -instance HasSelectors U1 where-  selectors = []+-- instance HasSelectors U1 where+--   selectors = []

@@ -0,0 +1,95 @@+-- allows automatic derivation from Entity type class+{-# LANGUAGE DeriveAnyClass #-}++module ConnSpec+  ( test,+    spec,+  )+where++import           Database.GP+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. +-- (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 AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Article SQLite conn+  return conn++data Article = Article+  { articleID :: Int,+    title     :: String,+    year      :: Int+  }+  deriving (Generic, Entity, Show, Eq)++spec :: Spec+spec = do+  describe "Connection Handling" $ do+    it "can work with embedded connection" $ do+      Conn{implicitCommit=ic, connection=conn} <- prepareDB+      ic `shouldBe` True+      +      runRaw conn "DROP TABLE IF EXISTS Person;"+      let conn' = connect AutoCommit conn++      allArticles <- select conn' allEntries :: IO [Article]+      allArticles `shouldBe` []++    it "can handle rollback" $ do+      conn <- prepareDB+      let conn' = conn{implicitCommit=False}+      let article = Article 1 "Hello" 2023+      +      insert conn' article+      allArticles <- select conn' allEntries :: IO [Article]+      allArticles `shouldBe` [article]+      rollback conn'+      allArticles' <- select conn' allEntries :: IO [Article]+      allArticles' `shouldBe` []++    it "provide the IConnection methods" $ do+      conn <- prepareDB+      getTables conn `shouldReturn` ["Article"]++      desc <- describeTable conn "Article" +      length desc `shouldBe` 3++      let driverName = hdbcDriverName conn+      driverName `shouldBe` "sqlite3"++      let clientVer = hdbcClientVer conn+      head clientVer `shouldBe` '3'++      let proxiedClient = proxiedClientName conn+      proxiedClient `shouldBe` "sqlite3"++      let proxiedClientVerion = proxiedClientVer conn+      head proxiedClientVerion `shouldBe` '3'++      let serverVer = dbServerVer conn+      head serverVer `shouldBe` '3'++      let txSupport = dbTransactionSupport conn+      txSupport `shouldBe` True++      clonedConn <- clone conn+      implicitCommit clonedConn `shouldBe` implicitCommit conn+++++      +      +      ++

@@ -7,13 +7,11 @@   ) where -import           Database.GP           (Database (SQLite), Entity, allEntries,-                                        connect, delete, insert, select,-                                        selectById, setupTableFor, update)-import           Database.HDBC         (disconnect)+import           Database.GP import           Database.HDBC.Sqlite3 (connectSqlite3) import           GHC.Generics import           Test.Hspec+import           Prelude               hiding (print)  -- `test` is here so that this module can be run from GHCi on its own.  It is -- not needed for automatic spec discovery.@@ -30,15 +28,21 @@   }   deriving (Generic, Entity, Show) -- deriving Entity allows us to use the GenericPersistence API +--print :: Show a => a -> IO ()+--print = putStrLn . show++print :: a -> IO ()+print _ = pure ()+ spec :: Spec spec = do   describe "A simple demo" $ do     it "shows some basic use cases" $ do-      -- connect to a database-      conn <- connect SQLite <$> connectSqlite3 "sqlite.db"+      -- connect to a database in auto commit mode+      conn <- connect AutoCommit <$> connectSqlite3 "sqlite.db"        -- initialize Person table-      setupTableFor @Person conn+      setupTableFor @Person SQLite conn        -- create a Person entity       let alice = Person {personID = 123456, name = "Alice", age = 25, address = "Elmstreet 1"}@@ -59,11 +63,15 @@       allPersons <- select @Person conn allEntries       print allPersons +      -- select all Persons from a database, where age is smaller 30.+      allPersonsUnder30 <- select @Person conn ((field "age") <. (30 :: Int))+      print allPersonsUnder30+       -- delete a Person from a database       delete conn alice        -- select all Persons from a database. Now it should be empty.-      allPersons' <- select conn allEntries :: IO [Person]+      allPersons' <- select @Person conn allEntries       print allPersons'        -- close connection

@@ -20,8 +20,8 @@  prepareDB :: IO Conn prepareDB = do-  conn <- connect SQLite <$> connectSqlite3 ":memory:"-  setupTableFor @Article conn+  conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Article SQLite conn   return conn  data Article = Article

@@ -21,8 +21,8 @@  prepareDB :: IO Conn prepareDB = do-  conn <- connect SQLite <$> connectSqlite3 ":memory:"-  setupTableFor @Book conn+  conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Book SQLite conn   return conn  data Book = Book

@@ -11,6 +11,8 @@ 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. @@ -20,8 +22,8 @@  prepareDB :: IO Conn prepareDB = do-  conn <- connect SQLite <$> connectSqlite3 ":memory:"-  setupTableFor @Article conn+  conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Article SQLite conn   return conn  data Article = Article@@ -31,6 +33,27 @@   }   deriving (Generic, Entity, Show, Eq) +data Bogus = Bogus+  { bogusID :: Int,+    bogusTitle :: String,+    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+    [ ("bogusID", "articleID"),+      ("bogusTitle", "title"),+      ("bogusYear", "year")+    ]++  fromRow :: Conn -> [SqlValue] -> IO Bogus+  fromRow _conn _row = throw $ DatabaseError "can't create bogus"++ yearField :: Field yearField = field "year" @@ -48,41 +71,70 @@       _ <- insert conn article       eitherExRes <- insert conn article :: IO (Either PersistenceException ())       case eitherExRes of-        Left (DuplicateInsert _) -> expectationSuccess-        _                        -> expectationFailure "Expected DuplicateInsert exception"+        Left di@(DuplicateInsert _msg) -> show di `shouldContain` "Entity already exists"+        _                          -> expectationFailure "Expected DuplicateInsert exception"     it "detects duplicate inserts in insertMany" $ do       conn <- prepareDB       _ <- insert conn article       eitherExRes <- insertMany conn [article,article] :: IO (Either PersistenceException ())       case eitherExRes of-        Left (DuplicateInsert _) -> expectationSuccess-        _                        -> expectationFailure "Expected DuplicateInsert exception"        +        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 ())+      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"     it "detects missing entities in selectById" $ do       conn <- prepareDB       eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Article)       case eitherExRes of-        Left (EntityNotFound _) -> expectationSuccess-        _                       -> expectationFailure "Expected EntityNotFound exception"+        Left (EntityNotFound msg) -> msg `shouldContain` "not found"+        _                         -> 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"}+      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"++    it "detects bogus data in selectById" $ do+      conn <- prepareDB+      _ <- insert conn article+      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"+     it "detects missing entities in update" $ do       conn <- prepareDB       eitherExRes <- update conn article :: IO (Either PersistenceException ())       case eitherExRes of-        Left (EntityNotFound _) -> expectationSuccess-        _                       -> expectationFailure "Expected EntityNotFound exception"+        Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"+        _                         -> 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 _) -> expectationSuccess-        _                       -> expectationFailure "Right: Expected EntityNotFound exception"+        Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"+        _                         -> expectationFailure "Right: Expected EntityNotFound exception"     it "detects general backend issues" $ do-      conn <- connect SQLite <$> connectSqlite3 ":memory:"+      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       eitherExRes <- update conn article :: IO (Either PersistenceException ())       case eitherExRes of-        Left (DatabaseError _) -> expectationSuccess-        _                      -> expectationFailure "Expected DatabaseError exception"+        Left (DatabaseError msg) -> msg `shouldContain` "SqlError"+        _                        -> expectationFailure "Expected DatabaseError exception"     it "has no leaking backend exceptions" $ do-      conn <- connect SQLite <$> connectSqlite3 ":memory:"+      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       _ <- update conn article :: IO (Either PersistenceException ())       _ <- insert conn article :: IO (Either PersistenceException ())       _ <- persist conn article :: IO (Either PersistenceException ())@@ -93,5 +145,20 @@       _ <- insertMany conn [article] :: IO (Either PersistenceException ())       _ <- updateMany conn [article] :: IO (Either PersistenceException ())       _ <- deleteMany conn [article] :: IO (Either PersistenceException ())-       expectationSuccess++    it "can find column names" $ do+      let columnName = columnNameFor @Article "articleID"+      columnName `shouldBe` "articleID"++    it "throws an exception when column name is not found" $ do+      let columnName = columnNameFor @Article "unknown"+      print columnName `shouldThrow` errorCall "columnNameFor: Article has no column mapping for unknown"++    it "reports unknown fields" $ do+      let index = fieldIndex @Article "unknown"+      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\""+    

@@ -1,5 +1,6 @@ -- allows automatic derivation from Entity type class {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE QuasiQuotes #-}  module GenericPersistenceSpec   ( test,@@ -10,8 +11,9 @@ import           Database.GP.GenericPersistence import           Database.HDBC import           Database.HDBC.Sqlite3-import           GHC.Generics+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. @@ -21,9 +23,9 @@  prepareDB :: IO Conn prepareDB = do-  conn <- connect SQLite <$> connectSqlite3 ":memory:"-  setupTableFor @Person conn-  setupTableFor @Book conn+  conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Person SQLite conn+  setupTableFor @Book SQLite conn   return conn  -- | A data type with several fields, using record syntax.@@ -35,12 +37,11 @@   }   deriving (Generic, Entity, Show, Eq) -nameField :: Field-nameField = field "name"-ageField :: Field-ageField = field "age"-addressField :: Field-addressField = field "address"+data Car = Car+  { carID :: Int,+    carType  :: String+  }+  deriving (Generic, Entity, Show, Eq)  data Book = Book   { book_id  :: Int,@@ -78,16 +79,9 @@     Person 6 "Frank" 50 "1415 Walnut St"   ] - book :: Book book = Book 1 "The Hobbit" "J.R.R. Tolkien" 1937 Fiction -lower :: Field -> Field-lower = sqlFun "LOWER";--upper :: Field -> Field-upper = sqlFun "UPPER";- spec :: Spec spec = do   describe "GenericPersistence" $ do@@ -102,6 +96,17 @@       head allPersons `shouldBe` bob       person' <- selectById conn (1 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just bob+    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 +      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"       it "retrieves Entities using user implementation" $ do       conn <- prepareDB       let hobbit = Book 1 "The Hobbit" "J.R.R. Tolkien" 1937 Fiction@@ -112,42 +117,30 @@       length allBooks `shouldBe` 3       head allBooks `shouldBe` hobbit       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)-      book' `shouldBe` Just hobbit-    it "retrieves Entities using a simple Query DSL" $ do+      book' `shouldBe` Just hobbit     +    it "select returns Nothing if no Entity was found" $ do       conn <- prepareDB-      let bob = Person 1 "Bob" 36 "West Street 79"-          alice = Person 2 "Alice" 25 "West Street 90"-          charlie = Person 3 "Charlie" 35 "West Street 40"-      insertMany conn [alice, bob, charlie]-      one <- select conn (nameField =. "Bob" &&. ageField =. (36 :: Int))-      length one `shouldBe` 1-      head one `shouldBe` bob-      two <- select conn (nameField =. "Bob" ||. ageField =. (25 :: Int))-      length two `shouldBe` 2-      two `shouldContain` [bob, alice]-      three <- select conn (addressField `like` "West Street %") :: IO [Person]-      length three `shouldBe` 3-      empty <- select conn (not' $ addressField `like` "West Street %") :: IO [Person]-      length empty `shouldBe` 0-      boomers <- select conn (ageField >. (30 :: Int))-      length boomers `shouldBe` 2-      boomers `shouldContain` [bob, charlie]-      thirtySomethings <- select conn (ageField `between` (30 :: Int, 40 :: Int)) :: IO [Person]-      length thirtySomethings `shouldBe` 2-      thirtySomethings `shouldContain` [bob, charlie]-      aliceAndCharlie <- select conn (nameField `in'` ["Alice", "Charlie"])-      length aliceAndCharlie `shouldBe` 2-      aliceAndCharlie `shouldContain` [alice, charlie]-      noOne <- select conn (isNull nameField) :: IO [Person]-      length noOne `shouldBe` 0-      allPersons <- select conn (not' $ isNull nameField) :: IO [Person]+      allPersons' <- select @Person conn allEntries+      allPersons' `shouldBe` []+    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 +      conn <- prepareDB+      insertMany conn manyPersons+      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-      peopleFromWestStreet <- select conn (lower(upper addressField) `like` "west street %") :: IO [Person]-      length peopleFromWestStreet `shouldBe` 3-      charlie' <- select conn (byId "3") :: IO [Person]-      length charlie' `shouldBe` 1-      head charlie' `shouldBe` charlie-           it "persists new Entities using Generics" $ do       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]@@ -166,6 +159,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 +      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"      it "persists existing Entities using Generics" $ do       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]@@ -183,7 +183,10 @@       persist conn book       allbooks' <- select conn allEntries :: IO [Book]       length allbooks' `shouldBe` 1-      persist conn book {year = 1938}+      eitherEA <- try $ persist conn book {year = 1938} :: IO (Either PersistenceException ())+      case eitherEA of+        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}     it "inserts Entities using Generics" $ do@@ -195,6 +198,12 @@       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 _) <- insertReturning conn (Car 0 "Honda Jazz")+      myCar' <- selectById conn carId :: IO (Maybe Car)+      myCar' `shouldBe` Just myCar     it "inserts many Entities re-using a single prepared stmt" $ do       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]@@ -264,10 +273,10 @@     it "provides a Connection Pool" $ do       connPool <- sqlLitePool ":memory:"        withResource connPool $ \conn -> do-        setupTableFor @Person conn+        setupTableFor @Person SQLite conn         insert conn person         allPersons <- select conn allEntries :: IO [Person]         length allPersons `shouldBe` 1  sqlLitePool :: FilePath -> IO ConnectionPool-sqlLitePool sqlLiteFile = createConnPool SQLite sqlLiteFile connectSqlite3 10 100+sqlLitePool sqlLiteFile = createConnPool AutoCommit sqlLiteFile connectSqlite3 10 100

@@ -0,0 +1,174 @@+-- allows automatic derivation from Entity type class+{-# LANGUAGE DeriveAnyClass #-}++module OneToManySafeSpec+  ( test,+    spec,+  )+where++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. +-- (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 AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Article SQLite conn+  setupTableFor @Author SQLite conn+  return conn++data Article = Article+  { articleID :: Int,+    title     :: String,+    authorId  :: Int,+    year      :: Int+  }+  deriving (Generic, Entity, Show, Eq) -- automatically derives Entity++data Author = Author+  { authorID :: Int,+    name     :: String,+    address  :: String,+    articles :: [Article]+  }+  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+    [ ("authorID", "authorID"),+      ("name", "name"),+      ("address", "address")+    ]++  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+    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++  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)]+++article1 :: Article+article1 =+  Article+    { articleID = 1,+      title = "Persistence without Boilerplate",+      authorId = 1,+      year = 2018+    }++article2 :: Article+article2 =+  Article+    { articleID = 2,+      title = "Boilerplate for Dummies",+      authorId = 2,+      year = 2020+    }++article3 :: Article+article3 =+  Article+    { articleID = 3,+      title = "The return of the boilerplate",+      authorId = 2,+      year = 2022+    }++arthur :: Author+arthur =+  Author+    { authorID = 2,+      name = "Arthur Miller",+      address = "Denver",+      articles = [article2, article3]+    }++spec :: Spec+spec = do+  describe "Handling of 1:N References" $ do+    it "works like a charm" $ do+      conn <- prepareDB++      eitherPeUnit <- insert conn arthur+      print eitherPeUnit+      _ <- insert conn article1++      authors <- fromRight [] <$> select @Author conn allEntries+      length authors `shouldBe` 1++      articles' <- fromRight [] <$> select @Article conn allEntries+      length articles' `shouldBe` 3++      eitherPeAuthor <- selectById @Author conn "2"+      eitherPeAuthor `shouldBe` Right arthur+      case eitherPeAuthor of+        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"}+    it "delete returns unit in case of success" $ do+      conn <- prepareDB+      _ <- insert conn arthur+      eitherPeUnit <- delete conn arthur+      eitherPeUnit `shouldBe` Right ()+    it "delete handles exceptions" $ do+      conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+      eitherPeUnit <- delete conn arthur+      case eitherPeUnit of+        Left (DatabaseError msg) -> msg `shouldContain` "no such table: Author"+        _ -> fail "should not happen"+    it "insertMany works with references" $ do+      conn <- prepareDB+      let authors = [arthur, arthur{name="Bob", authorID=3, articles=[]}]+      eitherPeUnit <- insertMany conn authors+      eitherPeUnit `shouldBe` Right ()+      eitherPeAuthors <- select @Author conn allEntries+      eitherPeAuthors `shouldBe` Right authors+    it "update works with references" $ do+      conn <- prepareDB+      _ <- insert conn arthur+      eitherPeUnit <- update conn arthur {address = "New York"}+      eitherPeUnit `shouldBe` Right ()+      eitherPeAuthor <- selectById @Author conn "2"+      eitherPeAuthor `shouldBe` Right arthur {address = "New York"}+    it "updateMany works with references" $ do+      conn <- prepareDB+      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 ()+      eitherPeAuthors <- select @Author conn allEntries+      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=[]}]+      _ <- insertMany conn authors+      eitherPeUnit <- deleteMany conn authors+      eitherPeUnit `shouldBe` Right ()+      eitherPeAuthors <- select @Author conn allEntries+      eitherPeAuthors `shouldBe` Right []++

@@ -22,9 +22,9 @@  prepareDB :: IO Conn prepareDB = do-  conn <- connect SQLite <$> connectSqlite3 ":memory:"-  setupTableFor @Article conn-  setupTableFor @Author conn+  conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Article SQLite conn+  setupTableFor @Author SQLite conn   return conn  data Article = Article

@@ -0,0 +1,180 @@+{-# LANGUAGE DeriveAnyClass #-}+module PostgresQuerySpec +( test+, spec+)+where ++import           Database.GP+import           Database.GP.SqlGenerator+import           Database.HDBC.PostgreSQL+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. +-- (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++  insertMany conn [alice, bob, charlie]+  commit conn+  return conn++-- | A data type with several fields, using record syntax.+data Person = Person+  { personID :: Int,+    name     :: String,+    age      :: Int,+    address  :: String+  }+  deriving (Generic, Entity, Show, Eq)++alice, bob, charlie, dave :: Person+bob = Person 1 "Bob" 36 "West Street 79"+alice = Person 2 "Alice" 25 "West Street 90"+charlie = Person 3 "Charlie" 35 "West Street 40"+dave = Person 4 "Dave" 35 "East Street 12"++nameField, ageField, addressField :: Field+nameField = field "name"+ageField = field "age"+addressField = field "address"++lower :: Field -> Field+lower = sqlFun "LOWER";++upper :: Field -> Field+upper = sqlFun "UPPER";++spec :: Spec+spec = do+  describe "The Query DSL against Postgres" $ do+    it "supports conjunction with &&." $ do+      conn <- prepareDB+      one <- select conn (nameField =. "Bob" &&. ageField =. (36 :: Int))+      length one `shouldBe` 1+      head one `shouldBe` bob+      commit conn+    -- 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]+      commit conn+    it "supports LIKE" $ do+      conn <- prepareDB+      three <- select conn (addressField `like` "West Street %") :: IO [Person]+      length three `shouldBe` 3+      commit conn+    it "supports NOT" $ do+      conn <- prepareDB  +      empty <- select conn (not' $ addressField `like` "West Street %") :: IO [Person]+      length empty `shouldBe` 0+      commit conn+    it "supports fieldwise comparisons like >" $ do+      conn <- prepareDB+      boomers <- select conn (ageField >. (30 :: Int))+      length boomers `shouldBe` 2+      boomers `shouldContain` [bob, charlie]+      teens <- select conn (ageField <. (20 :: Int)) :: IO [Person]+      length teens `shouldBe` 0+      wisePerson <- select conn (ageField >=. (50 :: Int)) :: IO [Person]+      length wisePerson `shouldBe` 0+      notAbove25 <- select conn (ageField <=. (25 :: Int)) :: IO [Person]+      length notAbove25 `shouldBe` 1+      allButBob <- select conn (ageField <>. (36 :: Int)) :: IO [Person]+      length allButBob `shouldBe` 2+      commit conn+    it "supports BETWEEN" $ do+      conn <- prepareDB+      thirtySomethings <- select conn (ageField `between` (30 :: Int, 40 :: Int)) :: IO [Person]+      length thirtySomethings `shouldBe` 2+      thirtySomethings `shouldContain` [bob, charlie]+      commit conn+    it "supports IN" $ do+      conn <- prepareDB+      aliceAndCharlie <- select conn (nameField `in'` ["Alice", "Charlie"])+      length aliceAndCharlie `shouldBe` 2+      aliceAndCharlie `shouldContain` [alice, charlie]+      commit conn+    it "supports IS NULL" $ do+      conn <- prepareDB+      noOne <- select conn (isNull nameField) :: IO [Person]+      length noOne `shouldBe` 0+      commit conn+    it "supports IS NOT NULL" $ do+      conn <- prepareDB+      allPersons <- select conn (not' $ isNull nameField) :: IO [Person]+      length allPersons `shouldBe` 3+      commit conn+    it "supports SQL functions on columns" $ do+      conn <- prepareDB+      peopleFromWestStreet <- select conn (lower(upper addressField) `like` "west street %") :: IO [Person]+      length peopleFromWestStreet `shouldBe` 3+      commit conn+    it "supports selection by id" $ do+      conn <- prepareDB+      charlie' <- select conn (byId "3") :: IO [Person]+      length charlie' `shouldBe` 1+      head charlie' `shouldBe` charlie+      commit conn+    it "supports ORDER BY" $ do+      conn <- prepareDB+      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)])+      length sortedPersons `shouldBe` 4+      sortedPersons `shouldBe` [alice, dave, charlie, bob]+      commit conn+    it "supports LIMIT" $ do+      conn <- prepareDB+      insert conn dave+      limitedPersons <- select @Person conn (allEntries `limit` 2)+      length limitedPersons `shouldBe` 2+      commit conn+    it "supports LIMIT OFFSET" $ do+      conn <- prepareDB+      insert conn dave+      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"+    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"+    it "can create whereclauses" $ do+      whereClauseValues byIdColumn `shouldBe` []+      +data SomeRecord = SomeRecord+  { someRecordID :: Int,+    someRecordName :: String,+    someRecordAge :: Double,+    someRecordTax :: Float,+    someRecordFlag :: Bool,+    someRecordDate :: Integer+  }+  deriving (Generic, Entity, Show, Eq)+

@@ -0,0 +1,317 @@+-- allows automatic derivation from Entity type class+{-# LANGUAGE DeriveAnyClass #-}++module PostgresSpec+  ( test,+    spec,+  )+where++import           Database.GP+import           Database.HDBC.PostgreSQL+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. +-- (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+  _ <- run conn "DROP TABLE IF EXISTS Car;" []+  _ <- run conn "CREATE TABLE Car (carID serial4 PRIMARY KEY, carType varchar);" []+  commit conn+  return conn++-- | A data type with several fields, using record syntax.+data Person = Person+  { personID :: Int,+    name     :: String,+    age      :: Int,+    address  :: String+  }+  deriving (Generic, Entity, Show, Eq)++data Car = Car+  { carID :: Int,+    carType  :: String+  }+  deriving (Generic, Entity, Show, Eq)++data Book = Book+  { book_id  :: Int,+    title    :: String,+    author   :: String,+    year     :: Int,+    category :: BookCategory+  }+  deriving (Generic, Show, Eq)++data BookCategory = Fiction | Travel | Arts | Science | History | Biography | Other+  deriving (Generic, Read, Show, Eq, Enum)++instance Entity Book where+  idField = "book_id"+  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+      col i = fromSql (row !! i)++  toRow _c b = pure [toSql (book_id b), toSql (title b), toSql (author b), toSql (year b), toSql (category b)]++person :: Person+person = Person 123456 "Alice" 25 "123 Main St"++manyPersons :: [Person]+manyPersons =+  [ Person 1 "Alice" 25 "123 Main St",+    Person 2 "Bob" 30 "456 Elm St",+    Person 3 "Charlie" 35 "789 Pine St",+    Person 4 "Dave" 40 "1011 Oak St",+    Person 5 "Eve" 45 "1213 Maple St",+    Person 6 "Frank" 50 "1415 Walnut St"+  ]++book :: Book+book = Book 1 "The Hobbit" "J.R.R. Tolkien" 1937 Fiction++spec :: Spec+spec = do+  describe "GenericPersistence for PostgreSQL" $ do+    it "retrieves Entities using Generics" $ do+      conn <- prepareDB+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 0+      let bob = Person 1 "Bob" 36 "7 West Street"+          alice = Person 2 "Alice" 25 "7 West Street"+      runRaw conn "INSERT INTO Person (personID, name, age, address) VALUES (1, 'Bob', 36, '7 West Street');"+      runRaw conn "INSERT INTO Person (personID, name, age, address) VALUES (2, 'Alice', 25, '7 West Street');"+      runRaw conn "INSERT INTO Person (personID, name, age, address) VALUES (3, 'Frank', 56, '7 West Street');"+      commit conn+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 3+      head allPersons `shouldBe` bob+      person' <- selectById conn (2 :: Int) :: IO (Maybe Person)+      person' `shouldBe` Just alice+      commit conn+    it "selectById returns Nothing if no Entity was found" $ do+      conn <- prepareDB+      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 +      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"  +      rollback conn+    it "retrieves Entities using user implementation" $ do+      conn <- prepareDB+      let hobbit = Book 1 "The Hobbit" "J.R.R. Tolkien" 1937 Fiction+      runRaw conn "INSERT INTO BOOK_TBL (bookId, bookTitle, bookAuthor, bookYear, bookCategory) VALUES (1, 'The Hobbit', 'J.R.R. Tolkien', 1937, 0);"+      runRaw conn "INSERT INTO BOOK_TBL (bookId, bookTitle, bookAuthor, bookYear, bookCategory) VALUES (2, 'The Lord of the Rings', 'J.R.R. Tolkien', 1955, 0);"+      runRaw conn "INSERT INTO BOOK_TBL (bookId, bookTitle, bookAuthor, bookYear, bookCategory) VALUES (3, 'Smith of Wootton Major', 'J.R.R. Tolkien', 1967, 0);"+      commit conn+      allBooks <- select conn allEntries :: IO [Book]+      length allBooks `shouldBe` 3+      head allBooks `shouldBe` hobbit+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)+      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 +      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"  +      rollback conn+    it "persists new Entities using Generics" $ do+      conn <- prepareDB+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 0+      persist conn person+      commit conn+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 1+      person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)+      person' `shouldBe` Just person+      commit conn+    it "persists new Entities using user implementation" $ do+      conn <- prepareDB+      allbooks <- select conn allEntries :: IO [Book]+      length allbooks `shouldBe` 0+      persist conn book+      commit conn+      allbooks' <- select conn allEntries :: IO [Book]+      length allbooks' `shouldBe` 1+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)+      book' `shouldBe` Just book+      commit conn+    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" +    it "persists existing Entities using Generics" $ do+      conn <- prepareDB+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 0+      persist conn person+      commit conn+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 1+      persist conn person {age = 26}+      commit conn+      person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)+      person' `shouldBe` Just person {age = 26}+      commit conn+    it "persists existing Entities using user implementation" $ do+      conn <- prepareDB+      allbooks <- select conn allEntries :: IO [Book]+      length allbooks `shouldBe` 0+      persist conn book+      commit conn+      allbooks' <- select conn allEntries :: IO [Book]+      length allbooks' `shouldBe` 1+      eitherEA <- try $ persist conn book {year = 1938} :: IO (Either PersistenceException ())+      case eitherEA of+        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 "inserts Entities using Generics" $ do+      conn <- prepareDB+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 0+      insert conn person+      commit conn+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 1+      person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)+      person' `shouldBe` Just person+      commit conn+    it "inserts Entities with autoincrement handling" $ do+      conn <- prepareDB+      myCar@(Car carId _) <- insertReturning conn (Car 0 "Honda Jazz")+      myCar' <- selectById conn carId :: IO (Maybe Car)+      myCar' `shouldBe` Just myCar+      commit conn+    it "inserts many Entities re-using a single prepared stmt" $ do+      conn <- prepareDB+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 0+      insertMany conn manyPersons+      commit conn+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 6+      commit conn+    it "updates many Entities re-using a single prepared stmt" $ do+      conn <- prepareDB+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 0+      insertMany conn manyPersons+      commit conn+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 6+      let manyPersons' = map (\p -> p {name = "Bob"}) manyPersons+      updateMany conn manyPersons'+      commit conn+      allPersons'' <- select conn allEntries :: IO [Person]+      all (\p -> name p == "Bob") allPersons'' `shouldBe` True+      commit conn+    it "deletes many Entities re-using a single prepared stmt" $ do+      conn <- prepareDB+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 0+      insertMany conn manyPersons+      commit conn+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 6   +      deleteMany conn allPersons'+      commit conn+      allPersons'' <- select conn allEntries :: IO [Person]+      length allPersons'' `shouldBe` 0+      commit conn++    it "inserts Entities using user implementation" $ do+      conn <- prepareDB+      allbooks <- select conn allEntries :: IO [Book]+      length allbooks `shouldBe` 0+      insert conn book+      commit conn+      allbooks' <- select conn allEntries :: IO [Book]+      length allbooks' `shouldBe` 1+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)+      book' `shouldBe` Just book+      commit conn +    it "updates Entities using Generics" $ do+      conn <- prepareDB+      insert conn person+      update conn person {name = "Bob"}+      commit conn+      person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)+      person' `shouldBe` Just person {name = "Bob"}+      commit conn+    it "updates Entities using user implementation" $ do+      conn <- prepareDB+      insert conn book+      update conn book {title = "The Lord of the Rings"}+      commit conn+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)+      book' `shouldBe` Just book {title = "The Lord of the Rings"}+      commit conn+    it "deletes Entities using Generics" $ do+      conn <- prepareDB+      insert conn person+      allPersons <- select conn allEntries :: IO [Person]+      length allPersons `shouldBe` 1+      delete conn person+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 0+      commit conn+    it "deletes Entities using user implementation" $ do+      conn <- prepareDB+      insert conn book+      allBooks <- select conn allEntries :: IO [Book]+      length allBooks `shouldBe` 1+      delete conn book+      allBooks' <- select conn allEntries :: IO [Book]+      length allBooks' `shouldBe` 0+      commit conn+    it "provides a Connection Pool" $ do+      connPool <- postgreSQLPool "host=localhost dbname=postgres user=postgres password=admin port=5431" +      withResource connPool $ \conn -> do+        setupTableFor @Person SQLite conn+        insert conn person+        allPersons <- select conn allEntries :: IO [Person]+        length allPersons `shouldBe` 1+        commit conn++postgreSQLPool :: String -> IO ConnectionPool+postgreSQLPool connectString = createConnPool ExplicitCommit connectString connectPostgreSQL 10 100

@@ -0,0 +1,163 @@+{-# LANGUAGE DeriveAnyClass #-}+module QuerySpec +( test+, spec+)+where ++import           Database.GP+import           Database.GP.SqlGenerator+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. +-- (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 AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Person SQLite conn++  insertMany conn [alice, bob, charlie]+  return conn++-- | A data type with several fields, using record syntax.+data Person = Person+  { personID :: Int,+    name     :: String,+    age      :: Int,+    address  :: String+  }+  deriving (Generic, Entity, Show, Eq)++alice, bob, charlie, dave :: Person+bob = Person 1 "Bob" 36 "West Street 79"+alice = Person 2 "Alice" 25 "West Street 90"+charlie = Person 3 "Charlie" 35 "West Street 40"+dave = Person 4 "Dave" 35 "East Street 12"++nameField, ageField, addressField :: Field+nameField = field "name"+ageField = field "age"+addressField = field "address"++lower :: Field -> Field+lower = sqlFun "LOWER";++upper :: Field -> Field+upper = sqlFun "UPPER";++spec :: Spec+spec = do+  describe "The Query DSL against SQLite" $ do+    it "supports conjunction with &&." $ do+      conn <- prepareDB+      one <- select conn (nameField =. "Bob" &&. ageField =. (36 :: Int))+      length one `shouldBe` 1+      head one `shouldBe` bob+    it "supports disjunction with ||." $ do+      conn <- prepareDB+      two <- select conn (nameField =. "Bob" ||. ageField =. (25 :: Int))+      length two `shouldBe` 2+      two `shouldContain` [bob, alice]+    it "supports LIKE" $ do+      conn <- prepareDB+      three <- select conn (addressField `like` "West Street %") :: IO [Person]+      length three `shouldBe` 3+    it "supports NOT" $ do+      conn <- prepareDB  +      empty <- select conn (not' $ addressField `like` "West Street %") :: IO [Person]+      length empty `shouldBe` 0+    it "supports fieldwise comparisons like >" $ do+      conn <- prepareDB+      boomers <- select conn (ageField >. (30 :: Int))+      length boomers `shouldBe` 2+      boomers `shouldContain` [bob, charlie]+      teens <- select conn (ageField <. (20 :: Int)) :: IO [Person]+      length teens `shouldBe` 0+      wisePerson <- select conn (ageField >=. (50 :: Int)) :: IO [Person]+      length wisePerson `shouldBe` 0+      notAbove25 <- select conn (ageField <=. (25 :: Int)) :: IO [Person]+      length notAbove25 `shouldBe` 1+      allButBob <- select conn (ageField <>. (36 :: Int)) :: IO [Person]+      length allButBob `shouldBe` 2+    it "supports BETWEEN" $ do+      conn <- prepareDB+      thirtySomethings <- select conn (ageField `between` (30 :: Int, 40 :: Int)) :: IO [Person]+      length thirtySomethings `shouldBe` 2+      thirtySomethings `shouldContain` [bob, charlie]+    it "supports IN" $ do+      conn <- prepareDB+      aliceAndCharlie <- select conn (nameField `in'` ["Alice", "Charlie"])+      length aliceAndCharlie `shouldBe` 2+      aliceAndCharlie `shouldContain` [alice, charlie]+    it "supports IS NULL" $ do+      conn <- prepareDB+      noOne <- select conn (isNull nameField) :: IO [Person]+      length noOne `shouldBe` 0+    it "supports IS NOT NULL" $ do+      conn <- prepareDB+      allPersons <- select conn (not' $ isNull nameField) :: IO [Person]+      length allPersons `shouldBe` 3+    it "supports SQL functions on columns" $ do+      conn <- prepareDB+      peopleFromWestStreet <- select conn (lower(upper addressField) `like` "west street %") :: IO [Person]+      length peopleFromWestStreet `shouldBe` 3+    it "supports selection by id" $ do+      conn <- prepareDB+      charlie' <- select conn (byId "3") :: IO [Person]+      length charlie' `shouldBe` 1+      head charlie' `shouldBe` charlie+    it "supports ORDER BY" $ do+      conn <- prepareDB+      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)])+      length sortedPersons `shouldBe` 4+      sortedPersons `shouldBe` [alice, dave, charlie, bob]+    it "supports LIMIT" $ do+      conn <- prepareDB+      insert conn dave+      limitedPersons <- select @Person conn (allEntries `limit` 2)+      length limitedPersons `shouldBe` 2+    it "supports LIMIT OFFSET" $ do+      conn <- prepareDB+      insert conn dave+      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"+    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"+    it "can create whereclauses" $ do+      whereClauseValues byIdColumn `shouldBe` []+      +data SomeRecord = SomeRecord+  { someRecordID :: Int,+    someRecordName :: String,+    someRecordAge :: Double,+    someRecordTax :: Float,+    someRecordFlag :: Bool,+    someRecordDate :: Integer+  }+  deriving (Generic, Entity, Show, Eq)+

@@ -22,9 +22,9 @@  prepareDB :: IO Conn prepareDB = do-  conn <- connect SQLite <$> connectSqlite3 ":memory:"-  setupTableFor @Article conn-  setupTableFor @Author conn+  conn <- connect AutoCommit <$> connectSqlite3 ":memory:"+  setupTableFor @Article SQLite conn+  setupTableFor @Author SQLite conn   return conn  data Article = Article@@ -66,8 +66,6 @@     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 =