packages feed

generic-persistence 0.5.0 → 0.6.0

raw patch · 19 files changed

+186/−143 lines, 19 filesdep ~HDBCdep ~HDBC-postgresqldep ~HDBC-sqlite3PVP ok

version bump matches the API change (PVP)

Dependency ranges changed: HDBC, HDBC-postgresql, HDBC-sqlite3, QuickCheck, convertible, generic-deriving, hspec, hspec-discover, raw-strings-qq, resource-pool, template-haskell

API changes (from Hackage documentation)

- Database.GP: insertReturning :: forall a. Entity a => Conn -> a -> IO a
- Database.GP.GenericPersistence: insertReturning :: forall a. Entity a => Conn -> a -> IO a
- Database.GP.GenericPersistenceSafe: insertReturning :: forall a. Entity a => Conn -> a -> IO (Either PersistenceException a)
+ Database.GP: autoIncrement :: Entity a => Bool
+ Database.GP.Entity: autoIncrement :: Entity a => Bool
+ Database.GP.Entity: fieldIndex :: forall a. Entity a => String -> Int
+ Database.GP.Entity: maybeIdFieldIndex :: forall a. Entity a => Maybe Int
+ Database.GP.GenericPersistence: autoIncrement :: Entity a => Bool
+ Database.GP.GenericPersistenceSafe: autoIncrement :: Entity a => Bool
- Database.GP: insert :: forall a. Entity a => Conn -> a -> IO ()
+ Database.GP: insert :: forall a. Entity a => Conn -> a -> IO a
- Database.GP.GenericPersistence: insert :: forall a. Entity a => Conn -> a -> IO ()
+ Database.GP.GenericPersistence: insert :: forall a. Entity a => Conn -> a -> IO a
- Database.GP.GenericPersistenceSafe: insert :: forall a. Entity a => Conn -> a -> IO (Either PersistenceException ())
+ Database.GP.GenericPersistenceSafe: insert :: forall a. Entity a => Conn -> a -> IO (Either PersistenceException a)

Files

