sydtest-persistent (empty) → 0.0.0.0

raw patch · 6 files changed

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

Dependencies added: base, monad-logger, mtl, persistent, persistent-sqlite, persistent-template, sydtest, sydtest-persistent

Files

• LICENSE.md +5/−0
• src/Test/Syd/Persistent.hs +40/−0
• sydtest-persistent.cabal +60/−0
• test/Spec.hs +1/−0
• test/Test/Syd/Persistent/Example.hs +28/−0
• test/Test/Syd/PersistentSpec.hs +35/−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,40 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | Testing with an in-memory sqlite database using persistent-sqlite+module Test.Syd.Persistent+  ( runSqlPool,+    runPersistentTest,+    migrationRunner,+  )+where++import Control.Monad.Reader+import Database.Persist.Sql+import Test.Syd++instance IsTest (SqlPersistM ()) where+  type Arg1 (SqlPersistM ()) = ()+  type Arg2 (SqlPersistM ()) = ConnectionPool+  runTest func = runTest (\() -> func)++instance IsTest (outerArgs -> SqlPersistM ()) where+  type Arg1 (outerArgs -> SqlPersistM ()) = outerArgs+  type Arg2 (outerArgs -> SqlPersistM ()) = ConnectionPool+  runTest func = runTest (\outerArgs pool -> runPersistentTest pool (func outerArgs))++-- | A flipped version of 'runSqlPool' to run your tests+runPersistentTest :: ConnectionPool -> SqlPersistM a -> IO a+runPersistentTest = flip runSqlPersistMPool++-- | Helper function to run a 'Migration' before/in a test suite that works accross versions of @persistent@.+#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

@@ -0,0 +1,60 @@+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+version:        0.0.0.0+synopsis:       A persistent 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++library+  exposed-modules:+      Test.Syd.Persistent+  other-modules:+      Paths_sydtest_persistent+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , monad-logger+    , mtl+    , persistent+    , persistent-template+    , sydtest+  default-language: Haskell2010++test-suite sydtest-persistent-sqlite-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Syd.Persistent.Example+      Test.Syd.PersistentSpec+      Paths_sydtest_persistent+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      base >=4.7 && <5+    , monad-logger+    , persistent+    , persistent-sqlite+    , persistent-template+    , sydtest+    , sydtest-persistent+  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,35 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Syd.PersistentSpec (spec) where++import Control.Monad.Logger+import Database.Persist+import Database.Persist.Sql+import Database.Persist.Sqlite+import Test.Syd+import Test.Syd.Persistent+import Test.Syd.Persistent.Example++spec :: Spec+spec = do+  let persistSpec :: SpecWith ConnectionPool -> Spec+      persistSpec = setupAround $+        SetupFunc $ \takeConnectionPool ->+          runNoLoggingT $+            withSqlitePool ":memory:" 1 $ \pool -> do+              _ <- flip runSqlPool pool $ migrationRunner migrateExample+              liftIO $ takeConnectionPool pool++  persistSpec $ do+    it "can write and read this example person" $ \pool -> runPersistentTest 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 -> runPersistentTest pool $ do+        let p = Person {personName = "John Doe", personAge = Just 21}+        insert_ p+      it "cannot read anything that has not been written yet" $ \pool -> runPersistentTest pool $ do+        mp <- get (toSqlKey 0)+        liftIO $ mp `shouldBe` (Nothing :: Maybe Person)