generic-persistence 0.3.0.1 → 0.4.0.0

raw patch · 17 files changed

+1073/−253 lines, 17 filesdep +resource-poolPVP ok

version bump matches the API change (PVP)

Dependencies added: resource-pool

API changes (from Hackage documentation)

Files

• README.md +121/−36
• generic-persistence.cabal +9/−3
• src/Database/GP.hs +29/−8
• src/Database/GP/Conn.hs +42/−11
• src/Database/GP/Entity.hs +0/−4
• src/Database/GP/GenericPersistence.hs +88/−102
• src/Database/GP/GenericPersistenceSafe.hs +293/−0
• src/Database/GP/Query.hs +166/−0
• src/Database/GP/SqlGenerator.hs +34/−40
• src/Database/GP/TypeInfo.hs +0/−0
• test/DemoSpec.hs +70/−0
• test/EmbeddedSpec.hs +4/−3
• test/EnumSpec.hs +3/−2
• test/ExceptionsSpec.hs +97/−0
• test/GenericPersistenceSpec.hs +106/−35
• test/OneToManySpec.hs +6/−5
• test/ReferenceSpec.hs +5/−4

@@ -6,14 +6,15 @@  ## Introduction -GenericPersistence is a minimalistic Haskell persistence layer for relational databases. +GenericPersistence is a small Haskell persistence layer for relational databases.  The approach relies on [GHC.Generics](https://hackage.haskell.org/package/base-4.17.0.0/docs/GHC-Generics.html). The actual database access is provided by the [HDBC](https://hackage.haskell.org/package/HDBC) library.  The *functional goal* of the persistence layer is to provide hassle-free RDBMS persistence for Haskell data types in -Record notation (for brevity I call them *Entities*).+Record notation (for simplicity I call these *Entities*). -That is, it provides means for inserting, updating, deleting and quering such enties to/from relational databases.+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@@ -27,11 +28,10 @@  ## Status -The library is in an early stage of development. All test cases are green and it should be ready for early adopters.-Several things are still missing:+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: -- A query language-- Handling auto-incrementing primary keys+- auto-incrementing primary keys - caching - coding free support for 1:1 and 1:n relationships (using more generics magic) - schema migration@@ -68,9 +68,11 @@  module Main (main) where -import           Database.GP         -import           Database.HDBC-import           Database.HDBC.Sqlite3+import           Database.GP           (Database (SQLite), Entity, allEntries,+                                        connect, delete, insert, select,+                                        selectById, setupTableFor, update)+import           Database.HDBC         (disconnect)+import           Database.HDBC.Sqlite3 (connectSqlite3) import           GHC.Generics  -- | An Entity data type with several fields, using record syntax.@@ -87,36 +89,27 @@ main = do   -- connect to a database   conn <- connect SQLite <$> connectSqlite3 "sqlite.db"-   -- initialize Person table   setupTableFor @Person 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, -  -- as `retrieveEntityById` has a polymorphic return type `IO (Maybe a)`.-  alice' <- retrieveById @Person conn "123456" +  -- as `selectById` has a polymorphic return type `IO (Maybe a)`.+  alice' <- selectById @Person conn "123456"    print alice'--  -- select all Persons from a database-  allPersons <- retrieveAll @Person conn+  -- select all Persons from a database. again, the result type must be provided.+  allPersons <- select @Person conn allEntries   print allPersons-   -- delete a Person from a database   delete conn alice-   -- select all Persons from a database. Now it should be empty.-  allPersons' <- retrieveAll conn :: IO [Person]+  allPersons' <- select conn allEntries :: IO [Person]   print allPersons'-   -- close connection   disconnect conn ```@@ -359,7 +352,7 @@    fromRow :: Conn -> [SqlValue] -> IO Article   fromRow conn row = do    -    authorById <- fromJust <$> retrieveById conn (row !! 2)  -- load author by foreign key+    authorById <- fromJust <$> selectById conn (row !! 2)  -- load author by foreign key     return $ rawArticle {author = authorById}                -- add author to article     where       rawArticle = Article (col 0) (col 1)                   -- create article from row, @@ -415,12 +408,12 @@    fromRow :: Conn -> [SqlValue] -> IO Author   fromRow conn row = do-    let authID = head row                                 -- authorID is the first column-    articlesBy <- retrieveAllWhere conn "authorId" authID -- retrieve all articles by this author-    return rawAuthor {articles = articlesBy}              -- add the articles to the author+    let authID = head row                                  -- authorID is the first column+    articlesBy <- select conn (field "authorId" =. authID) -- retrieve all articles by this author+    return rawAuthor {articles = articlesBy}               -- add the articles to the author     where-      rawAuthor = Author (col 0) (col 1) (col 2) []       -- create the author from row (w/o articles)-      col i = fromSql (row !! i)                          -- helper function to convert SqlValue to Haskell type+      rawAuthor = Author (col 0) (col 1) (col 2) []        -- create the author from row (w/o articles)+      col i = fromSql (row !! i)                           -- helper function to convert SqlValue to Haskell type    toRow :: Conn -> Author -> IO [SqlValue]   toRow conn a = do@@ -432,14 +425,79 @@ Persisting all articles of an author as a side effect during the conversion of the author to a row may seem *special*... You can ommit this step. But then you have to persist the articles manually before persisting the author. -## Integrating user defined queries+## Performing queries with the Query DSL -As of now, the library only supports very basic support for queries:+The library provides a simple DSL for performing `SELECT`queries. The `select` function  -- `retrieveById` retrieves a single row of a table by its primary key-- `retrieveAll` retrieves all rows of a table-- `retrieveAllWhere` retrieves all rows of a table where a given column has a given value+```haskell+select :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO [a]+``` +This function retrieves all entities of type `a` that match some query criteria.+The function takes an HDBC connection (wrapped in a `Conn`) and a `WhereClauseExpr` as parameters.+The function returns a (possibly empty) list of all matching entities.++The `WhereClauseExpr` is constructed using a small set of functions and infix operators.++There are a set of infix operators `(=.), (>.), (<.), (>=.), (<=.), (<>.), like, between, in', contains` that define field comparisons:++```haskell+field "name" =. "John"++field "age" >=. 18++field "age" `between` (18, 30)++field "name" `like` "J%"++field "name" `in'` ["John", "Jane"]+```++Then we have three function `isNull`, `allEntries` and `byId` that also define simple `WHERE` clauses:++```haskell+isNull (field "name") -- matches all entries where the name field is NULL++byId 42               -- matches the entry where the primary key column has the value 42++allEntries            -- matches all entries of the table+```++It is also possible to apply SQL functions to fields:++```haskell+lower = sqlFun "LOWER" -- define a function that applies the SQL function LOWER to a field++lower(field "name") =. "all lowercase"+```++These field-wise comparisons can be combined using the logical operators `&&.`, `||.` and `not'`:++```haskell+(field "name" `like` "J%") &&. (field "age" >=. 18)++(field "name" =. "John") ||. (field "name" =. "Jane")++not' (field "name" =. "John")+```++The `select` function will then use the `WhereClauseExpr` constructed from these operators and functions to generate a SQL query that retrieves all matching entities:++```haskell++ageField :: Field+ageField = field "age"++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).+++## 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.+ If you want to use more complex queries, you can integrate HDBC SQL queries by using the `entitiesFromRows` function as in the following example:  ```haskell@@ -463,7 +521,7 @@   insertMany conn people    -- perform a custom query with HDBC-  stmt = "SELECT * FROM Person WHERE age >= ?"+  stmt = "SELECT * FROM Person WHERE age >= ? ORDER BY age ASC"   resultRows <- quickQuery conn stmt [toSql (40 :: Int)]    -- convert the resulting rows into a list of Person objects@@ -487,4 +545,31 @@ let conn = c {implicitCommit = False} ``` +## A simple Connection Pool++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 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.++The following example shows how to create a connection pool and how to use it to perform a database query:++```haskell++sqlLitePool :: FilePath -> IO ConnectionPool+sqlLitePool sqlLiteFile = createConnPool SQLite sqlLiteFile connectSqlite3 10 100++main :: IO ()+main = do+  connPool <- sqlLitePool ":memory:" +  let alice = Person 123456 "Alice" 25 "123 Main St"+  withResource connPool $ \conn -> do+    setupTableFor @Person conn+    insert conn alice+    allPersons <- select conn allEntries :: IO [Person]+    print allPersons+```++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.3.0.1+version:            0.4.0.0 license:            BSD3 license-file:       LICENSE copyright:          2023 Thomas Mahler@@ -27,6 +27,8 @@         Database.GP.Conn         Database.GP.Entity         Database.GP.GenericPersistence+        Database.GP.GenericPersistenceSafe+        Database.GP.Query         Database.GP.SqlGenerator         Database.GP.TypeInfo @@ -42,7 +44,8 @@         HDBC <2.5,         base >=4.7 && <5,         convertible <1.2,-        generic-deriving <1.15+        generic-deriving <1.15,+        resource-pool <0.5  test-suite generic-persistence-test     type:               exitcode-stdio-1.0@@ -50,8 +53,10 @@     build-tool-depends: hspec-discover:hspec-discover >=2 && <3     hs-source-dirs:     test     other-modules:+        DemoSpec         EmbeddedSpec         EnumSpec+        ExceptionsSpec         GenericPersistenceSpec         OneToManySpec         ReferenceSpec@@ -73,4 +78,5 @@         generic-deriving <1.15,         generic-persistence,         hspec <2.10,-        hspec-discover <2.10+        hspec-discover <2.10,+        resource-pool <0.5

