genesis-test (empty) → 0.0.1.0

raw patch · 11 files changed

+447/−0 lines, 11 filesdep +basedep +envparsedep +genesissetup-changed

Dependencies added: base, envparse, genesis, genesis-test, hspec, hspec-expectations, lifted-base, monad-control, monad-logger, monad-persist, persistent-postgresql, persistent-template, text, transformers-base

Files

• CHANGELOG.md +3/−0
• Setup.hs +7/−0
• genesis-test.cabal +69/−0
• library/Genesis/Test.hs +18/−0
• library/Genesis/Test/Hspec.hs +101/−0
• library/Genesis/Test/Persist.hs +118/−0
• package.yaml +66/−0
• stack.yaml +12/−0
• test-suite/Genesis/Test/PersistSpec.hs +37/−0
• test-suite/Main.hs +15/−0
• test-suite/Spec.hs +1/−0

@@ -0,0 +1,3 @@+## 0.0.1.0 (April 24th, 2017)++- Initial release

@@ -0,0 +1,7 @@+-- This script is used to build and install your package. Typically you don't+-- need to change it. The Cabal documentation has more information about this+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain

@@ -0,0 +1,69 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           genesis-test+version:        0.0.1.0+synopsis:       Opinionated bootstrapping for Haskell web services.+description:    Opinionated bootstrapping for Haskell web services.+category:       Other+homepage:       https://github.com/cjdev/genesis#readme+bug-reports:    https://github.com/cjdev/genesis/issues+maintainer:     Alexis King <lexi.lambda@gmail.com>+copyright:      2017 CJ Affiliate by Conversant+license:        ISC+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.md+    package.yaml+    stack.yaml++source-repository head+  type: git+  location: https://github.com/cjdev/genesis++library+  hs-source-dirs:+      library+  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+    , hspec+    , hspec-expectations     >= 0.7.0+    , lifted-base+    , monad-control          >= 1.0.0.0 && < 2+    , monad-logger           >= 0.3.10+    , monad-persist          >= 0.0.1.0 && < 1+    , persistent-postgresql  >= 2.5 && < 3+    , transformers-base+  exposed-modules:+      Genesis.Test+      Genesis.Test.Hspec+      Genesis.Test.Persist+  default-language: Haskell2010++test-suite genesis-test-test-suite+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test-suite+  default-extensions: ConstraintKinds DeriveGeneric DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedStrings RankNTypes ScopedTypeVariables TypeApplications TypeOperators+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base+    , envparse+    , genesis+    , genesis-test+    , hspec+    , monad-logger+    , monad-persist+    , persistent-template+    , text+  other-modules:+      Genesis.Test.PersistSpec+      Spec+  default-language: Haskell2010

@@ -0,0 +1,18 @@+module Genesis.Test+  ( -- * Managing the global database connection+    -- | The bindings in this section are re-exported from+    -- "Genesis.Test.Persist". For more information, see the module+    -- documentation for "Genesis.Test.Persist".+    runDB+  , runDBCommit+  , withGlobalPostgresqlConn+    -- * HSpec helpers+  , module Genesis.Test.Hspec+  , dbExample+    -- * Other re-exports+  , module Genesis.Persist+  ) where++import Genesis.Persist+import Genesis.Test.Hspec+import Genesis.Test.Persist

