packages feed

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 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]