README.md view
@@ -55,6 +55,11 @@ As of now there is full support for SQLite and PostgreSQL.  Support for other databases will be implemented on demand. +### new features in v0.6+- Autoincrement flag for primary keys can now defined per Entity+- insert now always returns the inserted entity (thus insertReturning was removed)+- insertMany now also respects handling of primary keys+ ### new features in v0.5  - support for PostgreSQL@@ -119,27 +124,24 @@   -- initialize Person table   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+  alice <- insert conn Person {name = "Alice", age = 25, address = "Elmstreet 1"}+  print alice    -- update a Person   update conn alice {address = "Main Street 200"} -  -- select a Person from a database+  -- select a Person by id   -- 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 (personID alice)   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))+  -- 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@@ -236,6 +238,9 @@    -- | Returns the name of the table for a type 'a'.   tableName :: String++  -- | Returns True if the primary key field for a type 'a' is autoincremented by the database.+  autoIncrement :: Bool ```  ### Default Behaviour@@ -249,6 +254,8 @@ - `tableName` returns the name of the database table used for type `a`. The default implementation simply returns the constructor name of `a`. E.g. `tableName @Book` will return `"Book"`.  - `fieldsToColumns` returns a list of tuples that map field names of type `a` to database column names for a type. The default implementation simply returns a list of tuples that map the field names of `a` to the field names of `a`. E.g. `fieldsToColumns @Person` will return `[("personID","personID"),("name","name"),("age","age"),("address","address")]`.++- `autoIncrement` returns `True` by default. This means that the primary key field of a type `a` is assumed to be autoincremented by the database. If this is not the case, you can override the default implementation to return `False`.  `fromRow` and `toRow` are used to convert between Haskell types and database rows.  
generic-persistence.cabal view
@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               generic-persistence-version:            0.5.0+version:            0.6.0 license:            BSD3 license-file:       LICENSE copyright:          2023 Thomas Mahler@@ -45,13 +45,13 @@         -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints      build-depends:-        HDBC <2.5,+        HDBC >=2.4.0.4 && <2.5,         base >=4.7 && <5,-        convertible <1.2,-        generic-deriving <1.15,-        raw-strings-qq <1.2,-        resource-pool <0.5,-        template-haskell <2.19+        convertible >=1.1.1.1 && <1.2,+        generic-deriving >=1.14.3 && <1.15,+        raw-strings-qq >=1.1 && <1.2,+        resource-pool >=0.4.0.0 && <0.5,+        template-haskell >=2.18.0.0 && <2.19  test-suite generic-persistence-test     type:               exitcode-stdio-1.0@@ -85,16 +85,16 @@         -threaded -rtsopts -with-rtsopts=-N      build-depends:-        HDBC <2.5,-        HDBC-postgresql <2.6,-        HDBC-sqlite3 <2.4,-        QuickCheck <2.15,+        HDBC >=2.4.0.4 && <2.5,+        HDBC-postgresql >=2.5.0.1 && <2.6,+        HDBC-sqlite3 >=2.3.3.1 && <2.4,+        QuickCheck >=2.14.2 && <2.15,         base >=4.7 && <5,-        convertible <1.2,-        generic-deriving <1.15,+        convertible >=1.1.1.1 && <1.2,+        generic-deriving >=1.14.3 && <1.15,         generic-persistence,-        hspec <2.10,-        hspec-discover <2.10,-        raw-strings-qq <1.2,-        resource-pool <0.5,-        template-haskell <2.19+        hspec >=2.9.7 && <2.10,+        hspec-discover >=2.9.7 && <2.10,+        raw-strings-qq >=1.1 && <1.2,+        resource-pool >=0.4.0.0 && <0.5,+        template-haskell >=2.18.0.0 && <2.19
src/Database/GP.hs view
@@ -5,7 +5,6 @@     sql,     persist,     insert,-    insertReturning,     insertMany,     update,     updateMany,
src/Database/GP/Entity.hs view
@@ -15,6 +15,8 @@     maybeFieldTypeFor,     Conn(..),     TxHandling(..),+    maybeIdFieldIndex,+    fieldIndex,   ) where @@ -27,6 +29,7 @@ import           GHC.Generics import           GHC.TypeNats import           Database.GP.Conn+import Data.List (elemIndex)  {- | This is the Entity class. It is a type class that is used to define the mapping between a Haskell product type in record notation and a database table.@@ -66,6 +69,9 @@   -- | Returns the name of the table for a type 'a'.   tableName :: String +  -- | Returns True if the primary key field for a type 'a' is autoincremented by the database.+  autoIncrement :: Bool+   -- | fromRow generic default implementation   default fromRow :: (GFromRow (Rep a)) => Conn -> [SqlValue] -> IO a   fromRow _conn = pure . to <$> gfromRow@@ -77,11 +83,7 @@   -- | idField default implementation: the ID field is the field with the same name   --   as the type name in lower case and appended with "ID", e.g. "bookID"   default idField :: String-  idField = idFieldName-    where-      idFieldName :: String-      idFieldName = map toLower (constructorName ti) ++ "ID"-      ti = typeInfo @a+  idField = map toLower (constructorName (typeInfo @a)) ++ "ID"    -- | fieldsToColumns default implementation: the field names are used as column names   default fieldsToColumns :: [(String, String)]@@ -89,9 +91,34 @@    -- | tableName default implementation: the type name is used as table name   default tableName :: String-  tableName = constructorName ti-    where-      ti = typeInfo @a+  tableName = constructorName (typeInfo @a)++  -- | autoIncrement default implementation: the ID field is autoincremented+  default autoIncrement :: Bool+  autoIncrement = True++-- | Returns Just index of the primary key field for a type 'a'.+--   if the type has no primary key field, Nothing is returned.+maybeIdFieldIndex :: forall a. (Entity a) => Maybe Int+maybeIdFieldIndex = elemIndex (idField @a) (fieldNames (typeInfo @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)  -- | A convenience function: returns the name of the column for a field of a type 'a'. columnNameFor :: forall a. (Entity a) => String -> String
src/Database/GP/GenericPersistence.hs view
@@ -6,7 +6,6 @@     sql,     persist,     insert,-    insertReturning,     insertMany,     update,     updateMany,@@ -132,11 +131,8 @@ persist = (fromEitherExOrA .) . GpSafe.persist  -- | A function that explicitely inserts an entity into a database.-insert :: forall a. (Entity a) => Conn -> a -> IO ()+insert :: forall a. (Entity a) => Conn -> a -> IO a 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.
src/Database/GP/GenericPersistenceSafe.hs view
@@ -10,7 +10,6 @@     sql,     persist,     insert,-    insertReturning,     insertMany,     update,     updateMany,@@ -64,7 +63,7 @@ import           Control.Monad            (when) import           Data.Convertible         (ConvertResult, Convertible) import           Data.Convertible.Base    (Convertible (safeConvert))-import           Data.List                (elemIndex, isInfixOf)+import           Data.List                (isInfixOf) import           Database.GP.Conn import           Database.GP.Entity import           Database.GP.SqlGenerator@@ -156,7 +155,7 @@     let stmt = selectFromStmt @a byIdColumn     quickQuery conn stmt [eid] >>=       \case-        []           -> insert conn entity+        []           -> insert conn entity >> return (Right ())         [_singleRow] -> update conn entity         _            -> return $ Left $ NoUniqueKey $ "More than one entity found for id " ++ show eid   case eitherExRes of@@ -169,29 +168,25 @@ 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 :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException a) insert conn entity = do-  eitherExUnit <- try $ do+  eitherExOrA <- try $ do     row <- toRow conn entity-    _rowcount <- run conn (insertStmtFor @a) row+    [singleRow] <- quickQuery' conn (insertReturningStmtFor @a) (removeIdField @a row)     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+    fromRow @a conn singleRow+  case eitherExOrA of     Left ex -> return $ Left $ handleDuplicateInsert ex     Right a -> return $ Right a     +removeIdField :: forall a. (Entity a) => [SqlValue] -> [SqlValue]+removeIdField row =+  if autoIncrement @a+    then case maybeIdFieldIndex @a of+      Nothing      -> row+      Just idIndex -> take idIndex row ++ drop (idIndex + 1) row+    else row+ handleDuplicateInsert :: SomeException -> PersistenceException handleDuplicateInsert ex =    if "UNIQUE constraint failed" `isInfixOf` show ex ||@@ -214,7 +209,7 @@   eitherExUnit <- try $ do     rows <- mapM (toRow conn) entities     stmt <- prepare conn (insertStmtFor @a)-    executeMany stmt rows+    executeMany stmt (map (removeIdField @a) rows)     commitIfAutoCommit conn   case eitherExUnit of     Left ex -> return $ Left $ handleDuplicateInsert ex@@ -294,24 +289,6 @@   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)  -- an alias for a simple quasiqouter sql :: QuasiQuoter
src/Database/GP/SqlGenerator.hs view
@@ -57,12 +57,15 @@   "INSERT INTO "     ++ tableName @a     ++ " ("-    ++ intercalate ", " columns+    ++ intercalate ", " insertColumns     ++ ") VALUES ("-    ++ intercalate ", " (params (length columns))+    ++ intercalate ", " (params (length insertColumns))     ++ ");"   where     columns = columnNamesFor @a+    insertColumns = if autoIncrement @a +                  then filter (/= idColumn @a) columns +                  else columns  insertReturningStmtFor :: forall a. Entity a => String insertReturningStmtFor =@@ -77,8 +80,10 @@     ++ ";"   where     columns = columnNamesFor @a  -    insertColumns = filter (/= idColumn @a) columns -    returnColumns = intercalate ", " columns -- ++ ")" +    insertColumns = if autoIncrement @a +                      then filter (/= idColumn @a) columns +                      else columns+    returnColumns = intercalate ", " columns   columnNamesFor :: forall a. Entity a => [String]@@ -132,16 +137,24 @@     ++ intercalate ", " (map (\(f, c) -> c ++ " " ++ columnTypeFor @a dbServer f ++ optionalPK f) (fieldsToColumns @a))     ++ ");"   where-    isIdField f = f == idField @a-    optionalPK f = if isIdField f then " PRIMARY KEY" else ""+    optionalPK f = if isIdField @a f +                    then case dbServer of+                      SQLite   -> " PRIMARY KEY AUTOINCREMENT"+                      Postgres -> " PRIMARY KEY"+                    else "" +isIdField :: forall a. (Entity a) => String -> Bool+isIdField f = f == idField @a+ -- | A function that returns the column type for a field of an entity. -- TODO: Support other databases than just SQLite and Postgres. columnTypeFor :: forall a. (Entity a) => Database -> String -> String columnTypeFor dbDialect fieldName =   case dbDialect of     SQLite   -> columnTypeForSQLite fType-    Postgres -> columnTypeForPostgres fType+    Postgres -> if isIdField @a fieldName +                  then "serial"+                  else columnTypeForPostgres fType   where     maybeFType = maybeFieldTypeFor @a fieldName     fType = maybe "OTHER" show maybeFType
test/ConnSpec.hs view
@@ -50,7 +50,7 @@       let conn' = conn{implicitCommit=False}       let article = Article 1 "Hello" 2023       -      insert conn' article+      _ <- insert conn' article       allArticles <- select conn' allEntries :: IO [Article]       allArticles `shouldBe` [article]       rollback conn'@@ -59,7 +59,8 @@      it "provide the IConnection methods" $ do       conn <- prepareDB-      getTables conn `shouldReturn` ["Article"]+      allTables <- getTables conn +      allTables `shouldContain` ["Article"]        desc <- describeTable conn "Article"        length desc `shouldBe` 3
test/DemoSpec.hs view
@@ -1,5 +1,4 @@--- allows automatic derivation from Entity type class-{-# LANGUAGE DeriveAnyClass #-}+{-# OPTIONS_GHC -Wno-missing-fields #-}  module DemoSpec   ( test,@@ -28,8 +27,8 @@   }   deriving (Generic, Entity, Show) -- deriving Entity allows us to use the GenericPersistence API ---print :: Show a => a -> IO ()---print = putStrLn . show+-- print :: Show a => a -> IO ()+-- print = putStrLn . show  print :: a -> IO () print _ = pure ()@@ -44,19 +43,16 @@       -- initialize Person table       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+      alice <- insert conn Person {name = "Alice", age = 25, address = "Elmstreet 1"}+      print alice        -- update a Person       update conn alice {address = "Main Street 200"} -      -- select a Person from a database+      -- select a Person by id       -- 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 (personID alice)       print alice'        -- select all Persons from a database. again, the result type must be provided.@@ -64,7 +60,7 @@       print allPersons        -- select all Persons from a database, where age is smaller 30.-      allPersonsUnder30 <- select @Person conn ((field "age") <. (30 :: Int))+      allPersonsUnder30 <- select @Person conn (field "age" <. (30 :: Int))       print allPersonsUnder30        -- delete a Person from a database
test/EmbeddedSpec.hs view
@@ -83,7 +83,7 @@   describe "Handling of Embedded Objects" $ do     it "works like a charm" $ do       conn <- prepareDB-      insert conn article+      _ <- insert conn article       article' <- selectById conn "1" :: IO (Maybe Article)       article' `shouldBe` Just article       allArticles <- select conn allEntries :: IO [Article]
test/EnumSpec.hs view
@@ -49,6 +49,6 @@     it "works like a charm" $ do       conn <- prepareDB       let book = Book 1 "The Hobbit" "J.R.R. Tolkien" 1937 Fiction-      insert conn book+      _ <- insert conn book       allBooks <- select conn allEntries :: IO [Book]       allBooks `shouldBe` [book]
test/ExceptionsSpec.hs view
@@ -31,8 +31,11 @@     title     :: String,     year      :: Int   }-  deriving (Generic, Entity, Show, Eq)+  deriving (Generic, Show, Eq) +instance Entity Article where+  autoIncrement = False+ data Bogus = Bogus   { bogusID :: Int,     bogusTitle :: String,@@ -43,6 +46,7 @@ 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"),@@ -69,7 +73,7 @@     it "detects duplicate inserts" $ do       conn <- prepareDB       _ <- insert conn article-      eitherExRes <- insert conn article :: IO (Either PersistenceException ())+      eitherExRes <- insert conn article :: IO (Either PersistenceException Article)       case eitherExRes of         Left di@(DuplicateInsert _msg) -> show di `shouldContain` "Entity already exists"         _                          -> expectationFailure "Expected DuplicateInsert exception"@@ -136,7 +140,7 @@     it "has no leaking backend exceptions" $ do       conn <- connect AutoCommit <$> connectSqlite3 ":memory:"       _ <- update conn article :: IO (Either PersistenceException ())-      _ <- insert conn article :: IO (Either PersistenceException ())+      _ <- insert conn article :: IO (Either PersistenceException Article)       _ <- persist conn article :: IO (Either PersistenceException ())       _ <- delete conn article :: IO (Either PersistenceException ())       _ <- selectById conn "1" :: IO (Either PersistenceException Article)
test/GenericPersistenceSpec.hs view
@@ -35,8 +35,11 @@     age      :: Int,     address  :: String   }-  deriving (Generic, Entity, Show, Eq)+  deriving (Generic, Show, Eq) +instance Entity Person where+  autoIncrement = False + data Car = Car   { carID :: Int,     carType  :: String@@ -193,7 +196,7 @@       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0-      insert conn person+      _ <-  insert conn person       allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 1       person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)@@ -201,7 +204,7 @@     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@(Car carId _) <- insert 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@@ -237,26 +240,26 @@       conn <- prepareDB       allbooks <- select conn allEntries :: IO [Book]       length allbooks `shouldBe` 0-      insert conn book+      _ <- insert conn book       allbooks' <- select conn allEntries :: IO [Book]       length allbooks' `shouldBe` 1       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)       book' `shouldBe` Just book     it "updates Entities using Generics" $ do       conn <- prepareDB-      insert conn person+      _ <- insert conn person       update conn person {name = "Bob"}       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+      _ <- insert conn book       update conn book {title = "The Lord of the Rings"}       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+      _ <- insert conn person       allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 1       delete conn person@@ -264,7 +267,7 @@       length allPersons' `shouldBe` 0     it "deletes Entities using user implementation" $ do       conn <- prepareDB-      insert conn book+      _ <- insert conn book       allBooks <- select conn allEntries :: IO [Book]       length allBooks `shouldBe` 1       delete conn book@@ -274,7 +277,7 @@       connPool <- sqlLitePool ":memory:"        withResource connPool $ \conn -> do         setupTableFor @Person SQLite conn-        insert conn person+        _ <- insert conn person         allPersons <- select conn allEntries :: IO [Person]         length allPersons `shouldBe` 1 
test/OneToManySafeSpec.hs view
@@ -33,8 +33,11 @@     authorId  :: Int,     year      :: Int   }-  deriving (Generic, Entity, Show, Eq) -- automatically derives Entity+  deriving (Generic, Show, Eq) +instance Entity Article where+  autoIncrement = False + data Author = Author   { authorID :: Int,     name     :: String,@@ -65,7 +68,7 @@     mapM_ (persist conn) (articles a)                     -- persist all articles of this author (update or insert)     return [toSql (authorID a),                           -- return the author as a list of SqlValues             toSql (name a), toSql (address a)]-+  autoIncrement = False  article1 :: Article article1 =@@ -109,8 +112,7 @@     it "works like a charm" $ do       conn <- prepareDB -      eitherPeUnit <- insert conn arthur-      print eitherPeUnit+      _ <- insert conn arthur       _ <- insert conn article1        authors <- fromRight [] <$> select @Author conn allEntries
test/OneToManySpec.hs view
@@ -33,8 +33,11 @@     authorId  :: Int,     year      :: Int   }-  deriving (Generic, Entity, Show, Eq) -- automatically derives Entity+  deriving (Generic, Show, Eq) +instance Entity Article where+  autoIncrement = False   + data Author = Author   { authorID :: Int,     name     :: String,@@ -50,6 +53,7 @@       ("name", "name"),       ("address", "address")     ]+  autoIncrement = False    fromRow :: Conn -> [SqlValue] -> IO Author   fromRow conn row = do@@ -109,8 +113,8 @@     it "works like a charm" $ do       conn <- prepareDB -      insert conn arthur-      insert conn article1+      _ <- insert conn arthur+      _ <- insert conn article1        authors <- select conn allEntries :: IO [Author]       length authors `shouldBe` 1
test/PostgresQuerySpec.hs view
@@ -33,8 +33,11 @@     age      :: Int,     address  :: String   }-  deriving (Generic, Entity, Show, Eq)+  deriving (Generic, Show, Eq) +instance Entity Person where+  autoIncrement = False + alice, bob, charlie, dave :: Person bob = Person 1 "Bob" 36 "West Street 79" alice = Person 2 "Alice" 25 "West Street 90"@@ -133,20 +136,20 @@       commit conn     it "supports multiple columns in ORDER BY" $ do       conn <- prepareDB-      insert conn dave -- dave and charlie have the same age+      _ <- 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+      _ <- 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+      _ <- insert conn dave       limitedPersons <- select @Person conn (allEntries `limitOffset` (2,1))       length limitedPersons `shouldBe` 1       head limitedPersons `shouldBe` charlie
test/PostgresSpec.hs view
@@ -37,8 +37,11 @@     age      :: Int,     address  :: String   }-  deriving (Generic, Entity, Show, Eq)+  deriving (Generic, Show, Eq) +instance Entity Person where+  autoIncrement = False   + data Car = Car   { carID :: Int,     carType  :: String@@ -209,7 +212,7 @@       conn <- prepareDB       allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 0-      insert conn person+      _ <- insert conn person       commit conn       allPersons' <- select conn allEntries :: IO [Person]       length allPersons' `shouldBe` 1@@ -218,7 +221,7 @@       commit conn     it "inserts Entities with autoincrement handling" $ do       conn <- prepareDB-      myCar@(Car carId _) <- insertReturning conn (Car 0 "Honda Jazz")+      myCar@(Car carId _) <- insert conn (Car 0 "Honda Jazz")       myCar' <- selectById conn carId :: IO (Maybe Car)       myCar' `shouldBe` Just myCar       commit conn@@ -258,12 +261,11 @@       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+      _ <- insert conn book       commit conn       allbooks' <- select conn allEntries :: IO [Book]       length allbooks' `shouldBe` 1@@ -272,7 +274,7 @@       commit conn      it "updates Entities using Generics" $ do       conn <- prepareDB-      insert conn person+      _ <- insert conn person       update conn person {name = "Bob"}       commit conn       person' <- selectById conn (123456 :: Int) :: IO (Maybe Person)@@ -280,7 +282,7 @@       commit conn     it "updates Entities using user implementation" $ do       conn <- prepareDB-      insert conn book+      _ <- insert conn book       update conn book {title = "The Lord of the Rings"}       commit conn       book' <- selectById conn (1 :: Int) :: IO (Maybe Book)@@ -288,7 +290,7 @@       commit conn     it "deletes Entities using Generics" $ do       conn <- prepareDB-      insert conn person+      _ <- insert conn person       allPersons <- select conn allEntries :: IO [Person]       length allPersons `shouldBe` 1       delete conn person@@ -297,7 +299,7 @@       commit conn     it "deletes Entities using user implementation" $ do       conn <- prepareDB-      insert conn book+      _ <- insert conn book       allBooks <- select conn allEntries :: IO [Book]       length allBooks `shouldBe` 1       delete conn book@@ -307,8 +309,8 @@     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+        setupTableFor @Person Postgres conn+        _ <- insert conn person         allPersons <- select conn allEntries :: IO [Person]         length allPersons `shouldBe` 1         commit conn
test/QuerySpec.hs view
@@ -32,8 +32,11 @@     age      :: Int,     address  :: String   }-  deriving (Generic, Entity, Show, Eq)+  deriving (Generic, Show, Eq) +instance Entity Person where+  autoIncrement = False+ alice, bob, charlie, dave :: Person bob = Person 1 "Bob" 36 "West Street 79" alice = Person 2 "Alice" 25 "West Street 90"@@ -119,18 +122,18 @@       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+      _ <- 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+      _ <- insert conn dave       limitedPersons <- select @Person conn (allEntries `limit` 2)       length limitedPersons `shouldBe` 2     it "supports LIMIT OFFSET" $ do       conn <- prepareDB-      insert conn dave+      _ <- insert conn dave       limitedPersons <- select @Person conn (allEntries `limitOffset` (2,1))       length limitedPersons `shouldBe` 1       head limitedPersons `shouldBe` charlie
test/ReferenceSpec.hs view
@@ -40,9 +40,15 @@     name     :: String,     address  :: String   }-  deriving (Generic, Entity, Show, Eq)+  deriving (Generic, Show, Eq) +instance Entity Author where+  autoIncrement = False + instance Entity Article where+  autoIncrement :: Bool+  autoIncrement = False+     fieldsToColumns :: [(String, String)]                      -- ommitting the author field,   fieldsToColumns =                                          -- as this can not be mapped to a single column     [ ("articleID", "articleID"),                            -- instead we invent a new column authorID         @@ -89,7 +95,7 @@   describe "Handling of 1:1 References" $ do     it "works like a charm" $ do       conn <- prepareDB-      insert conn article+      _ <- insert conn article        author' <- selectById conn "2" :: IO (Maybe Author)       author' `shouldBe` Just arthur