@@ -1,7 +1,6 @@ module Database.GP-  ( retrieveById,-    retrieveAll,-    retrieveAllWhere,+  ( selectById,+    select,     entitiesFromRows,     persist,     insert,@@ -9,21 +8,43 @@     update,     updateMany,     delete,+    deleteMany,     setupTableFor,     idValue,+    Conn(..),+    connect,+    Database(..),+    ConnectionPool,+    createConnPool,+    withResource,     Entity (..),     GToRow,     GFromRow,     columnNameFor,     maybeFieldTypeFor,     toString,-    EntityId,-    entityId,     TypeInfo (..),     typeInfo,-    Conn (..),-    Database (..),-    connect,+    PersistenceException(..),+    WhereClauseExpr,+    Field,+    field,+    (&&.),+    (||.),+    (=.),+    (>.),+    (<.),+    (>=.),+    (<=.),+    (<>.),+    like,+    contains,+    between,+    in',+    isNull,+    not',+    sqlFun,+    allEntries,   ) where 

@@ -2,20 +2,28 @@   ( Conn (..),     connect,     Database (..),+    ConnectionPool,+    createConnPool,+    withResource,   ) where  import           Control.Monad ((>=>))-import           Database.HDBC hiding (withWConn)--{- | -  This module defines a wrapper around an HDBC IConnection. Using this wrapper `Conn` simplifies the signature of the functions in the `Database.GP` module.-  It allows to use any HDBC connection without having to define a new function for each connection type.-  It also provides additional attributes to the connection, like the database type and the implicit commit flag.-  These attributes can be used to implement database specific functionality, modify transaction behaviour, etc.+import           Data.Pool     (Pool, PoolConfig, defaultPoolConfig, newPool,+                                withResource)+import           Database.HDBC (IConnection (..)) -  This code has been inspired by the HDBC ConnectionWrapper and some parts have been copied from the HDBC Database.HDBC.Types module.--}+-- |+--  This module defines a wrapper around an HDBC IConnection.+--  Using this wrapper `Conn` simplifies the signature of the functions in the `Database.GP` module.+--  It allows to use any HDBC connection without having to define a new function for each connection type.+--  It also provides additional attributes to the connection, like the database type and the implicit commit flag.+--  These attributes can be used to implement database specific functionality, modify transaction behaviour, etc.+--+--  This code has been inspired by the HDBC ConnectionWrapper and some parts have been copied verbatim+--  from the HDBC Database.HDBC.Types module.+--+--  This module also defines a ConnectionPool type, which provides basic connection pooling functionality.  -- | A wrapper around an HDBC IConnection. data Conn = forall conn.@@ -37,10 +45,9 @@ connect :: forall conn. IConnection conn => Database -> conn -> Conn connect db = Conn db True --- | allows to execute a function that requires an `IConnection` argument on a `Conn`.      +-- | 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-      -- | manually implement the IConnection type class for the Conn type. instance IConnection Conn where@@ -59,3 +66,27 @@   dbTransactionSupport w = withWConn w dbTransactionSupport   getTables w = withWConn w getTables   describeTable w = withWConn w describeTable++-- | A pool of connections.+type ConnectionPool = Pool Conn++-- | Creates a connection pool.+createConnPool :: IConnection conn =>+  -- | the database type e.g. Postgres, MySQL, SQLite+  Database ->+  -- | the connection string+  String ->+  -- | a function that takes a connection string and returns an IConnection+  (String -> IO conn) ->+  -- | the time (in seconds) to keep idle connections open+  Double ->+  -- | the maximum number of connections to keep open+  Int ->+  -- | the resulting connection pool+  IO ConnectionPool+createConnPool db connectString connectFun idle numConns = newPool poolConfig+  where+    freshConnection :: IO Conn+    freshConnection = connect db <$> connectFun connectString+    poolConfig :: PoolConfig Conn+    poolConfig = defaultPoolConfig freshConnection disconnect idle numConns

@@ -10,7 +10,6 @@   ( Entity (..),     columnNameFor,     toString,-    EntityId,     gtoRow,     GToRow,     GFromRow,@@ -95,9 +94,6 @@   tableName = constructorName ti     where       ti = typeInfo @a---- | The EntityId is a tuple of the constructor name and the primary key value of an Entity.-type EntityId = (String, SqlValue)  -- | A convenience function: returns the name of the column for a field of a type 'a'. columnNameFor :: forall a. (Entity a) => String -> String

@@ -1,10 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# OPTIONS_GHC -Wno-orphans #-}- module Database.GP.GenericPersistence-  ( retrieveById,-    retrieveAll,-    retrieveAllWhere,+  ( selectById,+    select,     entitiesFromRows,     persist,     insert,@@ -12,79 +9,100 @@     update,     updateMany,     delete,+    deleteMany,     setupTableFor,     idValue,     Conn(..),     connect,     Database(..),+    ConnectionPool,+    createConnPool,+    withResource,     Entity (..),     GToRow,     GFromRow,     columnNameFor,     maybeFieldTypeFor,     toString,-    EntityId,-    entityId,     TypeInfo (..),     typeInfo,+    PersistenceException(..),+    WhereClauseExpr,+    Field,+    field,+    (&&.),+    (||.),+    (=.),+    (>.),+    (<.),+    (>=.),+    (<=.),+    (<>.),+    like,+    contains,+    between,+    in',  +    isNull,+    not',+    sqlFun,+    allEntries,+    byId,   ) where -import           Data.Convertible         (ConvertResult, Convertible)-import           Data.Convertible.Base    (Convertible (safeConvert))-import           Data.List                (elemIndex)+import           Control.Exception+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 qualified Database.GP.GenericPersistenceSafe as GpSafe import           Database.GP.SqlGenerator import           Database.GP.TypeInfo import           Database.HDBC-import Control.Monad (when) -{- | - This module defines RDBMS Persistence operations for Record Data Types that are instances of 'Data'.- I call instances of such a data type Entities.-- The Persistence operations are using Haskell generics to provide compile time reflection capabilities.- HDBC is used to access the RDBMS.--}+-- |+-- This module defines RDBMS Persistence operations for Record Data Types that are instances of 'Data'.+-- I call instances of such a data type Entities.+--+-- The Persistence operations are using Haskell generics to provide compile time reflection capabilities.+-- HDBC is used to access the RDBMS.  -- | A function that retrieves an entity from a database. -- The function takes entity id as parameter. -- If an entity with the given id exists in the database, it is returned as a Just value. -- If no such entity exists, Nothing is returned. -- An error is thrown if there are more than one entity with the given id.-retrieveById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> id -> IO (Maybe a)-retrieveById conn idx = do-  resultRowsSqlValues <- quickQuery conn stmt [eid]-  case resultRowsSqlValues of-    [] -> pure Nothing-    [singleRow] -> Just <$> fromRow conn singleRow-    _ -> error $ "More than one" ++ constructorName ti ++ " found for id " ++ show eid-  where-    ti = typeInfo @a-    stmt = selectStmtFor @a-    eid = toSql idx+selectById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> id -> IO (Maybe a)+selectById conn idx = do+  eitherExEntity <- GpSafe.selectById conn idx+  case eitherExEntity of+    Left (GpSafe.EntityNotFound _) -> pure Nothing+    Left ex                        -> throw ex+    Right entity                   -> pure $ Just entity  -- | This function retrieves all entities of type `a` from a database. --  The function takes an HDBC connection as parameter. --  The type `a` is determined by the context of the function call.-retrieveAll :: forall a. (Entity a) => Conn -> IO [a]-retrieveAll conn = do-  resultRows <- quickQuery conn stmt []-  entitiesFromRows conn resultRows-  where-    stmt = selectAllStmtFor @a+-- retrieveAll :: forall a. (Entity a) => Conn -> IO [a]+-- retrieveAll conn = do+--   eitherExRow <- GpSafe.retrieveAll @a conn+--   case eitherExRow of+--     Left ex    -> throw ex+--     Right rows -> pure rows --- | This function retrieves all entities of type `a` where a given field has a given value.---  The function takes an HDBC connection, the name of the field and the value 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.-retrieveAllWhere :: forall a. (Entity a) => Conn -> String -> SqlValue -> IO [a]-retrieveAllWhere conn field val = do-  resultRows <- quickQuery conn stmt [val]-  entitiesFromRows conn resultRows-  where-    stmt = selectAllWhereStmtFor @a field+-- | This function retrieves all entities of type `a` that match some query criteria.+--   The function takes an HDBC connection and a `WhereClauseExpr` as parameters.+--   The type `a` is determined by the context of the function call.+--   The function returns a (possibly empty) list of all matching entities.+--   The `WhereClauseExpr` is typically constructed using any tiny query dsl based on infix operators.+select :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO [a]+select conn whereClause = do+  eitherExEntities <- GpSafe.select @a conn whereClause+  case eitherExEntities of+    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.@@ -93,69 +111,57 @@ --   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 = mapM . fromRow+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+  eitherExUnit <- ioEitherExUnit+  case eitherExUnit of+    Left ex -> throw ex+    Right _ -> pure ()+ -- | 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 conn entity = do-  eid <- idValue conn entity-  resultRows <- quickQuery conn preparedSelectStmt [eid]-  case resultRows of-    []           -> insert conn entity-    [_singleRow] -> update conn entity-    _            -> error $ "More than one entity found for id " ++ show eid-  where-    preparedSelectStmt = selectStmtFor @a+persist = (fromEitherExUnit .) . GpSafe.persist  -- | A function that explicitely inserts an entity into a database. insert :: forall a. (Entity a) => Conn -> a -> IO ()-insert conn entity = do-  row <- toRow conn entity-  _rowcount <- run conn (insertStmtFor @a) row-  when (implicitCommit conn) $ commit conn+insert = (fromEitherExUnit .) . GpSafe.insert  -- | 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 conn entities = do-  rows <- mapM (toRow conn) entities-  stmt <- prepare conn (insertStmtFor @a)-  executeMany stmt rows-  when (implicitCommit conn) $ commit conn-  +insertMany = (fromEitherExUnit .) . GpSafe.insertMany  -- | A function that explicitely updates an entity in a database. update :: forall a. (Entity a) => Conn -> a -> IO ()-update conn entity = do-  eid <- idValue conn entity-  row <- toRow conn entity-  _rowcount <- run conn (updateStmtFor @a) (row ++ [eid])-  when (implicitCommit conn) $ commit conn+update = (fromEitherExUnit .) . 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 conn entities = do-  eids <- mapM (idValue conn) entities-  rows <- mapM (toRow conn) entities-  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+updateMany = (fromEitherExUnit .) . 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 conn entity = do-  eid <- idValue conn entity-  _rowCount <- run conn (deleteStmtFor @a) [eid]-  when (implicitCommit conn) $ commit conn+delete = (fromEitherExUnit .) . 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 ()@@ -164,16 +170,6 @@   runRaw conn $ createTableStmtFor @a (db conn)   when (implicitCommit conn) $ commit conn --- | Computes the EntityId of an entity.---   The EntityId of an entity is a (typeRep, idValue) tuple.---   The function takes an HDBC connection and an entity as parameters.-entityId :: forall a. (Entity a) => Conn -> a -> IO EntityId-entityId conn x = do-  eid <- idValue conn x-  return (tyName, eid)-  where-    tyName = constructorName (typeInfo @a)- -- | 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@@ -186,7 +182,7 @@ -- | 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 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 =@@ -200,13 +196,3 @@ expectJust :: String -> Maybe a -> a expectJust _ (Just x)  = x expectJust err Nothing = error ("expectJust " ++ err)---- | 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.-instance {-# OVERLAPS #-} forall a. (Enum a) => Convertible SqlValue a where-  safeConvert :: SqlValue -> ConvertResult a-  safeConvert = Right . toEnum . fromSql--instance {-# OVERLAPS #-} forall a. (Enum a) => Convertible a SqlValue where-  safeConvert :: a -> ConvertResult SqlValue-  safeConvert = Right . toSql . fromEnum

@@ -0,0 +1,293 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveAnyClass      #-}+{-# OPTIONS_GHC -Wno-orphans     #-}+{-# LANGUAGE LambdaCase          #-}++module Database.GP.GenericPersistenceSafe+  ( selectById,+    select,+    entitiesFromRows,+    persist,+    insert,+    insertMany,+    update,+    updateMany,+    delete,+    deleteMany,+    setupTableFor,+    idValue,+    Conn(..),+    connect,+    Database(..),+    ConnectionPool,+    createConnPool,+    withResource,+    Entity (..),+    GToRow,+    GFromRow,+    columnNameFor,+    maybeFieldTypeFor,+    toString,+    TypeInfo (..),+    typeInfo,+    PersistenceException(..),+    WhereClauseExpr,+    Field,+    field,+    (&&.),+    (||.),+    (=.),+    (>.),+    (<.),+    (>=.),+    (<=.),+    (<>.),+    like,+    contains,+    between,+    in',+    isNull,+    not',+    sqlFun,+    allEntries,+    byId,+  )+where++import           Control.Exception        (Exception, SomeException, try)+import           Control.Monad            (when)+import           Data.Convertible         (ConvertResult, Convertible)+import           Data.Convertible.Base    (Convertible (safeConvert))+import           Data.List                (elemIndex, isInfixOf)+import           Database.GP.Conn+import           Database.GP.Entity+import           Database.GP.SqlGenerator+import           Database.GP.TypeInfo+import           Database.HDBC++{- |+ This is the "safe" version of the module Database.GP.GenericPersistence. It uses Either to return errors.++ This module defines RDBMS Persistence operations for Record Data Types that are instances of 'Data'.+ I call instances of such a data type Entities.++ The Persistence operations are using Haskell generics to provide compile time reflection capabilities.+ HDBC is used to access the RDBMS.+-}++-- | exceptions that may occur during persistence operations+data PersistenceException =+    EntityNotFound String+  | DuplicateInsert String+  | DatabaseError String+  | NoUniqueKey String+  deriving (Show, Eq, Exception)++-- | A function that retrieves an entity from a database.+-- The function takes entity id as parameter.+-- If an entity with the given id exists in the database, it is returned as a Just value.+-- If no such entity exists, Nothing is returned.+-- 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+  eitherExResultRows <- try $ quickQuery conn stmt [eid]+  case eitherExResultRows of+    Left ex -> return $ Left $ fromException ex+    Right resultRowsSqlValues ->+      case resultRowsSqlValues of+        [] -> return $ Left $ EntityNotFound $ constructorName ti ++ " " ++ show eid ++ " not found"+        [singleRow] -> do+          eitherExEntity <- try $ fromRow conn singleRow+          case eitherExEntity of+            Left ex      -> return $ Left $ fromException ex+            Right entity -> return $ Right entity+        _ -> 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)+    eid = toSql idx++fromException :: SomeException -> PersistenceException+fromException ex = DatabaseError $ show ex+++-- | This function retrieves all entities of type `a` that match some query criteria.+--   The function takes an HDBC connection and a `WhereClauseExpr` as parameters.+--   The type `a` is determined by the context of the function call.+--   The function returns a (possibly empty) list of all matching entities.+--   The `WhereClauseExpr` is typically constructed using any tiny query dsl based on infix operators.+select :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO (Either PersistenceException [a])+select conn whereClause = do+  eitherExRows <- tryPE $ quickQuery conn stmt values+  case eitherExRows of+    Left ex          -> return $ Left ex+    Right resultRows -> entitiesFromRows conn resultRows+  where+    stmt = selectFromStmt @a whereClause+    values = whereClauseValues whereClause++-- | This function converts a list of database rows, represented as a `[[SqlValue]]` to a list of entities.+--   The function takes an HDBC connection and a list of database rows as parameters.+--   The type `a` is determined by the context of the function call.+--   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 (Either PersistenceException [a])+entitiesFromRows = (tryPE .) . mapM . fromRow++-- | 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 (Either PersistenceException ())+persist conn entity = do+  eitherExRes <- try $ do+    eid <- idValue conn entity+    let stmt = selectFromStmt @a (byId eid)+    --idValue conn entity >>= \eid ->+    quickQuery conn stmt [eid] >>=+      \case+        []           -> insert conn entity+        [_singleRow] -> update conn entity+        _            -> error $ "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 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+  case eitherExUnit of+    Left ex -> return $ Left $ handleDuplicateInsert ex+    Right _ -> return $ Right ()++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++tryPE :: IO a -> IO (Either PersistenceException a)+tryPE action = do+  eitherExResult <- try action+  case eitherExResult of+    Left ex      -> return $ Left $ fromException ex+    Right result -> return $ Right result++-- | 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 (Either PersistenceException ())+insertMany conn entities = do+  eitherExUnit <- try $ do+    rows <- mapM (toRow conn) entities+    stmt <- prepare conn (insertStmtFor @a)+    executeMany stmt rows+    when (implicitCommit conn) $ commit conn+  case eitherExUnit of+    Left ex -> return $ Left $ handleDuplicateInsert ex+    Right _ -> return $ Right ()+++-- | A function that explicitely updates an entity in a database.+update :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())+update conn entity = do+  eitherExUnit <- try $ do+    eid <- idValue conn entity+    row <- toRow conn entity+    rowcount <- run conn (updateStmtFor @a) (row ++ [eid])+    if rowcount == 0+      then return (Left (EntityNotFound (constructorName (typeInfo @a) ++ " " ++ show eid ++ " does not exist")))+      else do+        when (implicitCommit conn) $ commit conn+        return $ Right ()+  case eitherExUnit of+    Left ex      -> return $ Left $ fromException ex+    Right result -> return result++-- | 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 (Either PersistenceException ())+updateMany conn entities = tryPE $ do+  eids <- mapM (idValue conn) entities+  rows <- mapM (toRow conn) entities+  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++-- | 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 (Either PersistenceException ())+delete conn entity = do+  eitherExRes <- try $ do+    eid <- idValue conn entity+    rowCount <- run conn (deleteStmtFor @a) [eid]+    if rowCount == 0+      then return (Left (EntityNotFound (constructorName (typeInfo @a) ++ " " ++ show eid ++ " does not exist")))+      else do+        when (implicitCommit conn) $ commit conn+        return $ Right ()+  case eitherExRes of+    Left ex      -> return $ Left $ fromException ex+    Right result -> return result++-- | A function that deletes a list of entities from a database.+--   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 (Either PersistenceException ())+deleteMany conn entities = tryPE $ do+  eids <- mapM (idValue conn) entities+  stmt <- prepare conn (deleteStmtFor @a)+  executeMany stmt (map (: []) eids)+  when (implicitCommit conn) $ commit 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+  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++expectJust :: String -> Maybe a -> a+expectJust _ (Just x)  = x+expectJust err Nothing = error ("expectJust " ++ err)++-- | 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.+instance {-# OVERLAPS #-} forall a. (Enum a) => Convertible SqlValue a where+  safeConvert :: SqlValue -> ConvertResult a+  safeConvert = Right . toEnum . fromSql++instance {-# OVERLAPS #-} forall a. (Enum a) => Convertible a SqlValue where+  safeConvert :: a -> ConvertResult SqlValue+  safeConvert = Right . toSql . fromEnum

@@ -0,0 +1,166 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Database.GP.Query+  ( WhereClauseExpr,+    Field,+    field,+    whereClauseExprToSql,+    whereClauseValues,+    (&&.),+    (||.),+    (=.),+    (>.),+    (<.),+    (>=.),+    (<=.),+    (<>.),+    like,+    contains,+    between,+    in',+    isNull,+    not',+    params,+    sqlFun,+    allEntries,+    idColumn,+    byId,+  )+where++{--+  This module defines a DSL for building SQL SELECT WHERE clauses.+  The DSL provides query operators like =., >., <. for the most common SQL comparison operators.+  The DSL also provides the ability to combine WHERE clauses using the &&. and ||. operators.+  And to negate a where clause using the not' operator.+  The DSL is used in the `select` function of the Database.GP.GenericPersistence module.+  Example:+  thirtySomethings <- select conn (field "age" `between` (30 :: Int, 39 :: Int))+--}++import           Data.Convertible   (Convertible)+import           Data.List          (intercalate)+import           Database.GP.Entity (Entity, columnNameFor, idField)+import           Database.HDBC      (SqlValue, toSql)++data CompareOp = Eq | Gt | Lt | GtEq | LtEq | NotEq | Like | Contains+  deriving (Show, Eq)++data Field = Field [String] String+  deriving (Show, Eq)++data WhereClauseExpr+  = Where Field CompareOp SqlValue+  | WhereBetween Field (SqlValue, SqlValue)+  | WhereIn Field [SqlValue]+  | WhereIsNull Field+  | And WhereClauseExpr WhereClauseExpr+  | Or WhereClauseExpr WhereClauseExpr+  | Not WhereClauseExpr+  | All+  | ById SqlValue+  deriving (Show, Eq)++field :: String -> Field+field = Field []++getName :: Field -> String+getName (Field _fns n) = n++infixl 3 &&.++(&&.) :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr+(&&.) = And++infixl 2 ||.++(||.) :: WhereClauseExpr -> WhereClauseExpr -> WhereClauseExpr+(||.) = Or++infixl 4 =., >., <., >=., <=., <>., `like`, `between`, `in'`, `contains`++(=.), (>.), (<.), (>=.), (<=.), (<>.), like :: (Convertible b SqlValue) => Field -> b -> WhereClauseExpr+a =. b = Where a Eq (toSql b)+a >. b = Where a Gt (toSql b)+a <. b = Where a Lt (toSql b)+a >=. b = Where a GtEq (toSql b)+a <=. b = Where a LtEq (toSql b)+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)++in' :: (Convertible b SqlValue) => Field -> [b] -> WhereClauseExpr+a `in'` b = WhereIn a (map toSql b)++isNull :: Field -> WhereClauseExpr+isNull = WhereIsNull++not' :: WhereClauseExpr -> WhereClauseExpr+not' = Not++allEntries :: WhereClauseExpr+allEntries = All++byId :: (Convertible a SqlValue) => a -> WhereClauseExpr+byId = ById . toSql++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)++    opToSql :: CompareOp -> String+    opToSql Eq       = "="+    opToSql Gt       = ">"+    opToSql Lt       = "<"+    opToSql GtEq     = ">="+    opToSql LtEq     = "<="+    opToSql NotEq    = "<>"+    opToSql Like     = "LIKE"+    opToSql Contains = "CONTAINS"+whereClauseExprToSql (And e1 e2) = "(" ++ whereClauseExprToSql @a e1 ++ ") AND (" ++ whereClauseExprToSql @a e2 ++ ")"+whereClauseExprToSql (Or e1 e2) = "(" ++ whereClauseExprToSql @a e1 ++ ") OR (" ++ whereClauseExprToSql @a e2 ++ ")"+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 ++ ")"+  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 All = "1=1"+whereClauseExprToSql (ById _eid) = column ++ " = ?"+  where+    column = idColumn @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 ++ ")"++whereClauseValues :: WhereClauseExpr -> [SqlValue]+whereClauseValues (Where _ _ v) = [toSql v]+whereClauseValues (And e1 e2) = whereClauseValues e1 ++ whereClauseValues e2+whereClauseValues (Or e1 e2) = whereClauseValues e1 ++ whereClauseValues e2+whereClauseValues (Not e) = whereClauseValues e+whereClauseValues (WhereBetween _ (v1, v2)) = [toSql v1, toSql v2]+whereClauseValues (WhereIn _ v) = map toSql v+whereClauseValues (WhereIsNull _) = []+whereClauseValues All = []+whereClauseValues (ById eid) = [toSql eid]++params :: Int -> [String]+params n = replicate n "?"

@@ -3,22 +3,41 @@ module Database.GP.SqlGenerator   ( insertStmtFor,     updateStmtFor,-    selectStmtFor,+    selectFromStmt,     deleteStmtFor,-    selectAllStmtFor,-    selectAllWhereStmtFor,     createTableStmtFor,     dropTableStmtFor,+    WhereClauseExpr,+    Field,+    field,+    whereClauseValues,+    (&&.),+    (||.),+    (=.),+    (>.),+    (<.),+    (>=.),+    (<=.),+    (<>.),+    like,+    contains,+    between,+    in',+    isNull,+    not',+    sqlFun,+    allEntries,+    byId,   ) where  import           Data.List          (intercalate)-import           Database.GP.Entity+import Database.GP.Entity+import Database.GP.Query -{- | -  This module defines some basic SQL statements for Record Data Types that are instances of 'Entity'.-  The SQL statements are generated using Haskell generics to provide compile time reflection capabilities.--}+-- |+--  This module defines some basic SQL statements for Record Data Types that are instances of 'Entity'.+--  The SQL statements are generated using Haskell generics to provide compile time reflection capabilities.  -- | A function that returns an SQL insert statement for an entity. Type 'a' must be an instance of Data. -- The function will use the field names of the data type to generate the column names in the insert statement.@@ -41,9 +60,6 @@   where     fieldColumnPairs = fieldsToColumns @a -params :: Int -> [String]-params n = replicate n "?"- -- | A function that returns an SQL update statement for an entity. Type 'a' must be an instance of Entity. updateStmtFor :: forall a. (Entity a) => String updateStmtFor =@@ -58,40 +74,18 @@   where     updatePairs = map (++ " = ?") (columnNamesFor @a) -idColumn :: forall a. (Entity a) => String-idColumn = columnNameFor @a (idField @a)---- | A function that returns an SQL select statement for entity type `a` with primary key `id`.-selectStmtFor :: forall a. (Entity a) => String-selectStmtFor =+-- | A function that returns an SQL select statement for an entity. Type 'a' must be an instance of Entity.+--   The function takes a where clause expression as parameter. This expression is used to filter the result set.+selectFromStmt :: forall a. (Entity a) => WhereClauseExpr -> String+selectFromStmt whereClauseExpr =   "SELECT "     ++ intercalate ", " (columnNamesFor @a)     ++ " FROM "     ++ tableName @a     ++ " WHERE "-    ++ idColumn @a-    ++ " = ?;"--selectAllStmtFor :: forall a. (Entity a) => String-selectAllStmtFor =-  "SELECT "-    ++ intercalate ", " (columnNamesFor @a)-    ++ " FROM "-    ++ tableName @a+    ++ whereClauseExprToSql @a whereClauseExpr     ++ ";" -selectAllWhereStmtFor :: forall a. (Entity a) => String -> String-selectAllWhereStmtFor field =-  "SELECT "-    ++ intercalate ", " (columnNamesFor @a)-    ++ " FROM "-    ++ tableName @a-    ++ " WHERE "-    ++ column-    ++ " = ?;"-  where-    column = columnNameFor @a field- deleteStmtFor :: forall a. (Entity a) => String deleteStmtFor =   "DELETE FROM "@@ -114,7 +108,7 @@ -- | A function that returns the column type for a field of an entity. -- TODO: Support other databases than just SQLite. columnTypeFor :: forall a. (Entity a) => Database -> String -> String-columnTypeFor SQLite field =+columnTypeFor SQLite fieldName =   case fType of     "Int"    -> "INTEGER"     "String" -> "TEXT"@@ -123,7 +117,7 @@     "Bool"   -> "INT"     _        -> "TEXT"   where-    maybeFType = maybeFieldTypeFor @a field+    maybeFType = maybeFieldTypeFor @a fieldName     fType = maybe "OTHER" show maybeFType columnTypeFor other _ = error $ "Schema creation for " ++ show other ++ " not implemented yet" 

@@ -0,0 +1,70 @@+-- allows automatic derivation from Entity type class+{-# LANGUAGE DeriveAnyClass #-}++module DemoSpec+  ( test,+    spec,+  )+where++import           Database.GP           (Database (SQLite), Entity, allEntries,+                                        connect, delete, insert, select,+                                        selectById, setupTableFor, update)+import           Database.HDBC         (disconnect)+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++-- | An Entity data type with several fields, using record syntax.+data Person = Person+  { personID :: Int,+    name     :: String,+    age      :: Int,+    address  :: String+  }+  deriving (Generic, Entity, Show) -- deriving Entity allows us to use the GenericPersistence API++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"++      -- initialize Person table+      setupTableFor @Person 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,+      -- as `selectById` has a polymorphic return type `IO (Maybe a)`.+      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++      -- 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]+      print allPersons'++      -- close connection+      disconnect conn

@@ -13,7 +13,8 @@ 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)+-- 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 @@ -83,7 +84,7 @@     it "works like a charm" $ do       conn <- prepareDB       insert conn article-      article' <- retrieveById conn "1" :: IO (Maybe Article)+      article' <- selectById conn "1" :: IO (Maybe Article)       article' `shouldBe` Just article-      allArticles <- retrieveAll conn :: IO [Article]+      allArticles <- select conn allEntries :: IO [Article]       allArticles `shouldBe` [article]

@@ -14,7 +14,8 @@ 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)+-- 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 @@ -49,5 +50,5 @@       conn <- prepareDB       let book = Book 1 "The Hobbit" "J.R.R. Tolkien" 1937 Fiction       insert conn book-      allBooks <- retrieveAll conn :: IO [Book]+      allBooks <- select conn allEntries :: IO [Book]       allBooks `shouldBe` [book]

@@ -0,0 +1,97 @@+-- allows automatic derivation from Entity type class+{-# LANGUAGE DeriveAnyClass #-}++module ExceptionsSpec+  ( test,+    spec,+  )+where++import           Database.GP.GenericPersistenceSafe+import           Database.HDBC.Sqlite3+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 SQLite <$> connectSqlite3 ":memory:"+  setupTableFor @Article conn+  return conn++data Article = Article+  { articleID :: Int,+    title     :: String,+    year      :: Int+  }+  deriving (Generic, Entity, Show, Eq)++yearField :: Field+yearField = field "year"++article :: Article+article = Article 1 "The Hitchhiker's Guide to the Galaxy" 1979++expectationSuccess :: IO ()+expectationSuccess = return ()++spec :: Spec+spec = do+  describe "Exception Handling" $ do+    it "detects duplicate inserts" $ do+      conn <- prepareDB+      _ <- insert conn article+      eitherExRes <- insert conn article :: IO (Either PersistenceException ())+      case eitherExRes of+        Left (DuplicateInsert _) -> expectationSuccess+        _                        -> 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"        +    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"+    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"+    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"+    it "detects general backend issues" $ do+      conn <- connect SQLite <$> connectSqlite3 ":memory:"+      eitherExRes <- update conn article :: IO (Either PersistenceException ())+      case eitherExRes of+        Left (DatabaseError _) -> expectationSuccess+        _                      -> expectationFailure "Expected DatabaseError exception"+    it "has no leaking backend exceptions" $ do+      conn <- connect SQLite <$> connectSqlite3 ":memory:"+      _ <- update conn article :: IO (Either PersistenceException ())+      _ <- insert conn article :: IO (Either PersistenceException ())+      _ <- persist conn article :: IO (Either PersistenceException ())+      _ <- delete conn article :: IO (Either PersistenceException ())+      _ <- selectById conn "1" :: IO (Either PersistenceException Article)+      _ <- select conn allEntries :: IO (Either PersistenceException [Article])+      _ <- select conn (yearField =. "2023")  :: IO (Either PersistenceException [Article])+      _ <- insertMany conn [article] :: IO (Either PersistenceException ())+      _ <- updateMany conn [article] :: IO (Either PersistenceException ())+      _ <- deleteMany conn [article] :: IO (Either PersistenceException ())++      expectationSuccess

@@ -14,7 +14,8 @@ 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)+-- 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 @@ -34,6 +35,13 @@   }   deriving (Generic, Entity, Show, Eq) +nameField :: Field+nameField = field "name"+ageField :: Field+ageField = field "age"+addressField :: Field+addressField = field "address"+ data Book = Book   { book_id  :: Int,     title    :: String,@@ -48,7 +56,8 @@  instance Entity Book where   idField = "book_id"-  fieldsToColumns = [("book_id", "bookId"), ("title", "bookTitle"), ("author", "bookAuthor"), ("year", "bookYear"), ("category", "bookCategory")]+  fieldsToColumns = [("book_id", "bookId"), ("title", "bookTitle"), ("author", "bookAuthor"), +                     ("year", "bookYear"), ("category", "bookCategory")]   tableName = "BOOK_TBL"   fromRow _c row = pure $ Book (col 0) (col 1) (col 2) (col 3) (col 4)     where@@ -73,6 +82,12 @@ 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@@ -82,10 +97,10 @@       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\");"-      allPersons <- retrieveAll conn :: IO [Person]+      allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 3       head allPersons `shouldBe` bob-      person' <- retrieveById conn (1 :: Int) :: IO (Maybe Person)+      person' <- selectById conn (1 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just bob     it "retrieves Entities using user implementation" $ do       conn <- prepareDB@@ -93,110 +108,166 @@       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);"-      allBooks <- retrieveAll conn :: IO [Book]+      allBooks <- select conn allEntries :: IO [Book]       length allBooks `shouldBe` 3       head allBooks `shouldBe` hobbit-      book' <- retrieveById conn (1 :: Int) :: IO (Maybe Book)+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just hobbit+    it "retrieves Entities using a simple Query DSL" $ 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]+      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 <- retrieveAll conn :: IO [Person]+      allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0       persist conn person-      allPersons' <- retrieveAll conn :: IO [Person]+      allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 1-      person' <- retrieveById conn (123456 :: Int) :: IO (Maybe Person)+      person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just person     it "persists new Entities using user implementation" $ do       conn <- prepareDB-      allbooks <- retrieveAll conn :: IO [Book]+      allbooks <- select conn allEntries :: IO [Book]       length allbooks `shouldBe` 0       persist conn book-      allbooks' <- retrieveAll conn :: IO [Book]+      allbooks' <- select conn allEntries :: IO [Book]       length allbooks' `shouldBe` 1-      book' <- retrieveById conn (1 :: Int) :: IO (Maybe Book)+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book     it "persists existing Entities using Generics" $ do       conn <- prepareDB-      allPersons <- retrieveAll conn :: IO [Person]+      allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0       persist conn person-      allPersons' <- retrieveAll conn :: IO [Person]+      allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 1       persist conn person {age = 26}-      person' <- retrieveById conn (123456 :: Int) :: IO (Maybe Person)+      person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just person {age = 26}     it "persists existing Entities using user implementation" $ do       conn <- prepareDB-      allbooks <- retrieveAll conn :: IO [Book]+      allbooks <- select conn allEntries :: IO [Book]       length allbooks `shouldBe` 0       persist conn book-      allbooks' <- retrieveAll conn :: IO [Book]+      allbooks' <- select conn allEntries :: IO [Book]       length allbooks' `shouldBe` 1       persist conn book {year = 1938}-      book' <- retrieveById conn (1 :: Int) :: IO (Maybe Book)+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book {year = 1938}     it "inserts Entities using Generics" $ do       conn <- prepareDB-      allPersons <- retrieveAll conn :: IO [Person]+      allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0       insert conn person-      allPersons' <- retrieveAll conn :: IO [Person]+      allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 1-      person' <- retrieveById conn (123456 :: Int) :: IO (Maybe Person)+      person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just person     it "inserts many Entities re-using a single prepared stmt" $ do       conn <- prepareDB-      allPersons <- retrieveAll conn :: IO [Person]+      allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0       insertMany conn manyPersons-      allPersons' <- retrieveAll conn :: IO [Person]+      allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 6     it "updates many Entities re-using a single prepared stmt" $ do       conn <- prepareDB-      allPersons <- retrieveAll conn :: IO [Person]+      allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0       insertMany conn manyPersons-      allPersons' <- retrieveAll conn :: IO [Person]+      allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 6       let manyPersons' = map (\p -> p {name = "Bob"}) manyPersons       updateMany conn manyPersons'-      allPersons'' <- retrieveAll conn :: IO [Person]+      allPersons'' <- select conn allEntries :: IO [Person]       all (\p -> name p == "Bob") allPersons'' `shouldBe` True+    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+      allPersons' <- select conn allEntries :: IO [Person]+      length allPersons' `shouldBe` 6   +      deleteMany conn allPersons'+      allPersons'' <- select conn allEntries :: IO [Person]+      length allPersons'' `shouldBe` 0+     it "inserts Entities using user implementation" $ do       conn <- prepareDB-      allbooks <- retrieveAll conn :: IO [Book]+      allbooks <- select conn allEntries :: IO [Book]       length allbooks `shouldBe` 0       insert conn book-      allbooks' <- retrieveAll conn :: IO [Book]+      allbooks' <- select conn allEntries :: IO [Book]       length allbooks' `shouldBe` 1-      book' <- retrieveById conn (1 :: Int) :: IO (Maybe Book)+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book     it "updates Entities using Generics" $ do       conn <- prepareDB       insert conn person       update conn person {name = "Bob"}-      person' <- retrieveById conn (123456 :: Int) :: IO (Maybe Person)+      person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)       person' `shouldBe` Just person {name = "Bob"}     it "updates Entities using user implementation" $ do       conn <- prepareDB       insert conn book       update conn book {title = "The Lord of the Rings"}-      book' <- retrieveById conn (1 :: Int) :: IO (Maybe Book)+      book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book {title = "The Lord of the Rings"}     it "deletes Entities using Generics" $ do       conn <- prepareDB       insert conn person-      allPersons <- retrieveAll conn :: IO [Person]+      allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 1       delete conn person-      allPersons' <- retrieveAll conn :: IO [Person]+      allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 0     it "deletes Entities using user implementation" $ do       conn <- prepareDB       insert conn book-      allBooks <- retrieveAll conn :: IO [Book]+      allBooks <- select conn allEntries :: IO [Book]       length allBooks `shouldBe` 1       delete conn book-      allBooks' <- retrieveAll conn :: IO [Book]+      allBooks' <- select conn allEntries :: IO [Book]       length allBooks' `shouldBe` 0+    it "provides a Connection Pool" $ do+      connPool <- sqlLitePool ":memory:" +      withResource connPool $ \conn -> do+        setupTableFor @Person 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

@@ -15,7 +15,8 @@ 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)+-- 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 @@ -53,7 +54,7 @@   fromRow :: Conn -> [SqlValue] -> IO Author   fromRow conn row = do     let authID = head row                                 -- authorID is the first column-    articlesBy <- retrieveAllWhere conn "authorId" authID -- retrieve all articles by this author+    articlesBy <- select 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)@@ -111,12 +112,12 @@       insert conn arthur       insert conn article1 -      authors <- retrieveAll conn :: IO [Author]+      authors <- select conn allEntries :: IO [Author]       length authors `shouldBe` 1 -      articles' <- retrieveAll conn :: IO [Article]+      articles' <- select conn allEntries :: IO [Article]       length articles' `shouldBe` 3 -      author2 <- retrieveById conn "2" :: IO (Maybe Author)+      author2 <- selectById conn "2" :: IO (Maybe Author)       fromJust author2 `shouldBe` arthur       length (articles $ fromJust author2) `shouldBe` 2

@@ -15,7 +15,8 @@ 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)+-- 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 @@ -52,7 +53,7 @@    fromRow :: Conn -> [SqlValue] -> IO Article   fromRow conn row = do    -    authorById <- fromJust <$> retrieveById conn (row !! 2)  -- load author by foreign key+    authorById <- fromJust <$> selectById conn (row !! 2)  -- load author by foreign key     return $ rawArticle {author = authorById}                -- add author to article     where       rawArticle = Article (col 0) (col 1)                   -- create article from row, @@ -92,8 +93,8 @@       conn <- prepareDB       insert conn article -      author' <- retrieveById conn "2" :: IO (Maybe Author)+      author' <- selectById conn "2" :: IO (Maybe Author)       author' `shouldBe` Just arthur -      article' <- retrieveById conn "1" :: IO (Maybe Article)+      article' <- selectById conn "1" :: IO (Maybe Article)       article' `shouldBe` Just article