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 +16/−9
- generic-persistence.cabal +18/−18
- src/Database/GP.hs +0/−1
- src/Database/GP/Entity.hs +35/−8
- src/Database/GP/GenericPersistence.hs +1/−5
- src/Database/GP/GenericPersistenceSafe.hs +16/−39
- src/Database/GP/SqlGenerator.hs +20/−7
- test/ConnSpec.hs +3/−2
- test/DemoSpec.hs +8/−12
- test/EmbeddedSpec.hs +1/−1
- test/EnumSpec.hs +1/−1
- test/ExceptionsSpec.hs +7/−3
- test/GenericPersistenceSpec.hs +12/−9
- test/OneToManySafeSpec.hs +6/−4
- test/OneToManySpec.hs +7/−3
- test/PostgresQuerySpec.hs +7/−4
- test/PostgresSpec.hs +13/−11
- test/QuerySpec.hs +7/−4
- test/ReferenceSpec.hs +8/−2
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