@@ -0,0 +1,101 @@+{-|+  This module re-exports everything from "Test.Hspec", except with modified+  versions of the runner and expectations that operate over an arbitrary monad+  transformer stack with 'IO' at the base. This is especially useful in+  conjunction with 'Genesis.Test.Persist.dbExample' from "Genesis.Test.Persist",+  which runs an @hspec@ example in a monad that can interact with a database.+-}+module Genesis.Test.Hspec+  ( module Test.Hspec+  , hspec+  , expectationFailure+  , shouldBe+  , shouldSatisfy+  , shouldStartWith+  , shouldEndWith+  , shouldContain+  , shouldMatchList+  , shouldReturn+  , shouldNotBe+  , shouldNotSatisfy+  , shouldNotContain+  , shouldNotReturn+  , shouldThrow+  ) where++import qualified Test.Hspec as Hspec++import Control.Exception.Lifted (Exception, try)+import Control.Monad (unless)+import Control.Monad.Base (MonadBase, liftBase)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Proxy (Proxy(..))+import Data.Typeable (typeRep)+import GHC.Stack (HasCallStack)+import Test.Hspec hiding+  ( hspec+  , expectationFailure+  , shouldBe+  , shouldSatisfy+  , shouldStartWith+  , shouldEndWith+  , shouldContain+  , shouldMatchList+  , shouldReturn+  , shouldNotBe+  , shouldNotSatisfy+  , shouldNotContain+  , shouldNotReturn+  , shouldThrow+  )++hspec :: MonadBase IO m => Spec -> m ()+hspec x = liftBase $ Hspec.hspec x++expectationFailure :: (HasCallStack, MonadBase IO m) => String -> m ()+expectationFailure x = liftBase $ Hspec.expectationFailure x++expectTrue :: (HasCallStack, MonadBase IO m) => String -> Bool -> m ()+expectTrue msg b = unless b (expectationFailure msg)++shouldBe :: (HasCallStack, Show a, Eq a, MonadBase IO m) => a -> a -> m ()+shouldBe x y = liftBase $ Hspec.shouldBe x y++shouldSatisfy :: (HasCallStack, Show a, MonadBase IO m) => a -> (a -> Bool) -> m ()+shouldSatisfy x y = liftBase $ Hspec.shouldSatisfy x y++shouldStartWith :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()+shouldStartWith x y = liftBase $ Hspec.shouldStartWith x y++shouldEndWith :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()+shouldEndWith x y = liftBase $ Hspec.shouldEndWith x y++shouldContain :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()+shouldContain x y = liftBase $ Hspec.shouldContain x y++shouldMatchList :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()+shouldMatchList x y = liftBase $ Hspec.shouldMatchList x y++shouldNotBe :: (HasCallStack, Show a, Eq a, MonadBase IO m) => a -> a -> m ()+shouldNotBe x y = liftBase $ Hspec.shouldNotBe x y++shouldNotSatisfy :: (HasCallStack, Show a, MonadBase IO m) => a -> (a -> Bool) -> m ()+shouldNotSatisfy x y = liftBase $ Hspec.shouldNotSatisfy x y++shouldNotContain :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()+shouldNotContain x y = liftBase $ Hspec.shouldNotContain x y++shouldReturn :: (HasCallStack, Show a, Eq a, MonadBase IO m) => m a -> a -> m ()+shouldReturn action x = action >>= (`shouldBe` x)++shouldNotReturn :: (HasCallStack, Show a, Eq a, MonadBase IO m) => m a -> a -> m ()+shouldNotReturn action x = action >>= (`shouldNotBe` x)++-- impl modified from Test.Hspec.Expectations.shouldThrow+shouldThrow :: forall e a m. (HasCallStack, Exception e, MonadBaseControl IO m) => m a -> Selector e -> m ()+shouldThrow action p = try action >>= \case+    Right _ -> expectationFailure $+      "did not get expected exception: " ++ exceptionType+    Left e -> flip expectTrue (p e) $+      "predicate failed on expected exception: " ++ exceptionType ++ " (" ++ show e ++ ")"+  where exceptionType = show $ typeRep (Proxy @e) -- a string repsentation of the expected exception's type

