genesis-test 0.0.1.0 → 0.1.0.0
raw patch · 6 files changed
+61/−38 lines, 6 filesdep +transformersdep ~basedep ~genesisdep ~hspec-expectationsPVP ok
version bump matches the API change (PVP)
Dependencies added: transformers
Dependency ranges changed: base, genesis, hspec-expectations, monad-control, monad-persist
API changes (from Hackage documentation)
- Genesis.Test: runDB :: (MonadIO m, MonadBaseControl IO m) => SqlPersistT m a -> m a
+ Genesis.Test: runDB :: MonadBaseControl IO m => SqlPersistT m a -> m a
- Genesis.Test: runDBCommit :: (MonadIO m, MonadBaseControl IO m) => SqlPersistT m a -> m a
+ Genesis.Test: runDBCommit :: MonadBaseControl IO m => SqlPersistT m a -> m a
- Genesis.Test.Persist: dbConn :: HasCallStack => MonadBaseControl IO m => m SqlBackend
+ Genesis.Test.Persist: dbConn :: (HasCallStack, MonadBaseControl IO m) => m SqlBackend
- Genesis.Test.Persist: runDB :: (MonadIO m, MonadBaseControl IO m) => SqlPersistT m a -> m a
+ Genesis.Test.Persist: runDB :: MonadBaseControl IO m => SqlPersistT m a -> m a
- Genesis.Test.Persist: runDBCommit :: (MonadIO m, MonadBaseControl IO m) => SqlPersistT m a -> m a
+ Genesis.Test.Persist: runDBCommit :: MonadBaseControl IO m => SqlPersistT m a -> m a
Files
- CHANGELOG.md +4/−0
- genesis-test.cabal +10/−7
- library/Genesis/Test/Persist.hs +17/−16
- package.yaml +7/−6
- stack.yaml +1/−1
- test-suite/Genesis/Test/PersistSpec.hs +22/−8
CHANGELOG.md view
@@ -1,3 +1,7 @@+## 0.1.0.0 (November 21st, 2017)++- Changed `runDB` and `runDBCommit` to properly roll back a transaction if an exception is raised.+ ## 0.0.1.0 (April 24th, 2017) - Initial release
genesis-test.cabal view
@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.15.0.+-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack name: genesis-test-version: 0.0.1.0+version: 0.1.0.0 synopsis: Opinionated bootstrapping for Haskell web services. description: Opinionated bootstrapping for Haskell web services. category: Other@@ -30,20 +30,23 @@ default-extensions: ConstraintKinds DeriveGeneric DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedStrings RankNTypes ScopedTypeVariables TypeApplications TypeOperators ghc-options: -Wall build-depends:- base >= 4.9.0.0 && < 5- , genesis == 0.0.1.0+ base >= 4.9 && < 5+ , genesis == 0.1.0.0 , hspec- , hspec-expectations >= 0.7.0+ , hspec-expectations >= 0.7 , lifted-base- , monad-control >= 1.0.0.0 && < 2+ , monad-control >= 1 && < 2 , monad-logger >= 0.3.10- , monad-persist >= 0.0.1.0 && < 1+ , monad-persist >= 0.0.1.2 && < 1 , persistent-postgresql >= 2.5 && < 3+ , transformers , transformers-base exposed-modules: Genesis.Test Genesis.Test.Hspec Genesis.Test.Persist+ other-modules:+ Paths_genesis_test default-language: Haskell2010 test-suite genesis-test-test-suite
library/Genesis/Test/Persist.hs view
@@ -43,12 +43,12 @@ import qualified Database.Persist.Postgresql as PG import qualified Genesis.Test.Hspec as Hspec -import Control.Exception (bracket_)+import Control.Exception.Lifted (bracket_, finally, onException) import Control.Monad.Base (liftBase)-import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger (runNoLoggingT)-import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.IORef.Lifted (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (fromMaybe) import Genesis.Persist (PostgresOptions, withPostgresqlConn) import GHC.Stack (HasCallStack)@@ -63,7 +63,7 @@ does not exist (that is, you are not in the dynamic extent of a call to 'withGlobalPostgresqlConn'), this will raise an exception. -}-dbConn :: HasCallStack => MonadBaseControl IO m => m Persist.SqlBackend+dbConn :: (HasCallStack, MonadBaseControl IO m) => m Persist.SqlBackend dbConn = fromMaybe (error "dbConn: connection does not exist") <$> liftBase (readIORef dbConnRef) {-|@@ -76,17 +76,18 @@ concise, but this function is provided for uses that fall outside of simple @hspec@ examples. -}-runDB :: (MonadIO m, MonadBaseControl IO m) => Persist.SqlPersistT m a -> m a-runDB x = Persist.runPersistT (x <* Persist.transactionUndo) =<< dbConn+runDB :: MonadBaseControl IO m => Persist.SqlPersistT m a -> m a+runDB x = Persist.runPersistT (x `finally` Persist.transactionUndo) =<< dbConn {-| Like 'runDB', except that the transaction is commited after running instead of- rolled back. You should avoid this in test code to avoid creating tests that- dependent on the database state, but it can be useful to run migrations, for- example.+ rolled back (unless an exception is raised, in which case the transaction is+ rolled back, anyway). You should avoid this in test code to avoid creating+ tests that dependent on the database state, but it can be useful to run+ migrations, for example. -}-runDBCommit :: (MonadIO m, MonadBaseControl IO m) => Persist.SqlPersistT m a -> m a-runDBCommit x = Persist.runPersistT (x <* Persist.transactionSave) =<< dbConn+runDBCommit :: MonadBaseControl IO m => Persist.SqlPersistT m a -> m a+runDBCommit x = Persist.runPersistT ((x <* Persist.transactionSave) `onException` Persist.transactionUndo) =<< dbConn {-| A helper function that combines 'Hspec.example' with 'runDB'. This can be used@@ -110,9 +111,9 @@ extent of its execution. The connection is started within a transaction. -} withGlobalPostgresqlConn :: MonadBaseControl IO m => PostgresOptions -> m a -> m a-withGlobalPostgresqlConn opts = liftBaseOp_ $ \action ->+withGlobalPostgresqlConn opts action = runNoLoggingT $ withPostgresqlConn opts $ \conn -> do oldConn <- liftBase $ readIORef dbConnRef- liftBase $ bracket_ (writeIORef dbConnRef (Just conn)) (writeIORef dbConnRef oldConn) $ do- PG.connBegin conn (PG.getStmtConn conn) -- start a new transaction- action+ bracket_ (writeIORef dbConnRef (Just conn)) (writeIORef dbConnRef oldConn) $ do+ liftBase $ PG.connBegin conn (PG.getStmtConn conn) -- start a new transaction+ lift action
package.yaml view
@@ -1,5 +1,5 @@ name: genesis-test-version: 0.0.1.0+version: 0.1.0.0 category: Other synopsis: Opinionated bootstrapping for Haskell web services. description: Opinionated bootstrapping for Haskell web services.@@ -34,15 +34,16 @@ library: dependencies:- - base >= 4.9.0.0 && < 5- - genesis == 0.0.1.0+ - base >= 4.9 && < 5+ - genesis == 0.1.0.0 - hspec- - hspec-expectations >= 0.7.0+ - hspec-expectations >= 0.7 - lifted-base- - monad-control >= 1.0.0.0 && < 2+ - monad-control >= 1 && < 2 - monad-logger >= 0.3.10- - monad-persist >= 0.0.1.0 && < 1+ - monad-persist >= 0.0.1.2 && < 1 - persistent-postgresql >= 2.5 && < 3+ - transformers - transformers-base source-dirs: library
stack.yaml view
@@ -5,7 +5,7 @@ - location: '../genesis' extra-dep: true -extra-deps: [monad-persist-0.0.1.0]+extra-deps: [monad-io-adapter-0.1.0.0, monad-persist-0.0.2.0] flags: {}
test-suite/Genesis/Test/PersistSpec.hs view
@@ -10,7 +10,7 @@ module Genesis.Test.PersistSpec (spec) where -import Control.Monad.Persist (Entity(..), insert, selectList)+import Control.Monad.Persist (Entity(..), insert, insert_, selectList) import Data.Text (Text) import Database.Persist.TH (mkPersist, persistLowerCase, sqlSettings) import Genesis.Test@@ -28,10 +28,24 @@ |] spec :: Spec-spec = describe "dbExample" $- it "runs an Hspec example with access to the database" $ dbExample $ do- blogId <- insert $ Blog "Alyssa’s Blog"- let post = Post { postTitle = "First Post", postBody = "world changing post", postBlogId = blogId }- postId <- insert post- posts <- selectList [] []- posts `shouldBe` [Entity postId post]+spec = do+ describe "runDB" $ do+ it "rolls back when the action completes succesfully" $ example $ do+ runDB . insert_ $ Blog "Alyssa’s Blog"+ runDB (selectList [] []) `shouldReturn` ([] :: [Entity Blog])++ it "rolls back when the action fails with an exception" $ example $ do+ shouldThrow+ (runDB $ do+ insert_ $ Blog "Alyssa’s Blog"+ error "failure")+ (errorCall "failure")+ runDB (selectList [] []) `shouldReturn` ([] :: [Entity Blog])++ describe "dbExample" $+ it "runs an Hspec example with access to the database" $ dbExample $ do+ blogId <- insert $ Blog "Alyssa’s Blog"+ let post = Post { postTitle = "First Post", postBody = "world changing post", postBlogId = blogId }+ postId <- insert post+ posts <- selectList [] []+ posts `shouldBe` [Entity postId post]