sydtest-persistent-postgresql (empty) → 0.1.0.0

raw patch · 6 files changed

+205/−0 lines, 6 filesdep +basedep +monad-loggerdep +mtl

Dependencies added: base, monad-logger, mtl, persistent, persistent-postgresql, persistent-template, sydtest, sydtest-persistent-postgresql, tmp-postgres

Files

• LICENSE.md +5/−0
• src/Test/Syd/Persistent/Postgresql.hs +75/−0
• sydtest-persistent-postgresql.cabal +69/−0
• test/Spec.hs +1/−0
• test/Test/Syd/Persistent/Example.hs +28/−0
• test/Test/Syd/Persistent/PostgresqlSpec.hs +27/−0

@@ -0,0 +1,5 @@+# Sydtest License++Copyright (c) 2021 Tom Sydney Kerckhove++See the Sydtest License at https://github.com/NorfairKing/sydtest/blob/master/sydtest/LICENSE.md for the full license text.

@@ -0,0 +1,75 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Testing with a temporary postgresql database using persistent-postgresql+module Test.Syd.Persistent.Postgresql+  ( persistPostgresqlSpec,+    withConnectionPool,+    connectionPoolSetupFunc,+    runSqlPool,+    runPostgresqlTest,+  )+where++import Control.Monad.Logger+import Control.Monad.Reader+import Database.Persist.Postgresql+import Database.Postgres.Temp as Temp+import Test.Syd++-- | Declare a test suite that uses a database connection.+--+-- Example usage+--+-- > -- Database definition+-- > share+-- >   [mkPersist sqlSettings, mkMigrate "migrateExample"]+-- >   [persistLowerCase|+-- > Person+-- >     name String+-- >     age Int Maybe+-- >     deriving Show Eq+-- > |]+-- >+-- > -- Tests+-- > spec :: Spec+-- > spec =+-- >   persistPostgresqlSpec migrateExample $ do+-- >     it "can write and read this example person" $ \pool ->+-- >       runPostgresqlTest pool $ do+-- >         let p = Person {personName = "John Doe", personAge = Just 21}+-- >         i <- insert p+-- >         mp <- get i+-- >         liftIO $ mp `shouldBe` Just p+--+-- This sets up the database connection around every test, so state is not preserved accross tests.+persistPostgresqlSpec :: Migration -> SpecWith ConnectionPool -> SpecWith a+persistPostgresqlSpec migration = aroundWith $ \func _ -> withConnectionPool migration func++-- | Set up a postgresql connection and migrate it to run the given function.+withConnectionPool :: Migration -> (ConnectionPool -> IO r) -> IO r+withConnectionPool = unSetupFunc . connectionPoolSetupFunc++-- | The 'SetupFunc' version of 'withConnectionPool'.+connectionPoolSetupFunc :: Migration -> SetupFunc ConnectionPool+connectionPoolSetupFunc migration = SetupFunc $ \takeConnectionPool -> do+  errOrRes <- Temp.with $ \db ->+    runNoLoggingT $+      withPostgresqlPool (toConnectionString db) 1 $ \pool -> do+        _ <- flip runSqlPool pool $ migrationRunner migration+        liftIO $ takeConnectionPool pool+  case errOrRes of+    Left err -> liftIO $ expectationFailure $ show err+    Right r -> pure r++#if MIN_VERSION_persistent(2,10,2)+migrationRunner :: MonadIO m => Migration -> ReaderT SqlBackend m ()+migrationRunner = void . runMigrationQuiet+#else+migrationRunner :: MonadIO m => Migration -> ReaderT SqlBackend m ()+migrationRunner = runMigration+#endif++-- | A flipped version of 'runSqlPool' to run your tests+runPostgresqlTest :: ConnectionPool -> SqlPersistT IO a -> IO a+runPostgresqlTest = flip runSqlPool

@@ -0,0 +1,69 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           sydtest-persistent-postgresql+version:        0.1.0.0+synopsis:       An persistent-postgresql companion library for sydtest+category:       Testing+homepage:       https://github.com/NorfairKing/sydtest#readme+bug-reports:    https://github.com/NorfairKing/sydtest/issues+author:         Tom Sydney Kerckhove+maintainer:     syd@cs-syd.eu+copyright:      Copyright (c) 2021 Tom Sydney Kerckhove+license:        OtherLicense+license-file:   LICENSE.md+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/NorfairKing/sydtest++flag sydtest_integration_tests+  description: Whether to allow building integration tests+  manual: False+  default: True++library+  exposed-modules:+      Test.Syd.Persistent.Postgresql+  other-modules:+      Paths_sydtest_persistent_postgresql+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , monad-logger+    , mtl+    , persistent+    , persistent-postgresql+    , sydtest+    , tmp-postgres+  default-language: Haskell2010++test-suite sydtest-persistent-postgresql-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Syd.Persistent.Example+      Test.Syd.Persistent.PostgresqlSpec+      Paths_sydtest_persistent_postgresql+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      base >=4.7 && <5+    , persistent+    , persistent-postgresql+    , persistent-template+    , sydtest+    , sydtest-persistent-postgresql+  if flag(sydtest_integration_tests)+    buildable: True+  else+    buildable: False+  default-language: Haskell2010

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}

@@ -0,0 +1,28 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Test.Syd.Persistent.Example where++import Database.Persist.Sql+import Database.Persist.TH++share+  [mkPersist sqlSettings, mkMigrate "migrateExample"]+  [persistLowerCase|+Person+    name String+    age Int Maybe+    deriving Show Eq+|]

@@ -0,0 +1,27 @@+module Test.Syd.Persistent.PostgresqlSpec (spec) where++import Database.Persist+import Database.Persist.Sql+import Test.Syd+import Test.Syd.Persistent.Example+import Test.Syd.Persistent.Postgresql++spec :: Spec+spec =+  describe "persistPostgresqlSpec" $ do+    persistPostgresqlSpec migrateExample $ do+      it "can write and read this example person" $ \pool ->+        runPostgresqlTest pool $ do+          let p = Person {personName = "John Doe", personAge = Just 21}+          i <- insert p+          mp <- get i+          liftIO $ mp `shouldBe` Just p+      describe "shared data" $ do+        it "can write this example person" $ \pool ->+          runPostgresqlTest pool $ do+            let p = Person {personName = "John Doe", personAge = Just 21}+            insert_ p+        it "cannot read anything that has not been written yet" $ \pool ->+          runPostgresqlTest pool $ do+            mp <- get (toSqlKey 0)+            liftIO $ mp `shouldBe` (Nothing :: Maybe Person)