@@ -0,0 +1,118 @@+{-# OPTIONS_HADDOCK not-home #-}++{-|+  This module provides 'withGlobalPostgresqlConn', a function that parameterizes+  a global reference to a PostgreSQL database, 'dbConn'. This is intended for+  use in test code that does not need a connection pool and simply needs to+  execute functions against a database. It also provides 'postgresOptions', an+  @envparse@ 'Env.Parser' for 'PostgresOptions', which makes it easy to+  configure the PostgreSQL connection via the environment.++  If you use @hspec@, you should wrap your top-level test execution with+  'withGlobalPostgresqlConn' to properly set the global connection during the+  dynamic scope of your tests and ensure the database is rolled back after each+  test, then use 'runDB' in your tests to utilize the global connection.++  Example:++  @+  main :: 'IO' ()+  main = do+    opts <- 'Env.parse' ('Env.header' "test suite") 'postgresOptions'+    'withGlobalPostgresqlConn' opts $+      'Hspec.hspec' spec++  spec :: 'Spec'+  spec = 'Hspec.describe' "GET /foo" $ do+    'Hspec.it' "should produce a Foo" $ 'dbExample' $ do+      let foo = Foo { fooBar = "baz" }+      fooId <- 'Persist.insert' foo+      result <- getFoo (FooId 1)+      result `​'Hspec.shouldBe'​` foo+  @+-}+module Genesis.Test.Persist+  ( runDB+  , runDBCommit+  , dbExample+  , dbConn+  , withGlobalPostgresqlConn+  ) where++import qualified Control.Monad.Persist as Persist+import qualified Database.Persist.Postgresql as PG+import qualified Genesis.Test.Hspec as Hspec++import Control.Exception (bracket_)+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 Data.Maybe (fromMaybe)+import Genesis.Persist (PostgresOptions, withPostgresqlConn)+import GHC.Stack (HasCallStack)+import System.IO.Unsafe (unsafePerformIO)++dbConnRef :: IORef (Maybe Persist.SqlBackend)+dbConnRef = unsafePerformIO (newIORef Nothing)+{-# NOINLINE dbConnRef #-}++{-|+  Low-level access to the global database connection. If the global connection+  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 = fromMaybe (error "dbConn: connection does not exist") <$> liftBase (readIORef dbConnRef)++{-|+  Runs a computation that may interact with a database using the global database+  context, then rolls back the transaction once the computation has completed.+  This is intended to be wrapped around a single test case to create a+  self-contained test that interacts with the database.++  If you are using @hspec@, the 'dbExample' helper may be more useful and+  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++{-|+  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.+-}+runDBCommit :: (MonadIO m, MonadBaseControl IO m) => Persist.SqlPersistT m a -> m a+runDBCommit x = Persist.runPersistT (x <* Persist.transactionSave) =<< dbConn++{-|+  A helper function that combines 'Hspec.example' with 'runDB'. This can be used+  with 'Hspec.it' to create a test case which has access to the database within+  its body:++  @+  spec = 'Hspec.describe' "the database" $+    'Hspec.it' "holds records" $ 'dbExample' $ do+      ...+  @++  When using this function, you should most likely also use "Genesis.Test.Hspec"+  instead of "Test.Hspec" to avoid unnecessarily lifting of assertions.+-}+dbExample :: Persist.SqlPersistT IO () -> Hspec.Expectation+dbExample = Hspec.example . runDB++{-|+  Parameterizes the global database connection, 'dbConn', within the dynamic+  extent of its execution. The connection is started within a transaction.+-}+withGlobalPostgresqlConn :: MonadBaseControl IO m => PostgresOptions -> m a -> m a+withGlobalPostgresqlConn opts = liftBaseOp_ $ \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

@@ -0,0 +1,66 @@+name: genesis-test+version: 0.0.1.0+category: Other+synopsis: Opinionated bootstrapping for Haskell web services.+description: Opinionated bootstrapping for Haskell web services.+maintainer: Alexis King <lexi.lambda@gmail.com>+copyright: 2017 CJ Affiliate by Conversant+license: ISC+github: cjdev/genesis++extra-source-files:+- CHANGELOG.md+- package.yaml+- stack.yaml++ghc-options: -Wall+default-extensions:+- ConstraintKinds+- DeriveGeneric+- DuplicateRecordFields+- FlexibleContexts+- FlexibleInstances+- GADTs+- GeneralizedNewtypeDeriving+- KindSignatures+- LambdaCase+- MultiParamTypeClasses+- NamedFieldPuns+- OverloadedStrings+- RankNTypes+- ScopedTypeVariables+- TypeApplications+- TypeOperators++library:+  dependencies:+  - base                   >= 4.9.0.0 && < 5+  - genesis                == 0.0.1.0+  - hspec+  - hspec-expectations     >= 0.7.0+  - lifted-base+  - monad-control          >= 1.0.0.0 && < 2+  - monad-logger           >= 0.3.10+  - monad-persist          >= 0.0.1.0 && < 1+  - persistent-postgresql  >= 2.5 && < 3+  - transformers-base+  source-dirs: library++tests:+  genesis-test-test-suite:+    dependencies:+    - base+    - envparse+    - genesis+    - genesis-test+    - hspec+    - monad-logger+    - monad-persist+    - persistent-template+    - text+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts=-N+    main: Main.hs+    source-dirs: test-suite

@@ -0,0 +1,12 @@+resolver: lts-8.11++packages:+- '.'+- location: '../genesis'+  extra-dep: true++extra-deps: [monad-persist-0.0.1.0]++flags: {}++extra-package-dbs: []

@@ -0,0 +1,37 @@+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Genesis.Test.PersistSpec (spec) where++import Control.Monad.Persist (Entity(..), insert, selectList)+import Data.Text (Text)+import Database.Persist.TH (mkPersist, persistLowerCase, sqlSettings)+import Genesis.Test++mkPersist sqlSettings [persistLowerCase|+Blog+  name Text+  deriving Eq Show++Post+  title Text+  body Text+  blogId BlogId+  deriving Eq Show+|]++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]

@@ -0,0 +1,15 @@+{-# LANGUAGE TemplateHaskell #-}++import qualified Env+import qualified Spec++import Control.Monad.Logger (runNoLoggingT)+import Genesis.Persist.Migrate (runMigrations)+import Genesis.Test++main :: IO ()+main = do+  opts <- Env.parse (Env.header "genesis-test test suite") postgresOptions+  runNoLoggingT $ withGlobalPostgresqlConn opts $ do+    runDBCommit $(runMigrations "test-suite/migrations")+    hspec Spec.spec

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}