persistent-mtl 0.4.0.0 → 0.5.0.0

raw patch · 32 files changed

+2415/−2546 lines, 32 filesdep +tasty-autocollectdep ~basedep ~conduitdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty-autocollect

Dependency ranges changed: base, conduit, containers, exceptions, monad-logger, persistent, resourcet, text, transformers, unliftio, unliftio-core, unliftio-pool

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−7
• README.md +2/−2
• persistent-mtl.cabal +26/−24
• src/Control/Monad/IO/Rerunnable.hs +6/−6
• src/Control/Monad/Trans/Rerunnable.hs +68/−0
• src/Database/Persist/Monad.hs +103/−127
• src/Database/Persist/Monad/Class.hs +7/−7
• src/Database/Persist/Monad/Internal/PersistentShim.hs +17/−0
• src/Database/Persist/Monad/Internal/SqlTransaction.hs +92/−0
• src/Database/Persist/Monad/Shim.hs +18/−83
• src/Database/Persist/Monad/SqlQueryRep.hs +18/−153
• src/Database/Persist/Monad/TestUtils.hs +172/−156
• src/Database/Persist/Sql/Shim.hs +233/−0
• test/Basic.hs +0/−31
• test/Example.hs +42/−44
• test/Generated.hs +1/−40
• test/Integration.hs +0/−898
• test/IntegrationTest.hs +846/−0
• test/Main.hs +4/−19
• test/MockSqlQueryT.hs +0/−38
• test/Mocked.hs +0/−548
• test/MockedTest.hs +621/−0
• test/READMETest.hs +32/−0
• test/SqlQueryRepTest.hs +13/−21
• test/TestUtils/DB.hs +5/−5
• test/TestUtils/Esqueleto.hs +3/−9
• test/goldens/persistent-2.10/sqlqueryrep_show_representation.golden +0/−66
• test/goldens/persistent-2.11/sqlqueryrep_show_representation.golden +0/−68
• test/goldens/persistent-2.12/sqlqueryrep_show_representation.golden +0/−68
• test/goldens/persistent-2.14/sqlqueryrep_show_representation.golden +66/−0
• test/goldens/persistent-2.8/sqlqueryrep_show_representation.golden +0/−62
• test/goldens/persistent-2.9/sqlqueryrep_show_representation.golden +0/−64

@@ -1,36 +1,49 @@ # Unreleased -# 0.4.0.0+# v0.5.0.0 +* Export `SqlQueryT` constructor ([#46](https://github.com/brandonchinn178/persistent-mtl/pull/46))+* Drop support for GHC < 8.10+* Drop support for `persistent` < 2.13+* Add support for `persistent-2.14`+* Add `Database.Persist.Sql.Shim` module that re-exports `Database.Persist.Sql` and `Database.Persist.Monad.Shim`+* Add `MonadFix` instance to `SqlQueryT` and `SqlTransaction`+* Add `getSqlBackendPool`+* Move `rerunnableLift` into `MonadRerunnableTrans` typeclass in `Control.Monad.Trans.Rerunnable`+* Add `catchSqlTransaction`+* Add `retryCallback` to `SqlQueryEnv`++# v0.4.0.0+ * Add some mtl instances: `MonadThrow`, `MonadCatch`, `MonadMask`, `MonadLogger`, `MonadReader` * Removed support for GHC 8.2, 8.4 * Add `MonadSqlQuery (TransactionM m)` superclass constraint to allow writing functions generic on some `MonadSqlQuery m` using `withTransaction`, as shown in examples in README -# 0.3.0.0+# v0.3.0.0  * Add `unsafeLiftSql` ([#38](https://github.com/brandonchinn178/persistent-mtl/pull/38)) -# 0.2.2.0+# v0.2.2.0  * Fix for persistent 2.13 -# 0.2.1.0+# v0.2.1.0  * Add `rerunnableLift` for `SqlTransaction` * Use `unliftio-pool` instead of `resourcet-pool`, which has better async exeception safety -# 0.2.0.0+# v0.2.0.0  * Use a separate monad within `withTransaction` to prevent unsafe/arbitrary IO actions ([#7](https://github.com/brandonchinn178/persistent-mtl/issues/7), [#28](https://github.com/brandonchinn178/persistent-mtl/issues/28)) * Add `MonadRerunnableIO` to support IO actions within `withTransaction` only if the IO action is determined to be rerunnable * Add built-in support for retrying transactions if a serialization error occurs * Remove `SqlQueryRep` as an export from `Database.Persist.Monad`. You shouldn't ever need it for normal usage. It is now re-exported by `Database.Persist.Monad.TestUtils`, since most of the usage of `SqlQueryRep` is in mocking queries. If you need it otherwise, you can import it directly from `Database.Persist.Monad.SqlQueryRep`. -# 0.1.0.1+# v0.1.0.1  Fix quickstart -# 0.1.0.0+# v0.1.0.0  Initial release * `SqlQueryT` + `MonadSqlQuery`

@@ -1,8 +1,8 @@ # `persistent-mtl` -[![CircleCI](https://img.shields.io/circleci/build/github/brandonchinn178/persistent-mtl)](https://app.circleci.com/pipelines/github/brandonchinn178/persistent-mtl)+[![GitHub Actions](https://img.shields.io/github/workflow/status/brandonchinn178/persistent-mtl/CI/main)](https://github.com/brandonchinn178/persistent-mtl/actions?query=branch%3Amain) [![Hackage](https://img.shields.io/hackage/v/persistent-mtl)](https://hackage.haskell.org/package/persistent-mtl)-[![Codecov](https://img.shields.io/codecov/c/gh/brandonchinn178/persistent-mtl)](https://codecov.io/gh/brandonchinn178/persistent-mtl)+[![Codecov](https://img.shields.io/codecov/c/gh/brandonchinn178/persistent-mtl)](https://app.codecov.io/gh/brandonchinn178/persistent-mtl)  Use the `persistent` API in your monad transformer stack, seamlessly interleaving business logic with database operations by simply dropping `SqlQueryT` into your stack. 

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack  name:           persistent-mtl-version:        0.4.0.0+version:        0.5.0.0 synopsis:       Monad transformer for the persistent API description:    A monad transformer and mtl-style type class for using the                 persistent API directly in your monad transformer stack.@@ -19,12 +19,8 @@ extra-source-files:     CHANGELOG.md     README.md-    test/goldens/persistent-2.10/sqlqueryrep_show_representation.golden-    test/goldens/persistent-2.11/sqlqueryrep_show_representation.golden-    test/goldens/persistent-2.12/sqlqueryrep_show_representation.golden     test/goldens/persistent-2.13/sqlqueryrep_show_representation.golden-    test/goldens/persistent-2.8/sqlqueryrep_show_representation.golden-    test/goldens/persistent-2.9/sqlqueryrep_show_representation.golden+    test/goldens/persistent-2.14/sqlqueryrep_show_representation.golden  source-repository head   type: git@@ -33,50 +29,55 @@ library   exposed-modules:       Control.Monad.IO.Rerunnable+      Control.Monad.Trans.Rerunnable       Database.Persist.Monad       Database.Persist.Monad.Class+      Database.Persist.Monad.Internal.PersistentShim+      Database.Persist.Monad.Internal.SqlTransaction       Database.Persist.Monad.Shim       Database.Persist.Monad.SqlQueryRep       Database.Persist.Monad.TestUtils+      Database.Persist.Sql.Shim   other-modules:       Paths_persistent_mtl   hs-source-dirs:       src   ghc-options: -Wall   build-depends:-      base >=4.10 && <4.16-    , conduit >=1.3.0.3 && <1.4-    , containers >=0.5.10.2 && <0.7-    , exceptions >=0.8 && <0.11-    , monad-logger >=0.3.29 && <0.4+      base >=4.14 && <4.16+    , conduit >=1.3.4 && <1.4+    , containers ==0.6.*+    , exceptions ==0.10.*+    , monad-logger ==0.3.*     , mtl >=2.2.2 && <2.3-    , persistent >=2.8.2 && <2.14+    , persistent >=2.13 && <2.15     , resource-pool >=0.2.3.2 && <0.3-    , resourcet >=1.2.1 && <1.3-    , text >=1.2.3.0 && <1.3-    , transformers >=0.5.2.0 && <0.6-    , unliftio >=0.2.7.0 && <0.3-    , unliftio-core >=0.1.2.0 && <0.3-    , unliftio-pool >=0.2.0.0 && <0.3+    , resourcet >=1.2.4 && <1.3+    , text >=1.2.4 && <1.3+    , transformers >=0.5.6 && <0.6+    , unliftio ==0.2.*+    , unliftio-core ==0.2.*+    , unliftio-pool ==0.2.*   default-language: Haskell2010  test-suite persistent-mtl-test   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:-      Basic       Example       Generated-      Integration-      Mocked-      MockSqlQueryT+      IntegrationTest+      MockedTest+      READMETest       SqlQueryRepTest       TestUtils.DB       TestUtils.Esqueleto       Paths_persistent_mtl   hs-source-dirs:       test-  ghc-options: -Wall+  ghc-options: -Wall -F -pgmF=tasty-autocollect+  build-tool-depends:+      tasty-autocollect:tasty-autocollect   build-depends:       base     , bytestring@@ -93,6 +94,7 @@     , resource-pool     , resourcet     , tasty+    , tasty-autocollect     , tasty-golden     , tasty-hunit     , text

@@ -5,10 +5,9 @@ to 'Control.Monad.IO.Class.MonadIO', but use of it requires the user to explicitly acknowledge that the given IO operation can be rerun. -}--module Control.Monad.IO.Rerunnable-  ( MonadRerunnableIO(..)-  ) where+module Control.Monad.IO.Rerunnable (+  MonadRerunnableIO (..),+) where  import Control.Monad.Trans.Class (lift) import qualified Control.Monad.Trans.Except as Except@@ -23,8 +22,9 @@ import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict --- | A copy of 'Control.Monad.IO.Class.MonadIO' to explicitly allow only IO--- operations that are rerunnable, e.g. in the context of a SQL transaction.+{-| A copy of 'Control.Monad.IO.Class.MonadIO' to explicitly allow only IO+ operations that are rerunnable, e.g. in the context of a SQL transaction.+-} class Monad m => MonadRerunnableIO m where   -- | Lift the given IO operation to @m@.   --

@@ -0,0 +1,68 @@+{-|+Module: Control.Monad.Trans.Rerunnable++Defines the 'MonadRerunnableTrans' type class that is functionally equivalent+to 'Control.Monad.Trans.Class.MonadTrans', but use of it requires the user to+explicitly acknowledge that lifting the given action can be rerun.+-}+module Control.Monad.Trans.Rerunnable (+  MonadRerunnableTrans (..),+) where++import Control.Monad.Trans.Class (lift)+import qualified Control.Monad.Trans.Except as Except+import qualified Control.Monad.Trans.Identity as Identity+import qualified Control.Monad.Trans.Maybe as Maybe+import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict+import qualified Control.Monad.Trans.Reader as Reader+import qualified Control.Monad.Trans.Resource as Resource+import qualified Control.Monad.Trans.State.Lazy as State.Lazy+import qualified Control.Monad.Trans.State.Strict as State.Strict+import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy+import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict++{-| A copy of 'Control.Monad.Trans.Class.MonadTrans' to explicitly allow only+lifting actions that are rerunnable, e.g. in the context of a SQL transaction.+-}+class MonadRerunnableTrans t where+  -- | Lift the given action.+  --+  -- The given action may be rerun, so use of this function requires+  -- manually verifying that the given action is rerunnable.+  rerunnableLift :: Monad m => m a -> t m a++{- Instances for common monad transformers -}++instance MonadRerunnableTrans (Reader.ReaderT r) where+  rerunnableLift = lift++instance MonadRerunnableTrans (Except.ExceptT e) where+  rerunnableLift = lift++instance MonadRerunnableTrans Identity.IdentityT where+  rerunnableLift = lift++instance MonadRerunnableTrans Maybe.MaybeT where+  rerunnableLift = lift++instance Monoid w => MonadRerunnableTrans (RWS.Lazy.RWST r w s) where+  rerunnableLift = lift++instance Monoid w => MonadRerunnableTrans (RWS.Strict.RWST r w s) where+  rerunnableLift = lift++instance MonadRerunnableTrans (State.Lazy.StateT s) where+  rerunnableLift = lift++instance MonadRerunnableTrans (State.Strict.StateT s) where+  rerunnableLift = lift++instance Monoid w => MonadRerunnableTrans (Writer.Lazy.WriterT w) where+  rerunnableLift = lift++instance Monoid w => MonadRerunnableTrans (Writer.Strict.WriterT w) where+  rerunnableLift = lift++instance MonadRerunnableTrans Resource.ResourceT where+  rerunnableLift = lift

@@ -1,3 +1,14 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+ {-| Module: Database.Persist.Monad @@ -36,159 +47,104 @@   return () @ -}--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}--module Database.Persist.Monad-  (+module Database.Persist.Monad (   -- * Type class for executing database queries-    MonadSqlQuery-  , withTransaction+  MonadSqlQuery,+  withTransaction,    -- * SqlQueryT monad transformer-  , SqlQueryT-  , mapSqlQueryT-  , runSqlQueryT-  , runSqlQueryTWith-  , SqlQueryEnv(..)-  , mkSqlQueryEnv+  SqlQueryT (..),+  mapSqlQueryT,+  runSqlQueryT,+  runSqlQueryTWith,+  SqlQueryEnv (..),+  mkSqlQueryEnv, +  -- ** SqlQueryT environment+  getSqlBackendPool,+   -- * Transactions-  , SqlTransaction-  , rerunnableLift-  , TransactionError(..)+  SqlTransaction,+  TransactionError (..),+  catchSqlTransaction,    -- * Lifted functions-  , module Database.Persist.Monad.Shim-  ) where+  module Database.Persist.Monad.Shim,+) where  import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.IO.Unlift (MonadUnliftIO(..), wrappedWithRunInIO)+import Control.Monad.Fix (MonadFix)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.IO.Unlift (MonadUnliftIO (..), wrappedWithRunInIO) import Control.Monad.Logger (MonadLogger)-import Control.Monad.Reader (ReaderT(..), mapReaderT)-import Control.Monad.Reader.Class (MonadReader(..))-import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.Reader (ReaderT (..), asks, mapReaderT)+import Control.Monad.Reader.Class (MonadReader (..))+import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.Trans.Resource (MonadResource) import Data.Pool (Pool)-import Database.Persist.Sql (SqlBackend, SqlPersistT, runSqlConn)-import qualified GHC.TypeLits as GHC+import Database.Persist.Sql (SqlBackend) import UnliftIO.Concurrent (threadDelay) import UnliftIO.Exception (Exception, SomeException, catchJust, throwIO) import UnliftIO.Pool (withResource) -import Control.Monad.IO.Rerunnable (MonadRerunnableIO, rerunnableIO)+import Control.Monad.IO.Rerunnable (MonadRerunnableIO) import Database.Persist.Monad.Class+import Database.Persist.Monad.Internal.SqlTransaction import Database.Persist.Monad.Shim-import Database.Persist.Monad.SqlQueryRep -{- SqlTransaction -}---- | The monad that tracks transaction state.------ Conceptually equivalent to 'Database.Persist.Sql.SqlPersistT', but restricts--- IO operations, for two reasons:---   1. Forking a thread that uses the same 'SqlBackend' as the current thread---      causes Bad Things to happen.---   2. Transactions may need to be retried, in which case IO operations in---      a transaction are required to be rerunnable.------ You shouldn't need to explicitly use this type; your functions should only--- declare the 'MonadSqlQuery' constraint.-newtype SqlTransaction m a = SqlTransaction-  { unSqlTransaction :: SqlPersistT m a-  }-  deriving (Functor, Applicative, Monad, MonadRerunnableIO)--instance-  ( GHC.TypeError ('GHC.Text "Cannot run arbitrary IO actions within a transaction. If the IO action is rerunnable, use rerunnableIO")-  , Monad m-  )-  => MonadIO (SqlTransaction m) where-  liftIO = undefined--instance (MonadSqlQuery m, MonadUnliftIO m) => MonadSqlQuery (SqlTransaction m) where-  type TransactionM (SqlTransaction m) = TransactionM m--  runQueryRep = SqlTransaction . runSqlQueryRep--  -- Delegate to 'm', since 'm' is in charge of starting/stopping transactions.-  -- 'SqlTransaction' is ONLY in charge of executing queries.-  withTransaction = SqlTransaction . withTransaction--runSqlTransaction :: MonadUnliftIO m => SqlBackend -> SqlTransaction m a -> m a-runSqlTransaction conn = (`runSqlConn` conn) . unSqlTransaction---- | 'SqlTransaction' does not have an instance for 'MonadTrans' to prevent--- accidental lifting of unsafe monadic actions. Use this function to explicitly--- mark a monadic action as rerunnable.-rerunnableLift :: MonadUnliftIO m => m a -> SqlTransaction m a-rerunnableLift m = SqlTransaction $ lift $ withRunInIO $ \runInIO -> rerunnableIO $ runInIO m---- | Errors that can occur within a SQL transaction.-data TransactionError-  = RetryLimitExceeded-    -- ^ The retry limit was reached when retrying a transaction.-  deriving (Show, Eq)--instance Exception TransactionError- {- SqlQueryT monad -} --- | Environment to configure running 'SqlQueryT'.------ For simple usage, you can just use 'runSqlQueryT', but for more advanced--- usage, including the ability to retry transactions, use 'mkSqlQueryEnv' with--- 'runSqlQueryTWith'.+{-| Environment to configure running 'SqlQueryT'.++ For simple usage, you can just use 'runSqlQueryT', but for more advanced+ usage, including the ability to retry transactions, use 'mkSqlQueryEnv' with+ 'runSqlQueryTWith'.+-} data SqlQueryEnv = SqlQueryEnv   { backendPool :: Pool SqlBackend-    -- ^ The pool for your persistent backend. Get this from @withSqlitePool@-    -- or the equivalent for your backend.+  -- ^ The pool for your persistent backend. Get this from @withSqlitePool@+  -- or the equivalent for your backend.+  , retryIf :: SomeException -> Bool+  -- ^ Retry a transaction when an exception matches this predicate. Will+  -- retry with an exponential backoff.+  --+  -- Defaults to always returning False (i.e. never retry)+  , retryLimit :: Int+  -- ^ The number of times to retry, if 'retryIf' is satisfied.+  --+  -- Defaults to 10.+  , retryCallback :: SomeException -> IO ()+  -- ^ A callback to run if 'retryIf' returns True. Useful for logging.+  } -  , retryIf     :: SomeException -> Bool-    -- ^ Retry a transaction when an exception matches this predicate. Will-    -- retry with an exponential backoff.-    ---    -- Defaults to always returning False (i.e. never retry)+{-| Build a SqlQueryEnv from the default. -  , retryLimit  :: Int-    -- ^ The number of times to retry, if 'retryIf' is satisfied.-    ---    -- Defaults to 10.-  }+ Usage: --- | Build a SqlQueryEnv from the default.------ Usage:------ @--- let env = mkSqlQueryEnv pool $ \\env -> env { retryIf = 10 }--- in runSqlQueryTWith env m--- @+ @+ let env = mkSqlQueryEnv pool $ \\env -> env { retryIf = 10 }+ in runSqlQueryTWith env m+ @+-} mkSqlQueryEnv :: Pool SqlBackend -> (SqlQueryEnv -> SqlQueryEnv) -> SqlQueryEnv-mkSqlQueryEnv backendPool f = f SqlQueryEnv-  { backendPool-  , retryIf = const False-  , retryLimit = 10-  }+mkSqlQueryEnv backendPool f =+  f+    SqlQueryEnv+      { backendPool+      , retryIf = const False+      , retryLimit = 10+      , retryCallback = \_ -> pure ()+      }  -- | The monad transformer that implements 'MonadSqlQuery'. newtype SqlQueryT m a = SqlQueryT   { unSqlQueryT :: ReaderT SqlQueryEnv m a-  } deriving+  }+  deriving     ( Functor     , Applicative     , Monad+    , MonadFix     , MonadIO     , MonadTrans     , MonadResource@@ -209,14 +165,20 @@   withTransaction m = do     SqlQueryEnv{..} <- SqlQueryT ask     withResource backendPool $ \conn ->-      let filterRetry e = if retryIf e then Just e else Nothing-          loop i = catchJust filterRetry (runSqlTransaction conn m) $ \_ ->+      let transactionEnv =+            SqlTransactionEnv+              { sqlBackend = conn+              , ignoreCatch = retryIf -- don't catch retry errors+              }+          filterRetry e = if retryIf e then Just e else Nothing+          loop i = catchJust filterRetry (runSqlTransaction transactionEnv m) $ \e ->             if i < retryLimit               then do-                threadDelay $ 1000 * 2^i+                liftIO $ retryCallback e+                threadDelay $ 1000 * 2 ^ i                 loop $! i + 1               else throwIO RetryLimitExceeded-      in loop 0+       in loop 0  instance MonadUnliftIO m => MonadUnliftIO (SqlQueryT m) where   withRunInIO = wrappedWithRunInIO SqlQueryT unSqlQueryT@@ -225,16 +187,30 @@ mapSqlQueryT f = SqlQueryT . mapReaderT f . unSqlQueryT  instance MonadReader r m => MonadReader r (SqlQueryT m) where-    ask = lift ask-    local = mapSqlQueryT . local+  ask = lift ask+  local = mapSqlQueryT . local +-- | Errors that can occur when running a SQL transaction.+data TransactionError+  = -- | The retry limit was reached when retrying a transaction.+    RetryLimitExceeded+  deriving (Show, Eq)++instance Exception TransactionError+ {- Running SqlQueryT -}  -- | Run the 'SqlQueryT' monad transformer with the given backend. runSqlQueryT :: Pool SqlBackend -> SqlQueryT m a -> m a runSqlQueryT backendPool = runSqlQueryTWith $ mkSqlQueryEnv backendPool id --- | Run the 'SqlQueryT' monad transformer with the explicitly provided--- environment.+{-| Run the 'SqlQueryT' monad transformer with the explicitly provided+ environment.+-} runSqlQueryTWith :: SqlQueryEnv -> SqlQueryT m a -> m a runSqlQueryTWith env = (`runReaderT` env) . unSqlQueryT++{- SqlQueryT environment -}++getSqlBackendPool :: Monad m => SqlQueryT m (Pool SqlBackend)+getSqlBackendPool = SqlQueryT (asks backendPool)

@@ -1,3 +1,7 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableSuperClasses #-}+ {-| Module: Database.Persist.Monad.Class @@ -6,13 +10,9 @@ 'Database.Persist.Monad.SqlQueryRep.SqlQueryRep' sent by a lifted function from @Database.Persist.Monad.Shim@. -}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableSuperClasses #-}--module Database.Persist.Monad.Class-  ( MonadSqlQuery(..)-  ) where+module Database.Persist.Monad.Class (+  MonadSqlQuery (..),+) where  import Control.Monad.Trans.Class (lift) import qualified Control.Monad.Trans.Except as Except

@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}++module Database.Persist.Monad.Internal.PersistentShim (+  SafeToInsert,+) where++#if MIN_VERSION_persistent(2,14,1)+import Database.Persist.Class (SafeToInsert)+#elif MIN_VERSION_persistent(2,14,0)+import Database.Persist.Class.PersistEntity (SafeToInsert)+#endif++#if !MIN_VERSION_persistent(2,14,0)+class SafeToInsert record+instance SafeToInsert record+#endif

@@ -0,0 +1,92 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Database.Persist.Monad.Internal.SqlTransaction (+  SqlTransaction (..),+  SqlTransactionEnv (..),+  runSqlTransaction,+  catchSqlTransaction,+) where++import Control.Monad.Fix (MonadFix)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.IO.Unlift (MonadUnliftIO (..))+import Control.Monad.Reader (ReaderT, ask, withReaderT)+import Database.Persist.Sql (SqlBackend, runSqlConn)+import qualified GHC.TypeLits as GHC+import UnliftIO.Exception (Exception, SomeException, catchJust, fromException)++import Control.Monad.IO.Rerunnable (MonadRerunnableIO)+import Control.Monad.Trans.Rerunnable (MonadRerunnableTrans)+import Database.Persist.Monad.Class+import Database.Persist.Monad.SqlQueryRep++{-| The monad that tracks transaction state.++ Conceptually equivalent to 'Database.Persist.Sql.SqlPersistT', but restricts+ IO operations, for two reasons:++   1. Forking a thread that uses the same 'SqlBackend' as the current thread+      causes Bad Things to happen.+   2. Transactions may need to be retried, in which case IO operations in+      a transaction are required to be rerunnable.++ You shouldn't need to explicitly use this type; your functions should only+ declare the 'MonadSqlQuery' constraint.+-}+newtype SqlTransaction m a = UnsafeSqlTransaction+  { unSqlTransaction :: ReaderT SqlTransactionEnv m a+  }+  deriving (Functor, Applicative, Monad, MonadFix, MonadRerunnableIO, MonadRerunnableTrans)++instance+  ( GHC.TypeError ( 'GHC.Text "Cannot run arbitrary IO actions within a transaction. If the IO action is rerunnable, use rerunnableIO")+  , Monad m+  ) =>+  MonadIO (SqlTransaction m)+  where+  liftIO = undefined++instance (MonadSqlQuery m, MonadUnliftIO m) => MonadSqlQuery (SqlTransaction m) where+  type TransactionM (SqlTransaction m) = TransactionM m++  runQueryRep = UnsafeSqlTransaction . withReaderT sqlBackend . runSqlQueryRep++  -- Delegate to 'm', since 'm' is in charge of starting/stopping transactions.+  -- 'SqlTransaction' is ONLY in charge of executing queries.+  withTransaction = UnsafeSqlTransaction . withTransaction++data SqlTransactionEnv = SqlTransactionEnv+  { sqlBackend :: SqlBackend+  , ignoreCatch :: SomeException -> Bool+  }++runSqlTransaction ::+  MonadUnliftIO m =>+  SqlTransactionEnv ->+  SqlTransaction m a ->+  m a+runSqlTransaction opts =+  (`runSqlConn` sqlBackend opts)+    . withReaderT (\conn -> opts{sqlBackend = conn})+    . unSqlTransaction++-- | Like normal 'catch', except ignores errors specified by 'ignoreCatch'.+catchSqlTransaction ::+  (MonadUnliftIO m, Exception e) =>+  SqlTransaction m a ->+  (e -> SqlTransaction m a) ->+  SqlTransaction m a+catchSqlTransaction (UnsafeSqlTransaction m) handler =+  UnsafeSqlTransaction $ m `catch` (unSqlTransaction . handler)+  where+    catch a b = do+      SqlTransactionEnv{ignoreCatch} <- ask+      catchJust+        (\e -> if ignoreCatch e then Nothing else fromException e)+        a+        b

@@ -1,3 +1,6 @@+{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}+{- FOURMOLU_DISABLE -}+ {-| Module: Database.Persist.Monad.Shim @@ -7,8 +10,6 @@ @Database.Persist.Monad.SqlQueryRep@. -} -{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}- {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}@@ -33,7 +34,9 @@ import Database.Persist.Monad.Class (MonadSqlQuery(..)) import Database.Persist.Monad.SqlQueryRep (SqlQueryRep(..)) -{-# ANN module "HLint: ignore" #-}+#if !MIN_VERSION_persistent(2,14,1)+import Database.Persist.Monad.Internal.PersistentShim (SafeToInsert)+#endif  -- | The lifted version of 'Database.Persist.Sql.get' get@@ -79,25 +82,25 @@  -- | The lifted version of 'Database.Persist.Sql.insert' insert-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => record -> m (Key record) insert a1 = runQueryRep $ Insert a1  -- | The lifted version of 'Database.Persist.Sql.insert_' insert_-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => record -> m () insert_ a1 = runQueryRep $ Insert_ a1  -- | The lifted version of 'Database.Persist.Sql.insertMany' insertMany-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => [record] -> m [Key record] insertMany a1 = runQueryRep $ InsertMany a1  -- | The lifted version of 'Database.Persist.Sql.insertMany_' insertMany_-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => [record] -> m () insertMany_ a1 = runQueryRep $ InsertMany_ a1 @@ -151,13 +154,13 @@  -- | The lifted version of 'Database.Persist.Sql.insertEntity' insertEntity-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => record -> m (Entity record) insertEntity a1 = runQueryRep $ InsertEntity a1  -- | The lifted version of 'Database.Persist.Sql.insertRecord' insertRecord-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => record -> m record insertRecord a1 = runQueryRep $ InsertRecord a1 @@ -167,35 +170,23 @@   => Unique record -> m (Maybe (Entity record)) getBy a1 = runQueryRep $ GetBy a1 -#if MIN_VERSION_persistent(2,10,0) -- | The lifted version of 'Database.Persist.Sql.getByValue' getByValue   :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record, Typeable record, MonadSqlQuery m)   => record -> m (Maybe (Entity record)) getByValue a1 = runQueryRep $ GetByValue a1-#endif -#if !MIN_VERSION_persistent(2,10,0)--- | The lifted version of 'Database.Persist.Sql.getByValue'-getByValue-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)-  => record -> m (Maybe (Entity record))-getByValue a1 = runQueryRep $ GetByValue a1-#endif- -- | The lifted version of 'Database.Persist.Sql.checkUnique' checkUnique   :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)   => record -> m (Maybe (Unique record)) checkUnique a1 = runQueryRep $ CheckUnique a1 -#if MIN_VERSION_persistent(2,11,0) -- | The lifted version of 'Database.Persist.Sql.checkUniqueUpdateable' checkUniqueUpdateable   :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)   => Entity record -> m (Maybe (Unique record)) checkUniqueUpdateable a1 = runQueryRep $ CheckUniqueUpdateable a1-#endif  -- | The lifted version of 'Database.Persist.Sql.deleteBy' deleteBy@@ -205,57 +196,37 @@  -- | The lifted version of 'Database.Persist.Sql.insertUnique' insertUnique-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => record -> m (Maybe (Key record)) insertUnique a1 = runQueryRep $ InsertUnique a1 -#if MIN_VERSION_persistent(2,10,0) -- | The lifted version of 'Database.Persist.Sql.upsert' upsert-  :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record, SafeToInsert record, Typeable record, MonadSqlQuery m)   => record -> [Update record] -> m (Entity record) upsert a1 a2 = runQueryRep $ Upsert a1 a2-#endif -#if !MIN_VERSION_persistent(2,10,0)--- | The lifted version of 'Database.Persist.Sql.upsert'-upsert-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)-  => record -> [Update record] -> m (Entity record)-upsert a1 a2 = runQueryRep $ Upsert a1 a2-#endif- -- | The lifted version of 'Database.Persist.Sql.upsertBy' upsertBy-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => Unique record -> record -> [Update record] -> m (Entity record) upsertBy a1 a2 a3 = runQueryRep $ UpsertBy a1 a2 a3  -- | The lifted version of 'Database.Persist.Sql.putMany' putMany-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => [record] -> m () putMany a1 = runQueryRep $ PutMany a1 -#if MIN_VERSION_persistent(2,10,0) -- | The lifted version of 'Database.Persist.Sql.insertBy' insertBy-  :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record, SafeToInsert record, Typeable record, MonadSqlQuery m)   => record -> m (Either (Entity record) (Key record)) insertBy a1 = runQueryRep $ InsertBy a1-#endif -#if !MIN_VERSION_persistent(2,10,0)--- | The lifted version of 'Database.Persist.Sql.insertBy'-insertBy-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)-  => record -> m (Either (Entity record) (Key record))-insertBy a1 = runQueryRep $ InsertBy a1-#endif- -- | The lifted version of 'Database.Persist.Sql.insertUniqueEntity' insertUniqueEntity-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  :: (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m)   => record -> m (Maybe (Entity record)) insertUniqueEntity a1 = runQueryRep $ InsertUniqueEntity a1 @@ -265,22 +236,12 @@   => Key record -> record -> m (Maybe (Unique record)) replaceUnique a1 a2 = runQueryRep $ ReplaceUnique a1 a2 -#if MIN_VERSION_persistent(2,10,0) -- | The lifted version of 'Database.Persist.Sql.onlyUnique' onlyUnique   :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record, Typeable record, MonadSqlQuery m)   => record -> m (Unique record) onlyUnique a1 = runQueryRep $ OnlyUnique a1-#endif -#if !MIN_VERSION_persistent(2,10,0)--- | The lifted version of 'Database.Persist.Sql.onlyUnique'-onlyUnique-  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)-  => record -> m (Unique record)-onlyUnique a1 = runQueryRep $ OnlyUnique a1-#endif- -- | The lifted version of 'Database.Persist.Sql.selectSourceRes' selectSourceRes   :: (MonadIO m2, PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)@@ -305,13 +266,11 @@   => [Filter record] -> m Int count a1 = runQueryRep $ Count a1 -#if MIN_VERSION_persistent(2,11,0) -- | The lifted version of 'Database.Persist.Sql.exists' exists   :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)   => [Filter record] -> m Bool exists a1 = runQueryRep $ Exists a1-#endif  -- | The lifted version of 'Database.Persist.Sql.selectSource' selectSource@@ -361,22 +320,6 @@   => [Filter record] -> [Update record] -> m Int64 updateWhereCount a1 a2 = runQueryRep $ UpdateWhereCount a1 a2 -#if !MIN_VERSION_persistent(2,13,0)--- | The lifted version of 'Database.Persist.Sql.deleteCascade'-deleteCascade-  :: (DeleteCascade record SqlBackend, Typeable record, MonadSqlQuery m)-  => Key record -> m ()-deleteCascade a1 = runQueryRep $ DeleteCascade a1-#endif--#if !MIN_VERSION_persistent(2,13,0)--- | The lifted version of 'Database.Persist.Sql.deleteCascadeWhere'-deleteCascadeWhere-  :: (DeleteCascade record SqlBackend, Typeable record, MonadSqlQuery m)-  => [Filter record] -> m ()-deleteCascadeWhere a1 = runQueryRep $ DeleteCascadeWhere a1-#endif- -- | The lifted version of 'Database.Persist.Sql.parseMigration' parseMigration   :: (HasCallStack, MonadSqlQuery m)@@ -413,13 +356,11 @@   => Migration -> m () runMigration a1 = runQueryRep $ RunMigration a1 -#if MIN_VERSION_persistent(2,10,2) -- | The lifted version of 'Database.Persist.Sql.runMigrationQuiet' runMigrationQuiet   :: (MonadSqlQuery m)   => Migration -> m [Text] runMigrationQuiet a1 = runQueryRep $ RunMigrationQuiet a1-#endif  -- | The lifted version of 'Database.Persist.Sql.runMigrationSilent' runMigrationSilent@@ -433,13 +374,11 @@   => Migration -> m () runMigrationUnsafe a1 = runQueryRep $ RunMigrationUnsafe a1 -#if MIN_VERSION_persistent(2,10,2) -- | The lifted version of 'Database.Persist.Sql.runMigrationUnsafeQuiet' runMigrationUnsafeQuiet   :: (HasCallStack, MonadSqlQuery m)   => Migration -> m [Text] runMigrationUnsafeQuiet a1 = runQueryRep $ RunMigrationUnsafeQuiet a1-#endif  -- | The lifted version of 'Database.Persist.Sql.getFieldName' getFieldName@@ -495,13 +434,11 @@   => m () transactionSave = runQueryRep $ TransactionSave -#if MIN_VERSION_persistent(2,9,0) -- | The lifted version of 'Database.Persist.Sql.transactionSaveWithIsolation' transactionSaveWithIsolation   :: (MonadSqlQuery m)   => IsolationLevel -> m () transactionSaveWithIsolation a1 = runQueryRep $ TransactionSaveWithIsolation a1-#endif  -- | The lifted version of 'Database.Persist.Sql.transactionUndo' transactionUndo@@ -509,13 +446,11 @@   => m () transactionUndo = runQueryRep $ TransactionUndo -#if MIN_VERSION_persistent(2,9,0) -- | The lifted version of 'Database.Persist.Sql.transactionUndoWithIsolation' transactionUndoWithIsolation   :: (MonadSqlQuery m)   => IsolationLevel -> m () transactionUndoWithIsolation a1 = runQueryRep $ TransactionUndoWithIsolation a1-#endif  -- | Lift an arbitrary 'SqlPersistT' action into 'MonadSqlQuery'. --

@@ -1,3 +1,6 @@+{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}+{- FOURMOLU_DISABLE -}+ {-| Module: Database.Persist.Monad.SqlQueryRep @@ -8,8 +11,6 @@ @Database.Persist.Monad.Shim@. -} -{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}- {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}@@ -38,7 +39,9 @@ import Database.Persist.Sql as Persist hiding (pattern Update) import GHC.Stack (HasCallStack) -{-# ANN module "HLint: ignore" #-}+#if !MIN_VERSION_persistent(2,14,1)+import Database.Persist.Monad.Internal.PersistentShim (SafeToInsert)+#endif  -- | The data type containing a constructor for each persistent function we'd -- like to lift into 'Database.Persist.Monad.MonadSqlQuery'.@@ -87,22 +90,22 @@    -- | Constructor corresponding to 'Persist.insert'   Insert-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => record -> SqlQueryRep record (Key record)    -- | Constructor corresponding to 'Persist.insert_'   Insert_-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => record -> SqlQueryRep record ()    -- | Constructor corresponding to 'Persist.insertMany'   InsertMany-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => [record] -> SqlQueryRep record [Key record]    -- | Constructor corresponding to 'Persist.insertMany_'   InsertMany_-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => [record] -> SqlQueryRep record ()    -- | Constructor corresponding to 'Persist.insertEntityMany'@@ -147,12 +150,12 @@    -- | Constructor corresponding to 'Persist.insertEntity'   InsertEntity-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => record -> SqlQueryRep record (Entity record)    -- | Constructor corresponding to 'Persist.insertRecord'   InsertRecord-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => record -> SqlQueryRep record record    -- | Constructor corresponding to 'Persist.getBy'@@ -160,31 +163,20 @@     :: (PersistRecordBackend record SqlBackend)     => Unique record -> SqlQueryRep record (Maybe (Entity record)) -#if MIN_VERSION_persistent(2,10,0)   -- | Constructor corresponding to 'Persist.getByValue'   GetByValue     :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record)     => record -> SqlQueryRep record (Maybe (Entity record))-#endif -#if !MIN_VERSION_persistent(2,10,0)-  -- | Constructor corresponding to 'Persist.getByValue'-  GetByValue-    :: (PersistRecordBackend record SqlBackend)-    => record -> SqlQueryRep record (Maybe (Entity record))-#endif-   -- | Constructor corresponding to 'Persist.checkUnique'   CheckUnique     :: (PersistRecordBackend record SqlBackend)     => record -> SqlQueryRep record (Maybe (Unique record)) -#if MIN_VERSION_persistent(2,11,0)   -- | Constructor corresponding to 'Persist.checkUniqueUpdateable'   CheckUniqueUpdateable     :: (PersistRecordBackend record SqlBackend)     => Entity record -> SqlQueryRep record (Maybe (Unique record))-#endif    -- | Constructor corresponding to 'Persist.deleteBy'   DeleteBy@@ -193,50 +185,32 @@    -- | Constructor corresponding to 'Persist.insertUnique'   InsertUnique-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => record -> SqlQueryRep record (Maybe (Key record)) -#if MIN_VERSION_persistent(2,10,0)   -- | Constructor corresponding to 'Persist.upsert'   Upsert-    :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record)+    :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record, SafeToInsert record)     => record -> [Update record] -> SqlQueryRep record (Entity record)-#endif -#if !MIN_VERSION_persistent(2,10,0)-  -- | Constructor corresponding to 'Persist.upsert'-  Upsert-    :: (PersistRecordBackend record SqlBackend)-    => record -> [Update record] -> SqlQueryRep record (Entity record)-#endif-   -- | Constructor corresponding to 'Persist.upsertBy'   UpsertBy-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => Unique record -> record -> [Update record] -> SqlQueryRep record (Entity record)    -- | Constructor corresponding to 'Persist.putMany'   PutMany-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => [record] -> SqlQueryRep record () -#if MIN_VERSION_persistent(2,10,0)   -- | Constructor corresponding to 'Persist.insertBy'   InsertBy-    :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record)+    :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record, SafeToInsert record)     => record -> SqlQueryRep record (Either (Entity record) (Key record))-#endif -#if !MIN_VERSION_persistent(2,10,0)-  -- | Constructor corresponding to 'Persist.insertBy'-  InsertBy-    :: (PersistRecordBackend record SqlBackend)-    => record -> SqlQueryRep record (Either (Entity record) (Key record))-#endif-   -- | Constructor corresponding to 'Persist.insertUniqueEntity'   InsertUniqueEntity-    :: (PersistRecordBackend record SqlBackend)+    :: (PersistRecordBackend record SqlBackend, SafeToInsert record)     => record -> SqlQueryRep record (Maybe (Entity record))    -- | Constructor corresponding to 'Persist.replaceUnique'@@ -244,20 +218,11 @@     :: (PersistRecordBackend record SqlBackend, Eq (Unique record), Eq record)     => Key record -> record -> SqlQueryRep record (Maybe (Unique record)) -#if MIN_VERSION_persistent(2,10,0)   -- | Constructor corresponding to 'Persist.onlyUnique'   OnlyUnique     :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record)     => record -> SqlQueryRep record (Unique record)-#endif -#if !MIN_VERSION_persistent(2,10,0)-  -- | Constructor corresponding to 'Persist.onlyUnique'-  OnlyUnique-    :: (PersistRecordBackend record SqlBackend)-    => record -> SqlQueryRep record (Unique record)-#endif-   -- | Constructor corresponding to 'Persist.selectSourceRes'   SelectSourceRes     :: (MonadIO m2, PersistRecordBackend record SqlBackend)@@ -278,12 +243,10 @@     :: (PersistRecordBackend record SqlBackend)     => [Filter record] -> SqlQueryRep record Int -#if MIN_VERSION_persistent(2,11,0)   -- | Constructor corresponding to 'Persist.exists'   Exists     :: (PersistRecordBackend record SqlBackend)     => [Filter record] -> SqlQueryRep record Bool-#endif    -- | Constructor corresponding to 'Persist.selectList'   SelectList@@ -315,20 +278,6 @@     :: (PersistRecordBackend record SqlBackend)     => [Filter record] -> [Update record] -> SqlQueryRep record Int64 -#if !MIN_VERSION_persistent(2,13,0)-  -- | Constructor corresponding to 'Persist.deleteCascade'-  DeleteCascade-    :: (DeleteCascade record SqlBackend)-    => Key record -> SqlQueryRep record ()-#endif--#if !MIN_VERSION_persistent(2,13,0)-  -- | Constructor corresponding to 'Persist.deleteCascadeWhere'-  DeleteCascadeWhere-    :: (DeleteCascade record SqlBackend)-    => [Filter record] -> SqlQueryRep record ()-#endif-   -- | Constructor corresponding to 'Persist.parseMigration'   ParseMigration     :: (HasCallStack)@@ -359,12 +308,10 @@     :: ()     => Migration -> SqlQueryRep Void () -#if MIN_VERSION_persistent(2,10,2)   -- | Constructor corresponding to 'Persist.runMigrationQuiet'   RunMigrationQuiet     :: ()     => Migration -> SqlQueryRep Void [Text]-#endif    -- | Constructor corresponding to 'Persist.runMigrationSilent'   RunMigrationSilent@@ -376,12 +323,10 @@     :: ()     => Migration -> SqlQueryRep Void () -#if MIN_VERSION_persistent(2,10,2)   -- | Constructor corresponding to 'Persist.runMigrationUnsafeQuiet'   RunMigrationUnsafeQuiet     :: (HasCallStack)     => Migration -> SqlQueryRep Void [Text]-#endif    -- | Constructor corresponding to 'Persist.getFieldName'   GetFieldName@@ -423,24 +368,20 @@     :: ()     => SqlQueryRep Void () -#if MIN_VERSION_persistent(2,9,0)   -- | Constructor corresponding to 'Persist.transactionSaveWithIsolation'   TransactionSaveWithIsolation     :: ()     => IsolationLevel -> SqlQueryRep Void ()-#endif    -- | Constructor corresponding to 'Persist.transactionUndo'   TransactionUndo     :: ()     => SqlQueryRep Void () -#if MIN_VERSION_persistent(2,9,0)   -- | Constructor corresponding to 'Persist.transactionUndoWithIsolation'   TransactionUndoWithIsolation     :: ()     => IsolationLevel -> SqlQueryRep Void ()-#endif    -- | Constructor for lifting an arbitrary SqlPersistT action into SqlQueryRep.   UnsafeLiftSql@@ -470,73 +411,39 @@     InsertEntity{} -> "InsertEntity{..}" ++ record     InsertRecord{} -> "InsertRecord{..}" ++ record     GetBy{} -> "GetBy{..}" ++ record-#if MIN_VERSION_persistent(2,10,0)     GetByValue{} -> "GetByValue{..}" ++ record-#endif-#if !MIN_VERSION_persistent(2,10,0)-    GetByValue{} -> "GetByValue{..}" ++ record-#endif     CheckUnique{} -> "CheckUnique{..}" ++ record-#if MIN_VERSION_persistent(2,11,0)     CheckUniqueUpdateable{} -> "CheckUniqueUpdateable{..}" ++ record-#endif     DeleteBy{} -> "DeleteBy{..}" ++ record     InsertUnique{} -> "InsertUnique{..}" ++ record-#if MIN_VERSION_persistent(2,10,0)     Upsert{} -> "Upsert{..}" ++ record-#endif-#if !MIN_VERSION_persistent(2,10,0)-    Upsert{} -> "Upsert{..}" ++ record-#endif     UpsertBy{} -> "UpsertBy{..}" ++ record     PutMany{} -> "PutMany{..}" ++ record-#if MIN_VERSION_persistent(2,10,0)     InsertBy{} -> "InsertBy{..}" ++ record-#endif-#if !MIN_VERSION_persistent(2,10,0)-    InsertBy{} -> "InsertBy{..}" ++ record-#endif     InsertUniqueEntity{} -> "InsertUniqueEntity{..}" ++ record     ReplaceUnique{} -> "ReplaceUnique{..}" ++ record-#if MIN_VERSION_persistent(2,10,0)     OnlyUnique{} -> "OnlyUnique{..}" ++ record-#endif-#if !MIN_VERSION_persistent(2,10,0)-    OnlyUnique{} -> "OnlyUnique{..}" ++ record-#endif     SelectSourceRes{} -> "SelectSourceRes{..}" ++ record     SelectFirst{} -> "SelectFirst{..}" ++ record     SelectKeysRes{} -> "SelectKeysRes{..}" ++ record     Count{} -> "Count{..}" ++ record-#if MIN_VERSION_persistent(2,11,0)     Exists{} -> "Exists{..}" ++ record-#endif     SelectList{} -> "SelectList{..}" ++ record     SelectKeysList{} -> "SelectKeysList{..}" ++ record     UpdateWhere{} -> "UpdateWhere{..}" ++ record     DeleteWhere{} -> "DeleteWhere{..}" ++ record     DeleteWhereCount{} -> "DeleteWhereCount{..}" ++ record     UpdateWhereCount{} -> "UpdateWhereCount{..}" ++ record-#if !MIN_VERSION_persistent(2,13,0)-    DeleteCascade{} -> "DeleteCascade{..}" ++ record-#endif-#if !MIN_VERSION_persistent(2,13,0)-    DeleteCascadeWhere{} -> "DeleteCascadeWhere{..}" ++ record-#endif     ParseMigration{} -> "ParseMigration{..}" ++ record     ParseMigration'{} -> "ParseMigration'{..}" ++ record     PrintMigration{} -> "PrintMigration{..}" ++ record     ShowMigration{} -> "ShowMigration{..}" ++ record     GetMigration{} -> "GetMigration{..}" ++ record     RunMigration{} -> "RunMigration{..}" ++ record-#if MIN_VERSION_persistent(2,10,2)     RunMigrationQuiet{} -> "RunMigrationQuiet{..}" ++ record-#endif     RunMigrationSilent{} -> "RunMigrationSilent{..}" ++ record     RunMigrationUnsafe{} -> "RunMigrationUnsafe{..}" ++ record-#if MIN_VERSION_persistent(2,10,2)     RunMigrationUnsafeQuiet{} -> "RunMigrationUnsafeQuiet{..}" ++ record-#endif     GetFieldName{} -> "GetFieldName{..}" ++ record     GetTableName{} -> "GetTableName{..}" ++ record     WithRawQuery{} -> "WithRawQuery{..}" ++ record@@ -545,13 +452,9 @@     RawExecuteCount{} -> "RawExecuteCount{..}" ++ record     RawSql{} -> "RawSql{..}" ++ record     TransactionSave{} -> "TransactionSave{..}" ++ record-#if MIN_VERSION_persistent(2,9,0)     TransactionSaveWithIsolation{} -> "TransactionSaveWithIsolation{..}" ++ record-#endif     TransactionUndo{} -> "TransactionUndo{..}" ++ record-#if MIN_VERSION_persistent(2,9,0)     TransactionUndoWithIsolation{} -> "TransactionUndoWithIsolation{..}" ++ record-#endif     UnsafeLiftSql label _ -> "UnsafeLiftSql{" ++ Text.unpack label ++ "}"     where       record = case recordTypeRep of@@ -587,73 +490,39 @@   InsertEntity a1 -> Persist.insertEntity a1   InsertRecord a1 -> Persist.insertRecord a1   GetBy a1 -> Persist.getBy a1-#if MIN_VERSION_persistent(2,10,0)   GetByValue a1 -> Persist.getByValue a1-#endif-#if !MIN_VERSION_persistent(2,10,0)-  GetByValue a1 -> Persist.getByValue a1-#endif   CheckUnique a1 -> Persist.checkUnique a1-#if MIN_VERSION_persistent(2,11,0)   CheckUniqueUpdateable a1 -> Persist.checkUniqueUpdateable a1-#endif   DeleteBy a1 -> Persist.deleteBy a1   InsertUnique a1 -> Persist.insertUnique a1-#if MIN_VERSION_persistent(2,10,0)   Upsert a1 a2 -> Persist.upsert a1 a2-#endif-#if !MIN_VERSION_persistent(2,10,0)-  Upsert a1 a2 -> Persist.upsert a1 a2-#endif   UpsertBy a1 a2 a3 -> Persist.upsertBy a1 a2 a3   PutMany a1 -> Persist.putMany a1-#if MIN_VERSION_persistent(2,10,0)   InsertBy a1 -> Persist.insertBy a1-#endif-#if !MIN_VERSION_persistent(2,10,0)-  InsertBy a1 -> Persist.insertBy a1-#endif   InsertUniqueEntity a1 -> Persist.insertUniqueEntity a1   ReplaceUnique a1 a2 -> Persist.replaceUnique a1 a2-#if MIN_VERSION_persistent(2,10,0)   OnlyUnique a1 -> Persist.onlyUnique a1-#endif-#if !MIN_VERSION_persistent(2,10,0)-  OnlyUnique a1 -> Persist.onlyUnique a1-#endif   SelectSourceRes a1 a2 -> Persist.selectSourceRes a1 a2   SelectFirst a1 a2 -> Persist.selectFirst a1 a2   SelectKeysRes a1 a2 -> Persist.selectKeysRes a1 a2   Count a1 -> Persist.count a1-#if MIN_VERSION_persistent(2,11,0)   Exists a1 -> Persist.exists a1-#endif   SelectList a1 a2 -> Persist.selectList a1 a2   SelectKeysList a1 a2 -> Persist.selectKeysList a1 a2   UpdateWhere a1 a2 -> Persist.updateWhere a1 a2   DeleteWhere a1 -> Persist.deleteWhere a1   DeleteWhereCount a1 -> Persist.deleteWhereCount a1   UpdateWhereCount a1 a2 -> Persist.updateWhereCount a1 a2-#if !MIN_VERSION_persistent(2,13,0)-  DeleteCascade a1 -> Persist.deleteCascade a1-#endif-#if !MIN_VERSION_persistent(2,13,0)-  DeleteCascadeWhere a1 -> Persist.deleteCascadeWhere a1-#endif   ParseMigration a1 -> Persist.parseMigration a1   ParseMigration' a1 -> Persist.parseMigration' a1   PrintMigration a1 -> Persist.printMigration a1   ShowMigration a1 -> Persist.showMigration a1   GetMigration a1 -> Persist.getMigration a1   RunMigration a1 -> Persist.runMigration a1-#if MIN_VERSION_persistent(2,10,2)   RunMigrationQuiet a1 -> Persist.runMigrationQuiet a1-#endif   RunMigrationSilent a1 -> Persist.runMigrationSilent a1   RunMigrationUnsafe a1 -> Persist.runMigrationUnsafe a1-#if MIN_VERSION_persistent(2,10,2)   RunMigrationUnsafeQuiet a1 -> Persist.runMigrationUnsafeQuiet a1-#endif   GetFieldName a1 -> Persist.getFieldName a1   GetTableName a1 -> Persist.getTableName a1   WithRawQuery a1 a2 a3 -> Persist.withRawQuery a1 a2 a3@@ -662,11 +531,7 @@   RawExecuteCount a1 a2 -> Persist.rawExecuteCount a1 a2   RawSql a1 a2 -> Persist.rawSql a1 a2   TransactionSave -> Persist.transactionSave-#if MIN_VERSION_persistent(2,9,0)   TransactionSaveWithIsolation a1 -> Persist.transactionSaveWithIsolation a1-#endif   TransactionUndo -> Persist.transactionUndo-#if MIN_VERSION_persistent(2,9,0)   TransactionUndoWithIsolation a1 -> Persist.transactionUndoWithIsolation a1-#endif   UnsafeLiftSql _ action -> action

@@ -1,10 +1,3 @@-{-|-Module: Database.Persist.Monad.TestUtils--Defines 'MockSqlQueryT', which one can use in tests in order to mock out-@persistent@ database queries called in production code.--}- {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}@@ -13,44 +6,57 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -module Database.Persist.Monad.TestUtils-  ( MockSqlQueryT-  , runMockSqlQueryT-  , withRecord-  , mockQuery-  , MockQuery+{-|+Module: Database.Persist.Monad.TestUtils +Defines 'MockSqlQueryT', which one can use in tests in order to mock out+@persistent@ database queries called in production code.+-}+module Database.Persist.Monad.TestUtils (+  MockSqlQueryT,+  runMockSqlQueryT,+  withRecord,+  mockQuery,+  MockQuery,+   -- * Specialized helpers-  , mockSelectSource-  , mockSelectKeys-  , mockWithRawQuery-  , mockRawQuery-  , mockRawSql+  mockSelectSource,+  mockSelectKeys,+  mockWithRawQuery,+  mockRawQuery,+  mockRawSql,    -- * Re-exports-  , SqlQueryRep(..)-  ) where+  SqlQueryRep (..),+) where  import Conduit ((.|)) import qualified Conduit import Control.Monad (msum)-import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Reader (ReaderT, ask, runReaderT) import Control.Monad.Trans.Resource (MonadResource) import qualified Data.Acquire as Acquire import Data.Text (Text) import qualified Data.Text as Text-import Data.Typeable (Typeable, eqT, (:~:)(..))-import Database.Persist.Sql-    (Entity, Filter, Key, PersistValue, SelectOpt, rawSqlProcessRow)+import Data.Typeable (Typeable, eqT, (:~:) (..))+import Database.Persist.Sql (+  Entity,+  Filter,+  Key,+  PersistValue,+  SelectOpt,+  rawSqlProcessRow,+ ) -import Database.Persist.Monad.Class (MonadSqlQuery(..))-import Database.Persist.Monad.SqlQueryRep (SqlQueryRep(..))+import Database.Persist.Monad.Class (MonadSqlQuery (..))+import Database.Persist.Monad.SqlQueryRep (SqlQueryRep (..))  -- | A monad transformer for testing functions that use 'MonadSqlQuery'. newtype MockSqlQueryT m a = MockSqlQueryT   { unMockSqlQueryT :: ReaderT [MockQuery] m a-  } deriving+  }+  deriving     ( Functor     , Applicative     , Monad@@ -58,34 +64,35 @@     , MonadResource     ) --- | Runs a 'MockSqlQueryT' monad transformer using the given mocks.------ When a database query is executed, the first mock that returns a 'Just' is--- returned. If no mocks match the query, an error is thrown. See 'SqlQueryRep'--- for the constructors available to match against. Most of the time, you'll--- want to use 'withRecord' to only match queries against a specific @record@--- type (e.g. only match 'Database.Persist.Monad.Shim.selectList' calls for--- the @Person@ entity).------ Usage:------ @--- myFunction :: MonadSqlQuery m => m [String]--- myFunction = map personName <$> selectList [PersonAge >. 25] []------ let persons = [Person ...]--- result <- runMockSqlQueryT myFunction---   [ withRecord \@Person $ \\case---       SelectList _ _ -> Just persons---       _ -> Nothing---   , withRecord \@Post $ \\case---       Insert Post{ name = "post1" } -> Just $ toSqlKey 1---       _ -> Nothing---   , mockQuery $ \\case---       RawExecuteCount "DELETE FROM person WHERE name = \'Alice\'" [] -> Just 1---       _ -> Nothing---   ]--- @+{-| Runs a 'MockSqlQueryT' monad transformer using the given mocks.++ When a database query is executed, the first mock that returns a 'Just' is+ returned. If no mocks match the query, an error is thrown. See 'SqlQueryRep'+ for the constructors available to match against. Most of the time, you'll+ want to use 'withRecord' to only match queries against a specific @record@+ type (e.g. only match 'Database.Persist.Monad.Shim.selectList' calls for+ the @Person@ entity).++ Usage:++ @+ myFunction :: MonadSqlQuery m => m [String]+ myFunction = map personName <$> selectList [PersonAge >. 25] []++ let persons = [Person ...]+ result <- runMockSqlQueryT myFunction+   [ withRecord \@Person $ \\case+       SelectList _ _ -> Just persons+       _ -> Nothing+   , withRecord \@Post $ \\case+       Insert Post{ name = "post1" } -> Just $ toSqlKey 1+       _ -> Nothing+   , mockQuery $ \\case+       RawExecuteCount "DELETE FROM person WHERE name = \'Alice\'" [] -> Just 1+       _ -> Nothing+   ]+ @+-} runMockSqlQueryT :: MockSqlQueryT m a -> [MockQuery] -> m a runMockSqlQueryT action mockQueries = (`runReaderT` mockQueries) . unMockSqlQueryT $ action @@ -94,149 +101,158 @@    runQueryRep rep = do     mockQueries <- MockSqlQueryT ask-    maybe (error $ "Could not find mock for query: " ++ show rep) liftIO-      $ msum $ map tryMockQuery mockQueries+    maybe (error $ "Could not find mock for query: " ++ show rep) liftIO $+      msum $+        map tryMockQuery mockQueries     where       tryMockQuery (MockQuery f) = f rep    withTransaction = id --- | A mocked query to use in 'runMockSqlQueryT'.------ Use 'withRecord' or another helper to create a 'MockQuery'.+{-| A mocked query to use in 'runMockSqlQueryT'.++ Use 'withRecord' or another helper to create a 'MockQuery'.+-} data MockQuery = MockQuery (forall record a. Typeable record => SqlQueryRep record a -> Maybe (IO a)) --- | A helper for defining a mocked database query against a specific @record@--- type. Designed to be used with TypeApplications.------ Most 'SqlQueryRep' constructors are in the context of a specific @record@--- type, like @Person@. This helper only matches mocked database queries that--- are querying the record you specify.------ Some constructors reference multiple @record@ types, like--- 'Database.Persist.Monad.BelongsTo'. Look at the type to see the record you--- need to match against. For example,------ @--- withRecord \@(Person, Post) $ \\case---   BelongsTo _ _ -> ...--- @------ would match the function call------ @--- belongsTo :: (Person -> Maybe (Key Post)) -> Person -> SqlQueryRep (Person, Post) (Maybe Post)--- @+{-| A helper for defining a mocked database query against a specific @record@+ type. Designed to be used with TypeApplications.++ Most 'SqlQueryRep' constructors are in the context of a specific @record@+ type, like @Person@. This helper only matches mocked database queries that+ are querying the record you specify.++ Some constructors reference multiple @record@ types, like+ 'Database.Persist.Monad.BelongsTo'. Look at the type to see the record you+ need to match against. For example,++ @+ withRecord \@(Person, Post) $ \\case+   BelongsTo _ _ -> ...+ @++ would match the function call++ @+ belongsTo :: (Person -> Maybe (Key Post)) -> Person -> SqlQueryRep (Person, Post) (Maybe Post)+ @+-} withRecord :: forall record. Typeable record => (forall a. SqlQueryRep record a -> Maybe a) -> MockQuery withRecord f = MockQuery $ \(rep :: SqlQueryRep someRecord result) ->   case eqT @record @someRecord of     Just Refl -> pure <$> f rep     Nothing -> Nothing --- | A helper for defining a mocked database query.------ This does not do any matching on the @record@ type, so it is mostly useful--- for queries that don't use the @record@ type, like--- 'Database.Persist.Monad.Shim.rawExecute'.+{-| A helper for defining a mocked database query.++ This does not do any matching on the @record@ type, so it is mostly useful+ for queries that don't use the @record@ type, like+ 'Database.Persist.Monad.Shim.rawExecute'.+-} mockQuery :: (forall record a. Typeable record => SqlQueryRep record a -> Maybe a) -> MockQuery mockQuery f = MockQuery (fmap pure . f) --- | A helper for mocking a 'Database.Persist.Monad.Shim.selectSource' or--- 'Database.Persist.Monad.Shim.selectSourceRes' call.------ Usage:------ @--- mockSelectSource $ \\filters opts ->---   if null filters && null opts---     then---       let person1 = [Entity (toSqlKey 1) $ Person \"Alice\"]---           person2 = [Entity (toSqlKey 2) $ Person \"Bob\"]---       in Just [person1, person2]---     else Nothing--- @+{-| A helper for mocking a 'Database.Persist.Monad.Shim.selectSource' or+ 'Database.Persist.Monad.Shim.selectSourceRes' call.++ Usage:++ @+ mockSelectSource $ \\filters opts ->+   if null filters && null opts+     then+       let person1 = [Entity (toSqlKey 1) $ Person \"Alice\"]+           person2 = [Entity (toSqlKey 2) $ Person \"Bob\"]+       in Just [person1, person2]+     else Nothing+ @+-} mockSelectSource :: forall record. Typeable record => ([Filter record] -> [SelectOpt record] -> Maybe [Entity record]) -> MockQuery mockSelectSource f = withRecord @record $ \case   SelectSourceRes filters opts ->     let toAcquire entities = Acquire.mkAcquire (pure $ Conduit.yieldMany entities) (\_ -> pure ())-    in toAcquire <$> f filters opts+     in toAcquire <$> f filters opts   _ -> Nothing --- | A helper for mocking a 'Database.Persist.Monad.Shim.selectKeys' or--- 'Database.Persist.Monad.Shim.selectKeysRes' call.------ Usage:------ @--- mockSelectKeys $ \\filters opts ->---   if null filters && null opts---     then Just $ map toSqlKey [1, 2]---     else Nothing--- @+{-| A helper for mocking a 'Database.Persist.Monad.Shim.selectKeys' or+ 'Database.Persist.Monad.Shim.selectKeysRes' call.++ Usage:++ @+ mockSelectKeys $ \\filters opts ->+   if null filters && null opts+     then Just $ map toSqlKey [1, 2]+     else Nothing+ @+-} mockSelectKeys :: forall record. Typeable record => ([Filter record] -> [SelectOpt record] -> Maybe [Key record]) -> MockQuery mockSelectKeys f = withRecord @record $ \case   SelectKeysRes filters opts ->     let toAcquire keys = Acquire.mkAcquire (pure $ Conduit.yieldMany keys) (\_ -> pure ())-    in toAcquire <$> f filters opts+     in toAcquire <$> f filters opts   _ -> Nothing --- | A helper for mocking a 'Database.Persist.Monad.Shim.withRawQuery' call.------ Usage:------ @--- mockWithRawQuery $ \\sql vals ->---   if sql == "SELECT id, name FROM person"---     then---       let row1 = [toPersistValue 1, toPersistValue \"Alice\"]---           row2 = [toPersistValue 2, toPersistValue \"Bob\"]---       in Just [row1, row2]---     else Nothing--- @+{-| A helper for mocking a 'Database.Persist.Monad.Shim.withRawQuery' call.++ Usage:++ @+ mockWithRawQuery $ \\sql vals ->+   if sql == "SELECT id, name FROM person"+     then+       let row1 = [toPersistValue 1, toPersistValue \"Alice\"]+           row2 = [toPersistValue 2, toPersistValue \"Bob\"]+       in Just [row1, row2]+     else Nothing+ @+-} mockWithRawQuery :: (Text -> [PersistValue] -> Maybe [[PersistValue]]) -> MockQuery mockWithRawQuery f = MockQuery $ \case   WithRawQuery sql vals conduit ->     let outputRows rows = Conduit.runConduit $ Conduit.yieldMany rows .| conduit-    in outputRows <$> f sql vals+     in outputRows <$> f sql vals   _ -> Nothing --- | A helper for mocking a 'Database.Persist.Monad.Shim.rawQuery' or--- 'Database.Persist.Monad.Shim.rawQueryRes' call.------ Usage:------ @--- mockRawQuery $ \\sql vals ->---   if sql == "SELECT id, name FROM person"---     then---       let row1 = [toPersistValue 1, toPersistValue \"Alice\"]---           row2 = [toPersistValue 2, toPersistValue \"Bob\"]---       in Just [row1, row2]---     else Nothing--- @+{-| A helper for mocking a 'Database.Persist.Monad.Shim.rawQuery' or+ 'Database.Persist.Monad.Shim.rawQueryRes' call.++ Usage:++ @+ mockRawQuery $ \\sql vals ->+   if sql == "SELECT id, name FROM person"+     then+       let row1 = [toPersistValue 1, toPersistValue \"Alice\"]+           row2 = [toPersistValue 2, toPersistValue \"Bob\"]+       in Just [row1, row2]+     else Nothing+ @+-} mockRawQuery :: (Text -> [PersistValue] -> Maybe [[PersistValue]]) -> MockQuery mockRawQuery f = MockQuery $ \case   RawQueryRes sql vals ->     let toAcquire rows = Acquire.mkAcquire (pure $ Conduit.yieldMany rows) (\_ -> pure ())-    in pure . toAcquire <$> f sql vals+     in pure . toAcquire <$> f sql vals   _ -> Nothing --- | A helper for mocking a 'Database.Persist.Monad.Shim.rawSql' call.------ Usage:------ @--- mockRawSql $ \\sql vals ->---   if sql == "SELECT id, name FROM person"---     then---       let row1 = [toPersistValue 1, toPersistValue \"Alice\"]---           row2 = [toPersistValue 2, toPersistValue \"Bob\"]---       in Just [row1, row2]---     else Nothing--- @+{-| A helper for mocking a 'Database.Persist.Monad.Shim.rawSql' call.++ Usage:++ @+ mockRawSql $ \\sql vals ->+   if sql == "SELECT id, name FROM person"+     then+       let row1 = [toPersistValue 1, toPersistValue \"Alice\"]+           row2 = [toPersistValue 2, toPersistValue \"Bob\"]+       in Just [row1, row2]+     else Nothing+ @+-} mockRawSql :: (Text -> [PersistValue] -> Maybe [[PersistValue]]) -> MockQuery mockRawSql f = MockQuery $ \case   RawSql sql vals ->     let fromRow = either (error . Text.unpack) id . rawSqlProcessRow-    in pure . map fromRow <$> f sql vals+     in pure . map fromRow <$> f sql vals   _ -> Nothing

@@ -0,0 +1,233 @@+{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}+{- FOURMOLU_DISABLE -}++{-|+Module: Database.Persist.Sql.Shim++Defines all the @persistent@ functions lifted into 'MonadSqlQuery', and+re-exports a version of the @Database.Persist.Sql@ module replacing each+function with the lifted version.++This file is autogenerated, to keep it in sync with+@Database.Persist.Monad.Shim@.+-}++{-# LANGUAGE CPP #-}++module Database.Persist.Sql.Shim (+  module Database.Persist.Sql,+  get,+  getMany,+  getJust,+  getJustEntity,+  getEntity,+  belongsTo,+  belongsToJust,+  insert,+  insert_,+  insertMany,+  insertMany_,+  insertEntityMany,+  insertKey,+  repsert,+  repsertMany,+  replace,+  delete,+  update,+  updateGet,+  insertEntity,+  insertRecord,+  getBy,+  getByValue,+  checkUnique,+  checkUniqueUpdateable,+  deleteBy,+  insertUnique,+  upsert,+  upsertBy,+  putMany,+  insertBy,+  insertUniqueEntity,+  replaceUnique,+  onlyUnique,+  selectSourceRes,+  selectFirst,+  selectKeysRes,+  count,+  exists,+  selectSource,+  selectKeys,+  selectList,+  selectKeysList,+  updateWhere,+  deleteWhere,+  deleteWhereCount,+  updateWhereCount,+  parseMigration,+  parseMigration',+  printMigration,+  showMigration,+  getMigration,+  runMigration,+  runMigrationQuiet,+  runMigrationSilent,+  runMigrationUnsafe,+  runMigrationUnsafeQuiet,+  getFieldName,+  getTableName,+  withRawQuery,+  rawQueryRes,+  rawQuery,+  rawExecute,+  rawExecuteCount,+  rawSql,+  transactionSave,+  transactionSaveWithIsolation,+  transactionUndo,+  transactionUndoWithIsolation,+  unsafeLiftSql,+  ) where++import Database.Persist.Monad.Shim (+    get,+    getMany,+    getJust,+    getJustEntity,+    getEntity,+    belongsTo,+    belongsToJust,+    insert,+    insert_,+    insertMany,+    insertMany_,+    insertEntityMany,+    insertKey,+    repsert,+    repsertMany,+    replace,+    delete,+    update,+    updateGet,+    insertEntity,+    insertRecord,+    getBy,+    getByValue,+    checkUnique,+    checkUniqueUpdateable,+    deleteBy,+    insertUnique,+    upsert,+    upsertBy,+    putMany,+    insertBy,+    insertUniqueEntity,+    replaceUnique,+    onlyUnique,+    selectSourceRes,+    selectFirst,+    selectKeysRes,+    count,+    exists,+    selectSource,+    selectKeys,+    selectList,+    selectKeysList,+    updateWhere,+    deleteWhere,+    deleteWhereCount,+    updateWhereCount,+    parseMigration,+    parseMigration',+    printMigration,+    showMigration,+    getMigration,+    runMigration,+    runMigrationQuiet,+    runMigrationSilent,+    runMigrationUnsafe,+    runMigrationUnsafeQuiet,+    getFieldName,+    getTableName,+    withRawQuery,+    rawQueryRes,+    rawQuery,+    rawExecute,+    rawExecuteCount,+    rawSql,+    transactionSave,+    transactionSaveWithIsolation,+    transactionUndo,+    transactionUndoWithIsolation,+    unsafeLiftSql+    )+import Database.Persist.Sql hiding (+    get,+    getMany,+    getJust,+    getJustEntity,+    getEntity,+    belongsTo,+    belongsToJust,+    insert,+    insert_,+    insertMany,+    insertMany_,+    insertEntityMany,+    insertKey,+    repsert,+    repsertMany,+    replace,+    delete,+    update,+    updateGet,+    insertEntity,+    insertRecord,+    getBy,+    getByValue,+    checkUnique,+    checkUniqueUpdateable,+    deleteBy,+    insertUnique,+    upsert,+    upsertBy,+    putMany,+    insertBy,+    insertUniqueEntity,+    replaceUnique,+    onlyUnique,+    selectSourceRes,+    selectFirst,+    selectKeysRes,+    count,+    exists,+    selectSource,+    selectKeys,+    selectList,+    selectKeysList,+    updateWhere,+    deleteWhere,+    deleteWhereCount,+    updateWhereCount,+    parseMigration,+    parseMigration',+    printMigration,+    showMigration,+    getMigration,+    runMigration,+    runMigrationQuiet,+    runMigrationSilent,+    runMigrationUnsafe,+    runMigrationUnsafeQuiet,+    getFieldName,+    getTableName,+    withRawQuery,+    rawQueryRes,+    rawQuery,+    rawExecute,+    rawExecuteCount,+    rawSql,+    transactionSave,+    transactionSaveWithIsolation,+    transactionUndo,+    transactionUndoWithIsolation,+    )

@@ -1,31 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TypeApplications #-}--module Basic where--import Test.Tasty-import Test.Tasty.HUnit--import Database.Persist.Monad-import Database.Persist.Monad.TestUtils-import Example--tests :: TestTree-tests = testGroup "Basic functionality tests"-  [ testCase "Ensure withTransaction README example typechecks" $ do-      let foo :: MonadSqlQuery m => m ()-          foo = insert_ $ person "Alice"-          bar :: MonadSqlQuery m => m ()-          bar = insert_ $ person "Bob"-          fooAndBar :: MonadSqlQuery m => m ()-          fooAndBar = withTransaction $ foo >> bar-      runMockSqlQueryT fooAndBar-        [ withRecord @Person $ \case-            Insert_ _ -> Just ()-            _ -> Nothing-        , withRecord @Person $ \case-            Insert_ _ -> Just ()-            _ -> Nothing-        ]-  ]

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-}@@ -11,55 +10,60 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-unused-top-binds #-} {-# OPTIONS_GHC -Wno-missing-methods #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-} -module Example-  ( TestApp-  , runTestApp-  , runTestAppWith+module Example (+  TestApp,+  runTestApp,+  runTestAppWith, -    -- * Person-  , Person(..)-  , person-  , getPeople-  , getPeopleNames-  , getName-  , nameAndAge+  -- * Person+  Person (..),+  person,+  getPeople,+  getPeopleNames,+  getName,+  nameAndAge, -    -- * Post-  , Post(..)-  , post-  , getPosts-  , getPostTitles+  -- * Post+  Post (..),+  post,+  getPosts,+  getPostTitles, -    -- * Persistent-  , EntityField(..)-  , Unique(..)-  , migration-  ) where+  -- * Persistent+  EntityField (..),+  Unique (..),+  migration,+) where  import Control.Arrow ((&&&))-import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)-import Database.Persist.Sql-    (Entity(..), EntityField, Key, SelectOpt(..), Unique, toSqlKey)-import Database.Persist.TH-    (mkMigrate, mkPersist, persistLowerCase, share, sqlSettings)-#if !MIN_VERSION_persistent(2,13,0)-import qualified Database.Persist.TH-#endif-import UnliftIO (MonadUnliftIO(..), wrappedWithRunInIO)+import Database.Persist.Sql (+  Entity (..),+  EntityField,+  Key,+  SelectOpt (..),+  Unique,+  toSqlKey,+ )+import Database.Persist.TH (+  mkMigrate,+  mkPersist,+  persistLowerCase,+  share,+  sqlSettings,+ )+import UnliftIO (MonadUnliftIO (..), wrappedWithRunInIO)  import Control.Monad.IO.Rerunnable (MonadRerunnableIO) import Database.Persist.Monad-import TestUtils.DB (BackendType(..), withTestDB)+import TestUtils.DB (BackendType (..), withTestDB)  share   [ mkPersist sqlSettings-#if !MIN_VERSION_persistent(2,13,0)-  , Database.Persist.TH.mkDeleteCascade sqlSettings-#endif   , mkMigrate "migration"   ]   [persistLowerCase|@@ -72,20 +76,13 @@  Post   title  String-#if MIN_VERSION_persistent(2,13,0)   author PersonId   editor PersonId Maybe-#else-  author PersonId       OnDeleteCascade-  editor PersonId Maybe OnDeleteCascade-#endif   deriving Show Eq |]  deriving instance Eq (Unique Person)-#if !MIN_VERSION_persistent_template(2,6,0) || MIN_VERSION_persistent_template(2,9,0) deriving instance Show (Unique Person)-#endif  -- Let tests use a literal number for keys instance Num (Key Person) where@@ -96,7 +93,8 @@  newtype TestApp a = TestApp   { unTestApp :: SqlQueryT (ResourceT IO) a-  } deriving+  }+  deriving     ( Functor     , Applicative     , Monad

@@ -1,4 +1,5 @@ {- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}+{- FOURMOLU_DISABLE -}  {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-}@@ -17,8 +18,6 @@ import Database.Persist.Monad.TestUtils (SqlQueryRep(..)) import Example -{-# ANN module "HLint: ignore" #-}- allSqlQueryRepShowRepresentations :: [String] allSqlQueryRepShowRepresentations =   [ show (Get undefined :: SqlQueryRep Person (Maybe Person))@@ -43,73 +42,39 @@   , show (InsertEntity undefined :: SqlQueryRep Person (Entity Person))   , show (InsertRecord undefined :: SqlQueryRep Person Person)   , show (GetBy undefined :: SqlQueryRep Person (Maybe (Entity Person)))-#if MIN_VERSION_persistent(2,10,0)   , show (GetByValue undefined :: SqlQueryRep Person (Maybe (Entity Person)))-#endif-#if !MIN_VERSION_persistent(2,10,0)-  , show (GetByValue undefined :: SqlQueryRep Person (Maybe (Entity Person)))-#endif   , show (CheckUnique undefined :: SqlQueryRep Person (Maybe (Unique Person)))-#if MIN_VERSION_persistent(2,11,0)   , show (CheckUniqueUpdateable undefined :: SqlQueryRep Person (Maybe (Unique Person)))-#endif   , show (DeleteBy undefined :: SqlQueryRep Person ())   , show (InsertUnique undefined :: SqlQueryRep Person (Maybe (Key Person)))-#if MIN_VERSION_persistent(2,10,0)   , show (Upsert undefined undefined :: SqlQueryRep Person (Entity Person))-#endif-#if !MIN_VERSION_persistent(2,10,0)-  , show (Upsert undefined undefined :: SqlQueryRep Person (Entity Person))-#endif   , show (UpsertBy undefined undefined undefined :: SqlQueryRep Person (Entity Person))   , show (PutMany undefined :: SqlQueryRep Person ())-#if MIN_VERSION_persistent(2,10,0)   , show (InsertBy undefined :: SqlQueryRep Person (Either (Entity Person) (Key Person)))-#endif-#if !MIN_VERSION_persistent(2,10,0)-  , show (InsertBy undefined :: SqlQueryRep Person (Either (Entity Person) (Key Person)))-#endif   , show (InsertUniqueEntity undefined :: SqlQueryRep Person (Maybe (Entity Person)))   , show (ReplaceUnique undefined undefined :: SqlQueryRep Person (Maybe (Unique Person)))-#if MIN_VERSION_persistent(2,10,0)   , show (OnlyUnique undefined :: SqlQueryRep Person (Unique Person))-#endif-#if !MIN_VERSION_persistent(2,10,0)-  , show (OnlyUnique undefined :: SqlQueryRep Person (Unique Person))-#endif   , show (SelectSourceRes undefined undefined :: SqlQueryRep Person (Acquire (ConduitM () (Entity Person) IO ())))   , show (SelectFirst undefined undefined :: SqlQueryRep Person (Maybe (Entity Person)))   , show (SelectKeysRes undefined undefined :: SqlQueryRep Person (Acquire (ConduitM () (Key Person) IO ())))   , show (Count undefined :: SqlQueryRep Person Int)-#if MIN_VERSION_persistent(2,11,0)   , show (Exists undefined :: SqlQueryRep Person Bool)-#endif   , show (SelectList undefined undefined :: SqlQueryRep Person [Entity Person])   , show (SelectKeysList undefined undefined :: SqlQueryRep Person [Key Person])   , show (UpdateWhere undefined undefined :: SqlQueryRep Person ())   , show (DeleteWhere undefined :: SqlQueryRep Person ())   , show (DeleteWhereCount undefined :: SqlQueryRep Person Int64)   , show (UpdateWhereCount undefined undefined :: SqlQueryRep Person Int64)-#if !MIN_VERSION_persistent(2,13,0)-  , show (DeleteCascade undefined :: SqlQueryRep Person ())-#endif-#if !MIN_VERSION_persistent(2,13,0)-  , show (DeleteCascadeWhere undefined :: SqlQueryRep Person ())-#endif   , show (ParseMigration undefined :: SqlQueryRep Void (Either [Text] CautiousMigration))   , show (ParseMigration' undefined :: SqlQueryRep Void CautiousMigration)   , show (PrintMigration undefined :: SqlQueryRep Void ())   , show (ShowMigration undefined :: SqlQueryRep Void [Text])   , show (GetMigration undefined :: SqlQueryRep Void [Sql])   , show (RunMigration undefined :: SqlQueryRep Void ())-#if MIN_VERSION_persistent(2,10,2)   , show (RunMigrationQuiet undefined :: SqlQueryRep Void [Text])-#endif   , show (RunMigrationSilent undefined :: SqlQueryRep Void [Text])   , show (RunMigrationUnsafe undefined :: SqlQueryRep Void ())-#if MIN_VERSION_persistent(2,10,2)   , show (RunMigrationUnsafeQuiet undefined :: SqlQueryRep Void [Text])-#endif   , show (GetFieldName undefined :: SqlQueryRep Person Text)   , show (GetTableName undefined :: SqlQueryRep Person Text)   , show (WithRawQuery undefined undefined undefined :: SqlQueryRep Void a)@@ -118,11 +83,7 @@   , show (RawExecuteCount undefined undefined :: SqlQueryRep Void Int64)   , show (RawSql undefined undefined :: SqlQueryRep Void [Entity Person])   , show (TransactionSave :: SqlQueryRep Void ())-#if MIN_VERSION_persistent(2,9,0)   , show (TransactionSaveWithIsolation undefined :: SqlQueryRep Void ())-#endif   , show (TransactionUndo :: SqlQueryRep Void ())-#if MIN_VERSION_persistent(2,9,0)   , show (TransactionUndoWithIsolation undefined :: SqlQueryRep Void ())-#endif   ]

@@ -1,898 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}--module Integration where--import Conduit (runConduit, (.|))-import qualified Conduit-import Control.Arrow ((&&&))-import qualified Data.Acquire as Acquire-import Data.Bifunctor (first)-import qualified Data.Map.Strict as Map-import Data.Text (Text)-import qualified Data.Text as Text-import Data.Typeable (Typeable)-#if MIN_VERSION_esqueleto(3,5,0)-import qualified Database.Esqueleto.Experimental as E-#else-import qualified Database.Esqueleto as E-#endif-import Database.Persist.Sql-    ( Entity(..)-    , Migration-    , PersistField-    , PersistRecordBackend-    , PersistValue-    , Single(..)-    , SqlBackend-    , fromPersistValue-    , (=.)-    , (==.)-    )-#if MIN_VERSION_persistent(2,9,0)-import Database.Persist.Sql (IsolationLevel(..))-#endif-import Test.Predicates (anything, elemsAre, eq, right)-import Test.Predicates.HUnit ((@?~))-import Test.Tasty-import Test.Tasty.HUnit-import UnliftIO (MonadIO, MonadUnliftIO, liftIO)-import UnliftIO.Exception-    ( Exception-    , SomeException-    , StringException(..)-    , fromException-    , throwIO-    , throwString-    , try-    )-import UnliftIO.IORef (atomicModifyIORef, newIORef)--import Control.Monad.IO.Rerunnable (MonadRerunnableIO, rerunnableIO)-import Database.Persist.Monad-import Example-import TestUtils.DB (BackendType(..), allBackendTypes)-import TestUtils.Esqueleto (esqueletoSelect)--tests :: TestTree-tests = testGroup "Integration tests" $-  map testsWithBackend allBackendTypes--testsWithBackend :: BackendType -> TestTree-testsWithBackend backendType = testGroup (show backendType)-  [ testWithTransaction backendType-  , testComposability backendType-  , testPersistentAPI backendType-  , testInterop backendType-  ]--testWithTransaction :: BackendType -> TestTree-testWithTransaction backendType = testGroup "withTransaction"-  [ testCase "it uses the same transaction" $ do-      -- without transactions, the INSERT shouldn't be rolled back-      runTestApp backendType $ do-        catchTestError $ insertAndFail $ person "Alice"-        result <- getPeopleNames-        liftIO $ result @?= ["Alice"]--      -- with transactions, the INSERT should be rolled back-      runTestApp backendType $ do-        catchTestError $ withTransaction $ insertAndFail $ person "Alice"-        result <- getPeopleNames-        liftIO $ result @?= []--  , testCase "retries transactions" $ do-      let retryIf e = case fromException e of-            Just (StringException "retry me" _) -> True-            _ -> False-          setRetry env = env { retryIf, retryLimit = 5 }--      counter <- newIORef (0 :: Int)--      result <- try @_ @SomeException $ runTestAppWith backendType setRetry $-        withTransaction $ rerunnableIO $ do-          x <- atomicModifyIORef counter $ \x -> (x + 1, x)-          if x > 2-            then return ()-            else throwString "retry me"--      case result of-        Right () -> return ()-        Left e -> error $ "Got unexpected error: " ++ show e--  , testCase "throws error when retry hits limit" $ do-      let setRetry env = env { retryIf = const True, retryLimit = 2 }--      result <- try @_ @TransactionError @() $ runTestAppWith backendType setRetry $-        withTransaction $ rerunnableIO $ throwString "retry me"--      result @?= Left RetryLimitExceeded-  ]---- this should compile-testComposability :: BackendType -> TestTree-testComposability backendType = testCase "Operations can be composed" $ do-  let onlySql :: MonadSqlQuery m => m ()-      onlySql = do-        _ <- getPeople-        return ()--      sqlAndRerunnableIO :: (MonadSqlQuery m, MonadRerunnableIO m) => m ()-      sqlAndRerunnableIO = do-        _ <- getPeopleNames-        _ <- rerunnableIO $ newIORef True-        return ()--      onlyRerunnableIO :: MonadRerunnableIO m => m ()-      onlyRerunnableIO = do-        _ <- rerunnableIO $ newIORef True-        return ()--      arbitraryIO :: MonadIO m => m ()-      arbitraryIO = do-        _ <- liftIO $ newIORef True-        return ()--  -- everything should compose naturally by default-  runTestApp backendType $ do-    onlySql-    sqlAndRerunnableIO-    onlyRerunnableIO-    arbitraryIO--  -- in a transaction, you can compose everything except arbitrary IO-  runTestApp backendType $ withTransaction $ do-    onlySql-    sqlAndRerunnableIO-    onlyRerunnableIO-    -- uncomment this to get compile error-    -- arbitraryIO--testPersistentAPI :: BackendType -> TestTree-testPersistentAPI backendType = testGroup "Persistent API"-  [ testCase "get" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        mapM get [1, 2]-      map (fmap personName) result @?= [Just "Alice", Nothing]--  , testCase "getMany" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        getMany [1]-      personName <$> Map.lookup 1 result @?= Just "Alice"--  , testCase "getJust" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        getJust 1-      personName result @?= "Alice"--  , testCase "getJustEntity" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        getJustEntity 1-      getName result @?= "Alice"--  , testCase "getEntity" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        mapM getEntity [1, 2]-      map (fmap getName) result @?= [Just "Alice", Nothing]--  , testCase "belongsTo" $ do-      result <- runTestApp backendType $ do-        aliceKey <- insert $ person "Alice"-        let post1 = Post "Post #1" aliceKey (Just aliceKey)-            post2 = Post "Post #2" aliceKey Nothing-        insertMany_ [post1, post2]-        mapM (belongsTo postEditor) [post1, post2]-      map (fmap personName) result @?= [Just "Alice", Nothing]--  , testCase "belongsToJust" $ do-      result <- runTestApp backendType $ do-        aliceKey <- insert $ person "Alice"-        let post1 = Post "Post #1" aliceKey Nothing-        insert_ post1-        belongsToJust postAuthor post1-      personName result @?= "Alice"--  , testCase "insert" $ do-      result <- runTestApp backendType $ do-        aliceKey <- insert $ person "Alice"-        people <- getPeopleNames-        return (aliceKey, people)-      result @?= (1, ["Alice"])--  , testCase "insert_" $ do-      result <- runTestApp backendType $ do-        result <- insert_ $ person "Alice"-        people <- getPeopleNames-        return (result, people)-      result @?= ((), ["Alice"])--  , testCase "insertMany" $ do-      result <- runTestApp backendType $ do-        keys <- insertMany [person "Alice", person "Bob"]-        people <- getPeopleNames-        return (keys, people)-      result @?= ([1, 2], ["Alice", "Bob"])--  , testCase "insertMany_" $ do-      result <- runTestApp backendType $ do-        result <- insertMany_ [person "Alice", person "Bob"]-        people <- getPeopleNames-        return (result, people)-      result @?= ((), ["Alice", "Bob"])--  , testCase "insertEntityMany" $ do-      result <- runTestApp backendType $ do-        result <- insertEntityMany-          [ Entity 1 $ person "Alice"-          , Entity 2 $ person "Bob"-          ]-        people <- getPeopleNames-        return (result, people)-      result @?= ((), ["Alice", "Bob"])--  , testCase "insertKey" $ do-      result <- runTestApp backendType $ do-        result <- insertKey 1 $ person "Alice"-        people <- getPeopleNames-        return (result, people)-      result @?= ((), ["Alice"])--  , testCase "repsert" $ do-      result <- runTestApp backendType $ do-        let alice = person "Alice"-        insert_ alice-        repsert 1 $ alice { personAge = 100 }-        repsert 2 $ person "Bob"-        getPeople-      map nameAndAge result @?=-        [ ("Alice", 100)-        , ("Bob", 0)-        ]--  , testCase "repsertMany" $ do-      result <- runTestApp backendType $ do-        let alice = person "Alice"--- https://github.com/yesodweb/persistent/issues/832-#if MIN_VERSION_persistent(2,9,0)-        insert_ alice-        repsertMany-          [ (1, alice { personAge = 100 })-          , (2, person "Bob")-          ]-#else-        repsertMany [(1, alice { personAge = 100 })]-        repsertMany [(2, person "Bob")]-#endif-        getPeople-      map nameAndAge result @?=-        [ ("Alice", 100)-        , ("Bob", 0)-        ]--  , testCase "replace" $ do-      result <- runTestApp backendType $ do-        let alice = person "Alice"-        insert_ alice-        replace 1 $ alice { personAge = 100 }-        getJust 1-      personAge result @?= 100--  , testCase "delete" $ do-      result <- runTestApp backendType $ do-        aliceKey <- insert $ person "Alice"-        delete aliceKey-        getPeople-      result @?= []--  , testCase "update" $ do-      result <- runTestApp backendType $ do-        key <- insert $ person "Alice"-        update key [PersonName =. "Alicia"]-        getPeopleNames-      result @?= ["Alicia"]--  , testCase "updateGet" $ do-      (updateResult, getResult) <- runTestApp backendType $ do-        key <- insert $ person "Alice"-        updateResult <- updateGet key [PersonName =. "Alicia"]-        getResult <- getJust key-        return (updateResult, getResult)-      updateResult @?= getResult--  , testCase "insertEntity" $ do-      (insertResult, getResult) <- runTestApp backendType $ do-        insertResult <- insertEntity $ person "Alice"-        getResult <- getJust $ entityKey insertResult-        return (insertResult, getResult)-      entityVal insertResult @?= getResult--  , testCase "insertRecord" $ do-      (insertResult, getResult) <- runTestApp backendType $ do-        insertResult <- insertRecord $ person "Alice"-        getResult <- getJust 1-        return (insertResult, getResult)-      insertResult @?= getResult--  , testCase "getBy" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        mapM getBy [UniqueName "Alice", UniqueName "Bob"]-      map (fmap getName) result @?= [Just "Alice", Nothing]--  , testCase "getByValue" $ do-      result <- runTestApp backendType $ do-        let alice = person "Alice"-        insert_ alice-        mapM getByValue [alice, person "Bob"]-      map (fmap getName) result @?= [Just "Alice", Nothing]--  , testCase "checkUnique" $ do-      result <- runTestApp backendType $ do-        let alice = person "Alice"-        insert_ alice-        mapM checkUnique-          [ alice-          , person "Bob"-          , (person "Alice"){ personAge = 100 }-          ]-      result @?= [Just (UniqueName "Alice"), Nothing, Just (UniqueName "Alice")]--#if MIN_VERSION_persistent(2,11,0)-  , testCase "checkUniqueUpdateable" $ do-      result <- runTestApp backendType $ do-        let alice = person "Alice"-        insert_ alice-        mapM checkUniqueUpdateable-          [ Entity 1 alice-          , Entity 2 $ person "Bob"-          , Entity 3 $ (person "Alice"){ personAge = 100 }-          ]-      result @?= [Nothing, Nothing, Just (UniqueName "Alice")]-#endif--  , testCase "deleteBy" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        deleteBy $ UniqueName "Alice"-        getPeople-      result @?= []--  , testCase "insertUnique" $ do-      (result1, result2, people) <- runTestApp backendType $ do-        result1 <- insertUnique $ person "Alice"-        result2 <- insertUnique $ person "Alice"-        people <- getPeopleNames-        return (result1, result2, people)-      result1 @?= Just 1-      result2 @?= Nothing-      people @?= ["Alice"]--  , testCase "upsert" $ do-      (result1, result2, people) <- runTestApp backendType $ do-        result1 <- upsert (person "Alice") [PersonAge =. 0]-        result2 <- upsert (person "Alice") [PersonAge =. 100]-        people <- getPeople-        return (result1, result2, people)-      entityKey result1 @?= entityKey result2-      nameAndAge (entityVal result1) @?= ("Alice", 0)-      nameAndAge (entityVal result2) @?= ("Alice", 100)-      map nameAndAge people @?= [("Alice", 100)]--  , testCase "upsertBy" $ do-      (result1, result2, people) <- runTestApp backendType $ do-        result1 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 0]-        result2 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 100]-        people <- getPeople-        return (result1, result2, people)-      entityKey result1 @?= entityKey result2-      nameAndAge (entityVal result1) @?= ("Alice", 0)-      nameAndAge (entityVal result2) @?= ("Alice", 100)-      map nameAndAge people @?= [("Alice", 100)]--  , testCase "putMany" $ do-      result <- runTestApp backendType $ do-        let alice = person "Alice"-        insert_ alice-        putMany-          [ alice { personAge = 100 }-          , person "Bob"-          ]-        getPeople-      map nameAndAge result @?=-        [ ("Alice", 100)-        , ("Bob", 0)-        ]--  , testCase "insertBy" $ do-      (result1, result2, people) <- runTestApp backendType $ do-        let alice = person "Alice"-        result1 <- insertBy alice-        result2 <- insertBy $ alice { personAge = 100 }-        people <- getPeople-        return (result1, result2, people)-      result1 @?= Right 1-      first (entityKey &&& getName) result2 @?= Left (1, "Alice")-      map nameAndAge people @?= [("Alice", 0)]--  , testCase "insertUniqueEntity" $ do-      (result1, result2, people) <- runTestApp backendType $ do-        let alice = person "Alice"-        result1 <- insertUniqueEntity alice-        result2 <- insertUniqueEntity $ alice { personAge = 100 }-        people <- getPeople-        return (result1, result2, people)-      (entityKey &&& getName) <$> result1 @?= Just (1, "Alice")-      result2 @?= Nothing-      map nameAndAge people @?= [("Alice", 0)]--  , testCase "replaceUnique" $ do-      (result1, result2, people) <- runTestApp backendType $ do-        let alice = person "Alice"-            bob = person "Bob"-        insertMany_ [alice, bob]-        result1 <- replaceUnique 1 $ alice { personName = "Bob" }-        result2 <- replaceUnique 2 $ bob { personAge = 100 }-        people <- getPeople-        return (result1, result2, people)-      result1 @?= Just (UniqueName "Bob")-      result2 @?= Nothing-      map nameAndAge people @?= [("Alice", 0), ("Bob", 100)]--  , testCase "onlyUnique" $ do-      result <- runTestApp backendType $ onlyUnique $ person "Alice"-      result @?= UniqueName "Alice"--  , testCase "selectSourceRes" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        acquire <- selectSourceRes [] []-        Acquire.with acquire $ \conduit ->-          runConduit $ conduit .| Conduit.mapC getName .| Conduit.sinkList-      result @?= ["Alice", "Bob"]--  , testCase "selectFirst" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        sequence-          [ selectFirst [PersonName ==. "Alice"] []-          , selectFirst [PersonName ==. "Bob"] []-          ]-      map (fmap getName) result @?= [Just "Alice", Nothing]--  , testCase "selectKeysRes" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        acquire <- selectKeysRes @_ @Person [] []-        Acquire.with acquire $ \conduit ->-          runConduit $ conduit .| Conduit.sinkList-      result @?= [1, 2]--  , testCase "count" $ do-      result <- runTestApp backendType $ do-        insertMany_ $ map (\p -> p{personAge = 100}) [person "Alice", person "Bob"]-        count [PersonAge ==. 100]-      result @?= 2--#if MIN_VERSION_persistent(2,11,0)-  , testCase "exists" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        exists [PersonName ==. "Alice"]-      result @?= True-#endif--  , testCase "selectSource" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList-      result @?= ["Alice", "Bob"]--  , testCase "selectKeys" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        runConduit $ selectKeys @Person [] [] .| Conduit.sinkList-      result @?= [1, 2]--  , testCase "selectList" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        insert_ $ person "Bob"-        selectList [] []-      map getName result @?= ["Alice", "Bob"]--  , testCase "selectKeysList" $ do-      result <- runTestApp backendType $ do-        insert_ $ person "Alice"-        insert_ $ person "Bob"-        selectKeysList @Person [] []-      result @?= [1, 2]--  , testCase "updateWhere" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        updateWhere [PersonName ==. "Alice"] [PersonAge =. 100]-        getPeople-      map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]--  , testCase "deleteWhere" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        deleteWhere [PersonName ==. "Alice"]-        getPeopleNames-      result @?= ["Bob"]--  , testCase "updateWhereCount" $ do-      (rowsUpdated, people) <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        rowsUpdated <- updateWhereCount [PersonName ==. "Alice"] [PersonAge =. 100]-        people <- getPeople-        return (rowsUpdated, people)-      rowsUpdated @?= 1-      map nameAndAge people @?= [("Alice", 100), ("Bob", 0)]--  , testCase "deleteWhereCount" $ do-      (rowsDeleted, names) <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        rowsDeleted <- deleteWhereCount [PersonName ==. "Alice"]-        names <- getPeopleNames-        return (rowsDeleted, names)-      rowsDeleted @?= 1-      names @?= ["Bob"]--#if !MIN_VERSION_persistent(2,13,0)-  , testCase "deleteCascade" $ do-      (people, posts) <- runTestApp backendType $ do-        aliceKey <- insert $ person "Alice"-        bobKey <- insert $ person "Bob"-        insertMany_-          [ post "Post #1" aliceKey-          , post "Post #2" bobKey-          ]-        deleteCascade aliceKey-        people <- getPeopleNames-        posts <- getPostTitles-        return (people, posts)-      people @?= ["Bob"]-      posts @?= ["Post #2"]--  , testCase "deleteCascadeWhere" $ do-      (people, posts) <- runTestApp backendType $ do-        aliceKey <- insert $ person "Alice"-        bobKey <- insert $ person "Bob"-        insertMany_-          [ post "Post #1" aliceKey-          , post "Post #2" bobKey-          ]-        deleteCascadeWhere [PersonName ==. "Alice"]-        people <- getPeopleNames-        posts <- getPostTitles-        return (people, posts)-      people @?= ["Bob"]-      posts @?= ["Post #2"]-#endif--  , testCase "parseMigration" $ do-      result <- runTestApp backendType $ do-        setupUnsafeMigration-        parseMigration migration--      let sql = case backendType of-            Sqlite ->-              [ eq-                  ( False-                  , Text.concat-                      [ "CREATE TEMP TABLE \"person_backup\"("-                      , "\"id\" INTEGER PRIMARY KEY,"-                      , "\"name\" VARCHAR NOT NULL,"-                      , "\"age\" INTEGER NOT NULL,"-                      , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"-                      ]-                  )-              , anything-              , eq (True, "DROP TABLE \"person\"")-              , anything-              , anything-              , eq (False, "DROP TABLE \"person_backup\"")-              ]-            Postgresql ->-              [ eq (True, "ALTER TABLE \"person\" DROP COLUMN \"foo\"")-              ]--      result @?~ right (elemsAre sql)--  , testCase "parseMigration'" $ do-      let action :: (Migration -> TestApp a) -> IO a-          action f = runTestApp backendType $ do-            setupUnsafeMigration-            f migration--      result <- action parseMigration-      result' <- action parseMigration'-      Right result' @?= result--  , testCase "printMigration" $-      runTestApp backendType $ do-        setupUnsafeMigration-        printMigration migration--  , testCase "showMigration" $ do-      result <- runTestApp backendType $ do-        setupUnsafeMigration-        showMigration migration--      let sql = case backendType of-            Sqlite ->-              [ eq $ Text.concat-                  [ "CREATE TEMP TABLE \"person_backup\"("-                  , "\"id\" INTEGER PRIMARY KEY,"-                  , "\"name\" VARCHAR NOT NULL,"-                  , "\"age\" INTEGER NOT NULL,"-                  , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"));"-                  ]-              , anything-              , eq "DROP TABLE \"person\";"-              , anything-              , anything-              , eq "DROP TABLE \"person_backup\";"-              ]-            Postgresql ->-              [ eq "ALTER TABLE \"person\" DROP COLUMN \"foo\";"-              ]--      result @?~ elemsAre sql--  , testCase "getMigration" $ do-      result <- runTestApp backendType $ do-        setupUnsafeMigration-        getMigration migration--      let sql = case backendType of-            Sqlite ->-              [ eq $ Text.concat-                  [ "CREATE TEMP TABLE \"person_backup\"("-                  , "\"id\" INTEGER PRIMARY KEY,"-                  , "\"name\" VARCHAR NOT NULL,"-                  , "\"age\" INTEGER NOT NULL,"-                  , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"-                  ]-              , anything-              , eq "DROP TABLE \"person\""-              , anything-              , anything-              , eq "DROP TABLE \"person_backup\""-              ]-            Postgresql ->-              [ eq "ALTER TABLE \"person\" DROP COLUMN \"foo\""-              ]--      result @?~ elemsAre sql--  , testCase "runMigration" $ do-      result <- runTestApp backendType $ do-        setupSafeMigration-        runMigration migration-        getSchemaColumnNames backendType "person"-      assertNotIn "removed_column" result--#if MIN_VERSION_persistent(2,10,2)-  , testCase "runMigrationQuiet" $ do-      (withQuiet, cols) <- runTestApp backendType $ do-        setupSafeMigration-        sql <- runMigrationQuiet migration-        cols <- getSchemaColumnNames backendType "person"-        return (sql, cols)-      withSilent <- runTestApp backendType $ do-        setupSafeMigration-        runMigrationSilent migration-      assertNotIn "removed_column" cols-      withQuiet @?= withSilent-#endif--  , testCase "runMigrationSilent" $ do-      (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do-        setupSafeMigration-        sqlPlanned <- getMigration migration-        sqlExecuted <- runMigrationSilent migration-        cols <- getSchemaColumnNames backendType "person"-        return (sqlPlanned, sqlExecuted, cols)-      assertNotIn "removed_column" cols-      sqlExecuted @?= sqlPlanned--  , testCase "runMigrationUnsafe" $ do-      result <- runTestApp backendType $ do-        setupUnsafeMigration-        runMigrationUnsafe migration-        getSchemaColumnNames backendType "person"-      assertNotIn "removed_column" result--#if MIN_VERSION_persistent(2,10,2)-  , testCase "runMigrationUnsafeQuiet" $ do-      (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do-        setupUnsafeMigration-        sqlPlanned <- getMigration migration-        sqlExecuted <- runMigrationUnsafeQuiet migration-        cols <- getSchemaColumnNames backendType "person"-        return (sqlPlanned, sqlExecuted, cols)-      assertNotIn "removed_column" cols-      sqlExecuted @?= sqlPlanned-#endif--  , testCase "getFieldName" $ do-      result <- runTestApp backendType $-        getFieldName PersonName-      result @?= "\"name\""--  , testCase "getTableName" $ do-      result <- runTestApp backendType $-        getTableName $ person "Alice"-      result @?= "\"person\""--  , testCase "withRawQuery" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        withRawQuery "SELECT name FROM person" [] $-          Conduit.mapC (fromPersistValue' @Text . head) .| Conduit.sinkList--      result @?= ["Alice", "Bob"]--  , testCase "rawQueryRes" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        acquire <- rawQueryRes "SELECT name FROM person" []-        Acquire.with acquire $ \conduit ->-          runConduit $ conduit .| Conduit.mapC (fromPersistValue' @Text . head) .| Conduit.sinkList-      result @?= ["Alice", "Bob"]--  , testCase "rawQuery" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.mapC (fromPersistValue' @Text . head) .| Conduit.sinkList-      result @?= ["Alice", "Bob"]--  , testCase "rawExecute" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        rawExecute "UPDATE person SET age = 100 WHERE name = 'Alice'" []-        getPeople-      map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]--  , testCase "rawExecuteCount" $ do-      (rowsUpdated, people) <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        rowsUpdated <- rawExecuteCount "UPDATE person SET age = 100 WHERE name = 'Alice'" []-        people <- getPeople-        return (rowsUpdated, people)-      rowsUpdated @?= 1-      map nameAndAge people @?= [("Alice", 100), ("Bob", 0)]--  , testCase "rawSql" $ do-      result <- runTestApp backendType $ do-        insertMany_ [person "Alice", person "Bob"]-        rawSql @(Single String) "SELECT name FROM person" []-      map unSingle result @?= ["Alice", "Bob"]--  , testCase "transactionSave" $ do-      result1 <- runTestApp backendType $ do-        catchTestError $ withTransaction $ do-          insert_ $ person "Alice"-          insertAndFail $ person "Bob"-        getPeopleNames-      result1 @?= []--      result2 <- runTestApp backendType $ do-        catchTestError $ withTransaction $ do-          insert_ $ person "Alice"-          transactionSave-          insertAndFail $ person "Bob"-        getPeopleNames-      result2 @?= ["Alice"]--#if MIN_VERSION_persistent(2,9,0)-  , testCase "transactionSaveWithIsolation" $ do-      result1 <- runTestApp backendType $ do-        catchTestError $ withTransaction $ do-          insert_ $ person "Alice"-          insertAndFail $ person "Bob"-        getPeopleNames-      result1 @?= []--      result2 <- runTestApp backendType $ do-        catchTestError $ withTransaction $ do-          insert_ $ person "Alice"-          transactionSaveWithIsolation Serializable-          insertAndFail $ person "Bob"-        getPeopleNames-      result2 @?= ["Alice"]-#endif--  , testCase "transactionUndo" $ do-      result <- runTestApp backendType $ withTransaction $ do-        insert_ $ person "Alice"-        transactionUndo-        getPeopleNames-      result @?= []--#if MIN_VERSION_persistent(2,9,0)-  , testCase "transactionUndoWithIsolation" $ do-      result <- runTestApp backendType $ withTransaction $ do-        insert_ $ person "Alice"-        transactionUndoWithIsolation Serializable-        getPeopleNames-      result @?= []-#endif-  ]--testInterop :: BackendType -> TestTree-testInterop backendType = testGroup "Interop with third-party Persistent libraries"-  [ testCase "unsafeLiftSql" $ do-      let alice = person "Alice"-      result <- runTestApp backendType $ do-        insert_ alice-        esqueletoSelect $-#if MIN_VERSION_esqueleto(3,5,0)-          E.from $ E.table @Person-#else-          E.from $ \p -> return p-#endif-      result @?= [Entity 1 alice]-  ]--{- Persistent helpers -}--fromPersistValue' :: PersistField a => PersistValue -> a-fromPersistValue' = either (error . Text.unpack) id . fromPersistValue--{- Meta SQL helpers -}---- | Put the database in a state where running a migration is safe.-setupSafeMigration :: MonadSqlQuery m => m ()-setupSafeMigration = rawExecute "ALTER TABLE person ADD COLUMN removed_column VARCHAR" []---- | Put the database in a state where running a migration is unsafe.-setupUnsafeMigration :: MonadSqlQuery m => m ()-setupUnsafeMigration = rawExecute "ALTER TABLE person ADD COLUMN foo VARCHAR" []---- | Get the names of all columns in the given table.-getSchemaColumnNames :: MonadSqlQuery m => BackendType -> String -> m [String]-getSchemaColumnNames backendType tableName = map unSingle <$> rawSql sql []-  where-    sql = Text.pack $ case backendType of-      Sqlite -> "SELECT name FROM pragma_table_info('" ++ tableName ++ "')"-      Postgresql -> unlines-        [ "SELECT column_name FROM information_schema.columns"-        , "WHERE table_schema = 'public' AND table_name = '" ++ tableName ++ "'"-        ]--{- Test helpers -}--data TestError = TestError-  deriving (Show, Eq)--instance Exception TestError--catchTestError :: (MonadUnliftIO m, Eq a, Show a) => m a -> m ()-catchTestError m = do-  result <- try m-  liftIO $ result @?= Left TestError--insertAndFail ::-  ( MonadRerunnableIO m-  , MonadSqlQuery m-  , PersistRecordBackend record SqlBackend-  , Typeable record-  )-  => record -> m ()-insertAndFail record = do-  insert_ record-  rerunnableIO $ throwIO TestError--assertNotIn :: (Eq a, Show a) => a -> [a] -> Assertion-assertNotIn a as = as @?= filter (/= a) as

@@ -0,0 +1,846 @@+{- AUTOCOLLECT.TEST -}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module IntegrationTest (+  -- $AUTOCOLLECT.TEST.export$+) where++import Conduit (runConduit, (.|))+import qualified Conduit+import Control.Arrow ((&&&))+import qualified Data.Acquire as Acquire+import Data.Bifunctor (first)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Typeable (Typeable)+import qualified Database.Esqueleto.Experimental as E+import Database.Persist.Sql (+  Entity (..),+  IsolationLevel (..),+  Migration,+  PersistField,+  PersistRecordBackend,+  PersistValue,+  Single (..),+  SqlBackend,+  fromPersistValue,+  (=.),+  (==.),+ )+import Test.Predicates (anything, elemsAre, eq, right)+import Test.Predicates.HUnit ((@?~))+import Test.Tasty+import Test.Tasty.HUnit+import UnliftIO (MonadIO, MonadUnliftIO, liftIO)+import UnliftIO.Exception (+  Exception,+  SomeException,+  StringException (..),+  fromException,+  throwIO,+  throwString,+  try,+ )+import UnliftIO.IORef (atomicModifyIORef, newIORef, readIORef, writeIORef)++import Control.Monad.IO.Rerunnable (MonadRerunnableIO, rerunnableIO)+import Database.Persist.Monad+import Database.Persist.Monad.Internal.PersistentShim (SafeToInsert)+import Example+import TestUtils.DB (BackendType (..), allBackendTypes)+import TestUtils.Esqueleto (esqueletoSelect)++test_batch =+  [ testGroup+    (show backendType)+    [ testWithTransaction backendType+    , testCatchTransaction backendType+    , testComposability backendType+    , testPersistentAPI backendType+    , testInterop backendType+    ]+  | backendType <- allBackendTypes+  ]++testWithTransaction :: BackendType -> TestTree+testWithTransaction backendType =+  testGroup+    "withTransaction"+    [ testCase "it uses the same transaction" $ do+        -- without transactions, the INSERT shouldn't be rolled back+        runTestApp backendType $ do+          catchTestError $ insertAndFail $ person "Alice"+          result <- getPeopleNames+          liftIO $ result @?= ["Alice"]++        -- with transactions, the INSERT should be rolled back+        runTestApp backendType $ do+          catchTestError $ withTransaction $ insertAndFail $ person "Alice"+          result <- getPeopleNames+          liftIO $ result @?= []+    , testCase "retries transactions" $ do+        let retryIf e = case fromException e of+              Just (StringException "retry me" _) -> True+              _ -> False+            setRetry env = env{retryIf, retryLimit = 5}++        counter <- newIORef (0 :: Int)++        result <- try @_ @SomeException $+          runTestAppWith backendType setRetry $+            withTransaction $+              rerunnableIO $ do+                x <- atomicModifyIORef counter $ \x -> (x + 1, x)+                if x > 2+                  then return ()+                  else throwString "retry me"++        case result of+          Right () -> return ()+          Left e -> error $ "Got unexpected error: " ++ show e+    , testCase "throws error when retry hits limit" $ do+        let setRetry env = env{retryIf = const True, retryLimit = 2}++        result <-+          try @_ @TransactionError @() $+            runTestAppWith backendType setRetry $+              withTransaction $+                rerunnableIO $+                  throwString "retry me"++        result @?= Left RetryLimitExceeded+    , testCase "Runs retryCallback" $ do+        callbackRef <- newIORef Nothing++        let setRetry env =+              env+                { retryIf = const True+                , retryLimit = 2+                , retryCallback = writeIORef callbackRef . Just+                }+        _ <-+          try @_ @TransactionError @() $+            runTestAppWith backendType setRetry . withTransaction $+              rerunnableIO (throwIO TestError)++        mError <- readIORef callbackRef+        case mError >>= fromException of+          Just TestError -> return ()+          _ -> assertFailure $ "Unexpected result: " ++ show mError+    ]++testCatchTransaction :: BackendType -> TestTree+testCatchTransaction backendType =+  testGroup+    "catchSqlTransaction"+    [ testCase "catches errors" $ do+        wasCaughtRef <- newIORef False+        runTestApp backendType . withTransaction $+          (`catchSqlTransaction` markCaught wasCaughtRef) $+            rerunnableIO (throwString "error")+        wasCaught <- readIORef wasCaughtRef+        wasCaught @?= True+    , testCase "does not catch retry errors" $ do+        let retryIf e = case fromException e of+              Just (StringException "retry me" _) -> True+              _ -> False+            setRetry env = env{retryIf, retryLimit = 2}++        wasCaughtRef <- newIORef False+        _ <-+          try @_ @SomeException $+            runTestAppWith backendType setRetry . withTransaction $+              (`catchSqlTransaction` markCaught wasCaughtRef) $+                rerunnableIO (throwString "retry me")+        wasCaught <- readIORef wasCaughtRef+        wasCaught @?= False+    ]+  where+    markCaught wasCaughtRef (_ :: SomeException) =+      rerunnableIO $ writeIORef wasCaughtRef True++-- this should compile+testComposability :: BackendType -> TestTree+testComposability backendType = testCase "Operations can be composed" $ do+  let onlySql :: MonadSqlQuery m => m ()+      onlySql = do+        _ <- getPeople+        return ()++      sqlAndRerunnableIO :: (MonadSqlQuery m, MonadRerunnableIO m) => m ()+      sqlAndRerunnableIO = do+        _ <- getPeopleNames+        _ <- rerunnableIO $ newIORef True+        return ()++      onlyRerunnableIO :: MonadRerunnableIO m => m ()+      onlyRerunnableIO = do+        _ <- rerunnableIO $ newIORef True+        return ()++      arbitraryIO :: MonadIO m => m ()+      arbitraryIO = do+        _ <- liftIO $ newIORef True+        return ()++  -- everything should compose naturally by default+  runTestApp backendType $ do+    onlySql+    sqlAndRerunnableIO+    onlyRerunnableIO+    arbitraryIO++  -- in a transaction, you can compose everything except arbitrary IO+  runTestApp backendType $ withTransaction $ do+    onlySql+    sqlAndRerunnableIO+    onlyRerunnableIO++-- uncomment this to get compile error+-- arbitraryIO++testPersistentAPI :: BackendType -> TestTree+testPersistentAPI backendType =+  testGroup+    "Persistent API"+    [ testCase "get" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          mapM get [1, 2]+        map (fmap personName) result @?= [Just "Alice", Nothing]+    , testCase "getMany" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          getMany [1]+        personName <$> Map.lookup 1 result @?= Just "Alice"+    , testCase "getJust" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          getJust 1+        personName result @?= "Alice"+    , testCase "getJustEntity" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          getJustEntity 1+        getName result @?= "Alice"+    , testCase "getEntity" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          mapM getEntity [1, 2]+        map (fmap getName) result @?= [Just "Alice", Nothing]+    , testCase "belongsTo" $ do+        result <- runTestApp backendType $ do+          aliceKey <- insert $ person "Alice"+          let post1 = Post "Post #1" aliceKey (Just aliceKey)+              post2 = Post "Post #2" aliceKey Nothing+          insertMany_ [post1, post2]+          mapM (belongsTo postEditor) [post1, post2]+        map (fmap personName) result @?= [Just "Alice", Nothing]+    , testCase "belongsToJust" $ do+        result <- runTestApp backendType $ do+          aliceKey <- insert $ person "Alice"+          let post1 = Post "Post #1" aliceKey Nothing+          insert_ post1+          belongsToJust postAuthor post1+        personName result @?= "Alice"+    , testCase "insert" $ do+        result <- runTestApp backendType $ do+          aliceKey <- insert $ person "Alice"+          people <- getPeopleNames+          return (aliceKey, people)+        result @?= (1, ["Alice"])+    , testCase "insert_" $ do+        result <- runTestApp backendType $ do+          result <- insert_ $ person "Alice"+          people <- getPeopleNames+          return (result, people)+        result @?= ((), ["Alice"])+    , testCase "insertMany" $ do+        result <- runTestApp backendType $ do+          keys <- insertMany [person "Alice", person "Bob"]+          people <- getPeopleNames+          return (keys, people)+        result @?= ([1, 2], ["Alice", "Bob"])+    , testCase "insertMany_" $ do+        result <- runTestApp backendType $ do+          result <- insertMany_ [person "Alice", person "Bob"]+          people <- getPeopleNames+          return (result, people)+        result @?= ((), ["Alice", "Bob"])+    , testCase "insertEntityMany" $ do+        result <- runTestApp backendType $ do+          result <-+            insertEntityMany+              [ Entity 1 $ person "Alice"+              , Entity 2 $ person "Bob"+              ]+          people <- getPeopleNames+          return (result, people)+        result @?= ((), ["Alice", "Bob"])+    , testCase "insertKey" $ do+        result <- runTestApp backendType $ do+          result <- insertKey 1 $ person "Alice"+          people <- getPeopleNames+          return (result, people)+        result @?= ((), ["Alice"])+    , testCase "repsert" $ do+        result <- runTestApp backendType $ do+          let alice = person "Alice"+          insert_ alice+          repsert 1 $ alice{personAge = 100}+          repsert 2 $ person "Bob"+          getPeople+        map nameAndAge result+          @?= [ ("Alice", 100)+              , ("Bob", 0)+              ]+    , testCase "repsertMany" $ do+        result <- runTestApp backendType $ do+          let alice = person "Alice"+          -- https://github.com/yesodweb/persistent/issues/832+          insert_ alice+          repsertMany+            [ (1, alice{personAge = 100})+            , (2, person "Bob")+            ]+          getPeople+        map nameAndAge result+          @?= [ ("Alice", 100)+              , ("Bob", 0)+              ]+    , testCase "replace" $ do+        result <- runTestApp backendType $ do+          let alice = person "Alice"+          insert_ alice+          replace 1 $ alice{personAge = 100}+          getJust 1+        personAge result @?= 100+    , testCase "delete" $ do+        result <- runTestApp backendType $ do+          aliceKey <- insert $ person "Alice"+          delete aliceKey+          getPeople+        result @?= []+    , testCase "update" $ do+        result <- runTestApp backendType $ do+          key <- insert $ person "Alice"+          update key [PersonName =. "Alicia"]+          getPeopleNames+        result @?= ["Alicia"]+    , testCase "updateGet" $ do+        (updateResult, getResult) <- runTestApp backendType $ do+          key <- insert $ person "Alice"+          updateResult <- updateGet key [PersonName =. "Alicia"]+          getResult <- getJust key+          return (updateResult, getResult)+        updateResult @?= getResult+    , testCase "insertEntity" $ do+        (insertResult, getResult) <- runTestApp backendType $ do+          insertResult <- insertEntity $ person "Alice"+          getResult <- getJust $ entityKey insertResult+          return (insertResult, getResult)+        entityVal insertResult @?= getResult+    , testCase "insertRecord" $ do+        (insertResult, getResult) <- runTestApp backendType $ do+          insertResult <- insertRecord $ person "Alice"+          getResult <- getJust 1+          return (insertResult, getResult)+        insertResult @?= getResult+    , testCase "getBy" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          mapM getBy [UniqueName "Alice", UniqueName "Bob"]+        map (fmap getName) result @?= [Just "Alice", Nothing]+    , testCase "getByValue" $ do+        result <- runTestApp backendType $ do+          let alice = person "Alice"+          insert_ alice+          mapM getByValue [alice, person "Bob"]+        map (fmap getName) result @?= [Just "Alice", Nothing]+    , testCase "checkUnique" $ do+        result <- runTestApp backendType $ do+          let alice = person "Alice"+          insert_ alice+          mapM+            checkUnique+            [ alice+            , person "Bob"+            , (person "Alice"){personAge = 100}+            ]+        result @?= [Just (UniqueName "Alice"), Nothing, Just (UniqueName "Alice")]+    , testCase "checkUniqueUpdateable" $ do+        result <- runTestApp backendType $ do+          let alice = person "Alice"+          insert_ alice+          mapM+            checkUniqueUpdateable+            [ Entity 1 alice+            , Entity 2 $ person "Bob"+            , Entity 3 $ (person "Alice"){personAge = 100}+            ]+        result @?= [Nothing, Nothing, Just (UniqueName "Alice")]+    , testCase "deleteBy" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          deleteBy $ UniqueName "Alice"+          getPeople+        result @?= []+    , testCase "insertUnique" $ do+        (result1, result2, people) <- runTestApp backendType $ do+          result1 <- insertUnique $ person "Alice"+          result2 <- insertUnique $ person "Alice"+          people <- getPeopleNames+          return (result1, result2, people)+        result1 @?= Just 1+        result2 @?= Nothing+        people @?= ["Alice"]+    , testCase "upsert" $ do+        (result1, result2, people) <- runTestApp backendType $ do+          result1 <- upsert (person "Alice") [PersonAge =. 0]+          result2 <- upsert (person "Alice") [PersonAge =. 100]+          people <- getPeople+          return (result1, result2, people)+        entityKey result1 @?= entityKey result2+        nameAndAge (entityVal result1) @?= ("Alice", 0)+        nameAndAge (entityVal result2) @?= ("Alice", 100)+        map nameAndAge people @?= [("Alice", 100)]+    , testCase "upsertBy" $ do+        (result1, result2, people) <- runTestApp backendType $ do+          result1 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 0]+          result2 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 100]+          people <- getPeople+          return (result1, result2, people)+        entityKey result1 @?= entityKey result2+        nameAndAge (entityVal result1) @?= ("Alice", 0)+        nameAndAge (entityVal result2) @?= ("Alice", 100)+        map nameAndAge people @?= [("Alice", 100)]+    , testCase "putMany" $ do+        result <- runTestApp backendType $ do+          let alice = person "Alice"+          insert_ alice+          putMany+            [ alice{personAge = 100}+            , person "Bob"+            ]+          getPeople+        map nameAndAge result+          @?= [ ("Alice", 100)+              , ("Bob", 0)+              ]+    , testCase "insertBy" $ do+        (result1, result2, people) <- runTestApp backendType $ do+          let alice = person "Alice"+          result1 <- insertBy alice+          result2 <- insertBy $ alice{personAge = 100}+          people <- getPeople+          return (result1, result2, people)+        result1 @?= Right 1+        first (entityKey &&& getName) result2 @?= Left (1, "Alice")+        map nameAndAge people @?= [("Alice", 0)]+    , testCase "insertUniqueEntity" $ do+        (result1, result2, people) <- runTestApp backendType $ do+          let alice = person "Alice"+          result1 <- insertUniqueEntity alice+          result2 <- insertUniqueEntity $ alice{personAge = 100}+          people <- getPeople+          return (result1, result2, people)+        (entityKey &&& getName) <$> result1 @?= Just (1, "Alice")+        result2 @?= Nothing+        map nameAndAge people @?= [("Alice", 0)]+    , testCase "replaceUnique" $ do+        (result1, result2, people) <- runTestApp backendType $ do+          let alice = person "Alice"+              bob = person "Bob"+          insertMany_ [alice, bob]+          result1 <- replaceUnique 1 $ alice{personName = "Bob"}+          result2 <- replaceUnique 2 $ bob{personAge = 100}+          people <- getPeople+          return (result1, result2, people)+        result1 @?= Just (UniqueName "Bob")+        result2 @?= Nothing+        map nameAndAge people @?= [("Alice", 0), ("Bob", 100)]+    , testCase "onlyUnique" $ do+        result <- runTestApp backendType $ onlyUnique $ person "Alice"+        result @?= UniqueName "Alice"+    , testCase "selectSourceRes" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          acquire <- selectSourceRes [] []+          Acquire.with acquire $ \conduit ->+            runConduit $ conduit .| Conduit.mapC getName .| Conduit.sinkList+        result @?= ["Alice", "Bob"]+    , testCase "selectFirst" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          sequence+            [ selectFirst [PersonName ==. "Alice"] []+            , selectFirst [PersonName ==. "Bob"] []+            ]+        map (fmap getName) result @?= [Just "Alice", Nothing]+    , testCase "selectKeysRes" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          acquire <- selectKeysRes @_ @Person [] []+          Acquire.with acquire $ \conduit ->+            runConduit $ conduit .| Conduit.sinkList+        result @?= [1, 2]+    , testCase "count" $ do+        result <- runTestApp backendType $ do+          insertMany_ $ map (\p -> p{personAge = 100}) [person "Alice", person "Bob"]+          count [PersonAge ==. 100]+        result @?= 2+    , testCase "exists" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          exists [PersonName ==. "Alice"]+        result @?= True+    , testCase "selectSource" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList+        result @?= ["Alice", "Bob"]+    , testCase "selectKeys" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          runConduit $ selectKeys @Person [] [] .| Conduit.sinkList+        result @?= [1, 2]+    , testCase "selectList" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          insert_ $ person "Bob"+          selectList [] []+        map getName result @?= ["Alice", "Bob"]+    , testCase "selectKeysList" $ do+        result <- runTestApp backendType $ do+          insert_ $ person "Alice"+          insert_ $ person "Bob"+          selectKeysList @Person [] []+        result @?= [1, 2]+    , testCase "updateWhere" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          updateWhere [PersonName ==. "Alice"] [PersonAge =. 100]+          getPeople+        map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]+    , testCase "deleteWhere" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          deleteWhere [PersonName ==. "Alice"]+          getPeopleNames+        result @?= ["Bob"]+    , testCase "updateWhereCount" $ do+        (rowsUpdated, people) <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          rowsUpdated <- updateWhereCount [PersonName ==. "Alice"] [PersonAge =. 100]+          people <- getPeople+          return (rowsUpdated, people)+        rowsUpdated @?= 1+        map nameAndAge people @?= [("Alice", 100), ("Bob", 0)]+    , testCase "deleteWhereCount" $ do+        (rowsDeleted, names) <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          rowsDeleted <- deleteWhereCount [PersonName ==. "Alice"]+          names <- getPeopleNames+          return (rowsDeleted, names)+        rowsDeleted @?= 1+        names @?= ["Bob"]+    , testCase "parseMigration" $ do+        result <- runTestApp backendType $ do+          setupUnsafeMigration+          parseMigration migration++        let sql = case backendType of+              Sqlite ->+                [ eq+                    ( False+                    , Text.concat+                        [ "CREATE TEMP TABLE \"person_backup\"("+                        , "\"id\" INTEGER PRIMARY KEY,"+                        , "\"name\" VARCHAR NOT NULL,"+                        , "\"age\" INTEGER NOT NULL,"+                        , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"+                        ]+                    )+                , anything+                , eq (True, "DROP TABLE \"person\"")+                , anything+                , anything+                , eq (False, "DROP TABLE \"person_backup\"")+                ]+              Postgresql ->+                [ eq (True, "ALTER TABLE \"person\" DROP COLUMN \"foo\"")+                ]++        result @?~ right (elemsAre sql)+    , testCase "parseMigration'" $ do+        let action :: (Migration -> TestApp a) -> IO a+            action f = runTestApp backendType $ do+              setupUnsafeMigration+              f migration++        result <- action parseMigration+        result' <- action parseMigration'+        Right result' @?= result+    , testCase "printMigration" $+        runTestApp backendType $ do+          setupUnsafeMigration+          printMigration migration+    , testCase "showMigration" $ do+        result <- runTestApp backendType $ do+          setupUnsafeMigration+          showMigration migration++        let sql = case backendType of+              Sqlite ->+                [ eq $+                    Text.concat+                      [ "CREATE TEMP TABLE \"person_backup\"("+                      , "\"id\" INTEGER PRIMARY KEY,"+                      , "\"name\" VARCHAR NOT NULL,"+                      , "\"age\" INTEGER NOT NULL,"+                      , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"));"+                      ]+                , anything+                , eq "DROP TABLE \"person\";"+                , anything+                , anything+                , eq "DROP TABLE \"person_backup\";"+                ]+              Postgresql ->+                [ eq "ALTER TABLE \"person\" DROP COLUMN \"foo\";"+                ]++        result @?~ elemsAre sql+    , testCase "getMigration" $ do+        result <- runTestApp backendType $ do+          setupUnsafeMigration+          getMigration migration++        let sql = case backendType of+              Sqlite ->+                [ eq $+                    Text.concat+                      [ "CREATE TEMP TABLE \"person_backup\"("+                      , "\"id\" INTEGER PRIMARY KEY,"+                      , "\"name\" VARCHAR NOT NULL,"+                      , "\"age\" INTEGER NOT NULL,"+                      , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"+                      ]+                , anything+                , eq "DROP TABLE \"person\""+                , anything+                , anything+                , eq "DROP TABLE \"person_backup\""+                ]+              Postgresql ->+                [ eq "ALTER TABLE \"person\" DROP COLUMN \"foo\""+                ]++        result @?~ elemsAre sql+    , testCase "runMigration" $ do+        result <- runTestApp backendType $ do+          setupSafeMigration+          runMigration migration+          getSchemaColumnNames backendType "person"+        assertNotIn "removed_column" result+    , testCase "runMigrationQuiet" $ do+        (withQuiet, cols) <- runTestApp backendType $ do+          setupSafeMigration+          sql <- runMigrationQuiet migration+          cols <- getSchemaColumnNames backendType "person"+          return (sql, cols)+        withSilent <- runTestApp backendType $ do+          setupSafeMigration+          runMigrationSilent migration+        assertNotIn "removed_column" cols+        withQuiet @?= withSilent+    , testCase "runMigrationSilent" $ do+        (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do+          setupSafeMigration+          sqlPlanned <- getMigration migration+          sqlExecuted <- runMigrationSilent migration+          cols <- getSchemaColumnNames backendType "person"+          return (sqlPlanned, sqlExecuted, cols)+        assertNotIn "removed_column" cols+        sqlExecuted @?= sqlPlanned+    , testCase "runMigrationUnsafe" $ do+        result <- runTestApp backendType $ do+          setupUnsafeMigration+          runMigrationUnsafe migration+          getSchemaColumnNames backendType "person"+        assertNotIn "removed_column" result+    , testCase "runMigrationUnsafeQuiet" $ do+        (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do+          setupUnsafeMigration+          sqlPlanned <- getMigration migration+          sqlExecuted <- runMigrationUnsafeQuiet migration+          cols <- getSchemaColumnNames backendType "person"+          return (sqlPlanned, sqlExecuted, cols)+        assertNotIn "removed_column" cols+        sqlExecuted @?= sqlPlanned+    , testCase "getFieldName" $ do+        result <-+          runTestApp backendType $+            getFieldName PersonName+        result @?= "\"name\""+    , testCase "getTableName" $ do+        result <-+          runTestApp backendType $+            getTableName $+              person "Alice"+        result @?= "\"person\""+    , testCase "withRawQuery" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          withRawQuery "SELECT name FROM person" [] $+            Conduit.mapC (fromPersistValue' @Text . head) .| Conduit.sinkList++        result @?= ["Alice", "Bob"]+    , testCase "rawQueryRes" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          acquire <- rawQueryRes "SELECT name FROM person" []+          Acquire.with acquire $ \conduit ->+            runConduit $ conduit .| Conduit.mapC (fromPersistValue' @Text . head) .| Conduit.sinkList+        result @?= ["Alice", "Bob"]+    , testCase "rawQuery" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.mapC (fromPersistValue' @Text . head) .| Conduit.sinkList+        result @?= ["Alice", "Bob"]+    , testCase "rawExecute" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          rawExecute "UPDATE person SET age = 100 WHERE name = 'Alice'" []+          getPeople+        map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]+    , testCase "rawExecuteCount" $ do+        (rowsUpdated, people) <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          rowsUpdated <- rawExecuteCount "UPDATE person SET age = 100 WHERE name = 'Alice'" []+          people <- getPeople+          return (rowsUpdated, people)+        rowsUpdated @?= 1+        map nameAndAge people @?= [("Alice", 100), ("Bob", 0)]+    , testCase "rawSql" $ do+        result <- runTestApp backendType $ do+          insertMany_ [person "Alice", person "Bob"]+          rawSql @(Single String) "SELECT name FROM person" []+        map unSingle result @?= ["Alice", "Bob"]+    , testCase "transactionSave" $ do+        result1 <- runTestApp backendType $ do+          catchTestError $ withTransaction $ do+            insert_ $ person "Alice"+            insertAndFail $ person "Bob"+          getPeopleNames+        result1 @?= []++        result2 <- runTestApp backendType $ do+          catchTestError $ withTransaction $ do+            insert_ $ person "Alice"+            transactionSave+            insertAndFail $ person "Bob"+          getPeopleNames+        result2 @?= ["Alice"]+    , testCase "transactionSaveWithIsolation" $ do+        result1 <- runTestApp backendType $ do+          catchTestError $ withTransaction $ do+            insert_ $ person "Alice"+            insertAndFail $ person "Bob"+          getPeopleNames+        result1 @?= []++        result2 <- runTestApp backendType $ do+          catchTestError $ withTransaction $ do+            insert_ $ person "Alice"+            transactionSaveWithIsolation Serializable+            insertAndFail $ person "Bob"+          getPeopleNames+        result2 @?= ["Alice"]+    , testCase "transactionUndo" $ do+        result <- runTestApp backendType $ withTransaction $ do+          insert_ $ person "Alice"+          transactionUndo+          getPeopleNames+        result @?= []+    , testCase "transactionUndoWithIsolation" $ do+        result <- runTestApp backendType $ withTransaction $ do+          insert_ $ person "Alice"+          transactionUndoWithIsolation Serializable+          getPeopleNames+        result @?= []+    ]++testInterop :: BackendType -> TestTree+testInterop backendType =+  testGroup+    "Interop with third-party Persistent libraries"+    [ testCase "unsafeLiftSql" $ do+        let alice = person "Alice"+        result <- runTestApp backendType $ do+          insert_ alice+          esqueletoSelect $+            E.from $+              E.table @Person+        result @?= [Entity 1 alice]+    ]++{- Persistent helpers -}++fromPersistValue' :: PersistField a => PersistValue -> a+fromPersistValue' = either (error . Text.unpack) id . fromPersistValue++{- Meta SQL helpers -}++-- | Put the database in a state where running a migration is safe.+setupSafeMigration :: MonadSqlQuery m => m ()+setupSafeMigration = rawExecute "ALTER TABLE person ADD COLUMN removed_column VARCHAR" []++-- | Put the database in a state where running a migration is unsafe.+setupUnsafeMigration :: MonadSqlQuery m => m ()+setupUnsafeMigration = rawExecute "ALTER TABLE person ADD COLUMN foo VARCHAR" []++-- | Get the names of all columns in the given table.+getSchemaColumnNames :: MonadSqlQuery m => BackendType -> String -> m [String]+getSchemaColumnNames backendType tableName = map unSingle <$> rawSql sql []+  where+    sql = Text.pack $ case backendType of+      Sqlite -> "SELECT name FROM pragma_table_info('" ++ tableName ++ "')"+      Postgresql ->+        unlines+          [ "SELECT column_name FROM information_schema.columns"+          , "WHERE table_schema = 'public' AND table_name = '" ++ tableName ++ "'"+          ]++{- Test helpers -}++data TestError = TestError+  deriving (Show, Eq)++instance Exception TestError++catchTestError :: (MonadUnliftIO m, Eq a, Show a) => m a -> m ()+catchTestError m = do+  result <- try m+  liftIO $ result @?= Left TestError++insertAndFail ::+  ( MonadRerunnableIO m+  , MonadSqlQuery m+  , PersistRecordBackend record SqlBackend+  , Typeable record+  , SafeToInsert record+  ) =>+  record ->+  m ()+insertAndFail record = do+  insert_ record+  rerunnableIO $ throwIO TestError++assertNotIn :: (Eq a, Show a) => a -> [a] -> Assertion+assertNotIn a as = as @?= filter (/= a) as

@@ -1,19 +1,4 @@-import Test.Tasty--import qualified Basic-import qualified Integration-import qualified MockSqlQueryT-import qualified Mocked-import qualified SqlQueryRepTest--main :: IO ()-main = defaultMain tests--tests :: TestTree-tests = testGroup "persistent-mtl"-  [ Basic.tests-  , Mocked.tests-  , Integration.tests-  , MockSqlQueryT.tests-  , SqlQueryRepTest.tests-  ]+{- AUTOCOLLECT.MAIN+suite_name = persistent-mtl+strip_suffix = Test+-}

@@ -1,38 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TypeApplications #-}--module MockSqlQueryT where--import Database.Persist (Entity(..))-import Database.Persist.Sql (toSqlKey)-import Test.Tasty-import Test.Tasty.HUnit-import UnliftIO (SomeException, try)--import Database.Persist.Monad.TestUtils-import Example--tests :: TestTree-tests = testGroup "MockSqlQueryT"-  [ testCase "it errors if it could not find a mock" $ do-      result <- try $ runMockSqlQueryT getPeopleNames []-      case result of-        Right _ -> assertFailure "runMockSqlQueryT did not fail"-        Left e -> do-          let msg = head $ lines $ show (e :: SomeException)-          msg @?= "Could not find mock for query: SelectList{..}<Person>"-  , testCase "it continues after a mock doesn't match" $ do-      result <- runMockSqlQueryT getPeopleNames-        [ withRecord @Post $ \_ -> error "getPeopleNames matched Post record"-        , mockQuery $ \_ -> Nothing-        , withRecord @Person $ \case-            SelectList _ _ -> Just-              [ Entity (toSqlKey 1) (Person "Alice" 10)-              , Entity (toSqlKey 2) (Person "Bob" 20)-              ]-            _ -> Nothing-        ]--      result @?= ["Alice", "Bob"]-  ]

@@ -1,548 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module Mocked where--import Conduit (runConduit, runResourceT, (.|))-import qualified Conduit-import qualified Data.Acquire as Acquire-import qualified Data.Map.Strict as Map-import Database.Persist.Sql-    (Entity(..), Single(..), toPersistValue, (=.), (==.))-import Test.Tasty-import Test.Tasty.HUnit--import Database.Persist.Monad-import Database.Persist.Monad.TestUtils-import Example--tests :: TestTree-tests = testGroup "Mocked tests"-  [ testWithTransaction-  , testPersistentAPI-  ]--testWithTransaction :: TestTree-testWithTransaction = testGroup "withTransaction"-  [ testCase "it doesn't error with MockSqlQueryT" $-      runMockSqlQueryT (withTransaction $ insert_ $ person "Alice")-        [ withRecord @Person $ \case-            Insert_ _ -> Just ()-            _ -> Nothing-        ]-  ]--testPersistentAPI :: TestTree-testPersistentAPI = testGroup "Persistent API"-  [ testCase "get" $ do-      result <- runMockSqlQueryT (mapM get [1, 2])-        [ withRecord @Person $ \case-            Get n-              | n == 1 -> Just $ Just $ person "Alice"-              | n == 2 -> Just Nothing-            _ -> Nothing-        ]-      map (fmap personName) result @?= [Just "Alice", Nothing]--  , testCase "getMany" $ do-      result <- runMockSqlQueryT (getMany [1])-        [ withRecord @Person $ \case-            GetMany _ -> Just $ Map.fromList [(1, person "Alice")]-            _ -> Nothing-        ]-      personName <$> Map.lookup 1 result @?= Just "Alice"--  , testCase "getJust" $ do-      result <- runMockSqlQueryT (getJust 1)-        [ withRecord @Person $ \case-            GetJust _ -> Just $ person "Alice"-            _ -> Nothing-        ]-      personName result @?= "Alice"--  , testCase "getJustEntity" $ do-      result <- runMockSqlQueryT (getJustEntity 1)-        [ withRecord @Person $ \case-            GetJustEntity _ -> Just $ Entity 1 $ person "Alice"-            _ -> Nothing-        ]-      getName result @?= "Alice"--  , testCase "getEntity" $ do-      result <- runMockSqlQueryT (mapM getEntity [1, 2])-        [ withRecord @Person $ \case-            GetEntity n-              | n == 1 -> Just $ Just $ Entity 1 $ person "Alice"-              | n == 2 -> Just Nothing-            _ -> Nothing-        ]-      map (fmap getName) result @?= [Just "Alice", Nothing]--  , testCase "belongsTo" $ do-      let post1 = Post "Post #1" 1 (Just 1)-          post2 = Post "Post #2" 1 Nothing-      result <- runMockSqlQueryT (mapM (belongsTo postEditor) [post1, post2])-        [ withRecord @(Post, Person) $ \case-            BelongsTo _ Post{postEditor = Just 1} -> Just $ Just $ person "Alice"-            BelongsTo _ Post{postEditor = Nothing} -> Just Nothing-            _ -> Nothing-        ]-      map (fmap personName) result @?= [Just "Alice", Nothing]--  , testCase "belongsToJust" $ do-      let post1 = Post "Post #1" 1 Nothing-      result <- runMockSqlQueryT (belongsToJust postAuthor post1)-        [ withRecord @(Post, Person) $ \case-            BelongsToJust _ _ -> Just $ person "Alice"-            _ -> Nothing-        ]-      personName result @?= "Alice"--  , testCase "insert" $ do-      result <- runMockSqlQueryT (insert $ person "Alice")-        [ withRecord @Person $ \case-            Insert _ -> Just 1-            _ -> Nothing-        ]-      result @?= 1--  , testCase "insert_" $ do-      result <- runMockSqlQueryT (insert_ $ person "Alice")-        [ withRecord @Person $ \case-            Insert_ _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "insertMany" $ do-      result <- runMockSqlQueryT (insertMany [person "Alice", person "Bob"])-        [ withRecord @Person $ \case-            InsertMany records -> Just $ map fromIntegral [ 1 .. length records ]-            _ -> Nothing-        ]-      result @?= [1, 2]--  , testCase "insertMany_" $ do-      result <- runMockSqlQueryT (insertMany_ [person "Alice", person "Bob"])-        [ withRecord @Person $ \case-            InsertMany_ _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "insertEntityMany" $ do-      result <- runMockSqlQueryT (insertEntityMany [Entity 1 $ person "Alice"])-        [ withRecord @Person $ \case-            InsertEntityMany _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "insertKey" $ do-      result <- runMockSqlQueryT (insertKey 1 $ person "Alice")-        [ withRecord @Person $ \case-            InsertKey _ _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "repsert" $ do-      result <- runMockSqlQueryT (repsert 1 $ person "Alice")-        [ withRecord @Person $ \case-            Repsert _ _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "repsertMany" $ do-      result <- runMockSqlQueryT (repsertMany [(1, person "Alice")])-        [ withRecord @Person $ \case-            RepsertMany _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "replace" $ do-      result <- runMockSqlQueryT (replace 1 $ person "Alice")-        [ withRecord @Person $ \case-            Replace _ _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "delete" $ do-      result <- runMockSqlQueryT (delete @Person 1)-        [ withRecord @Person $ \case-            Delete _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "update" $ do-      result <- runMockSqlQueryT (update 1 [PersonName =. "Alicia"])-        [ withRecord @Person $ \case-            Update _ _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "updateGet" $ do-      result <- runMockSqlQueryT (updateGet 1 [PersonName =. "Alicia"])-        [ withRecord @Person $ \case-            UpdateGet _ _ -> Just $ person "Alicia"-            _ -> Nothing-        ]-      personName result @?= "Alicia"--  , testCase "insertEntity" $ do-      let alice = person "Alice"-      result <- runMockSqlQueryT (insertEntity alice)-        [ withRecord @Person $ \case-            InsertEntity _ -> Just $ Entity 1 alice-            _ -> Nothing-        ]-      entityVal result @?= alice--  , testCase "insertRecord" $ do-      let alice = person "Alice"-      result <- runMockSqlQueryT (insertRecord alice)-        [ withRecord @Person $ \case-            InsertRecord _ -> Just alice-            _ -> Nothing-        ]-      result @?= alice--  , testCase "getBy" $ do-      result <- runMockSqlQueryT (mapM getBy [UniqueName "Alice", UniqueName "Bob"])-        [ withRecord @Person $ \case-            GetBy (UniqueName "Alice") -> Just $ Just $ Entity 1 $ person "Alice"-            GetBy (UniqueName "Bob") -> Just Nothing-            _ -> Nothing-        ]-      map (fmap getName) result @?= [Just "Alice", Nothing]--  , testCase "getByValue" $ do-      result <- runMockSqlQueryT (mapM getByValue [person "Alice", person "Bob"])-        [ withRecord @Person $ \case-            GetByValue Person{personName = "Alice"} -> Just $ Just $ Entity 1 $ person "Alice"-            GetByValue Person{personName = "Bob"} -> Just Nothing-            _ -> Nothing-        ]-      map (fmap getName) result @?= [Just "Alice", Nothing]--  , testCase "checkUnique" $ do-      result <- runMockSqlQueryT (mapM checkUnique [person "Alice", person "Bob"])-        [ withRecord @Person $ \case-            CheckUnique Person{personName = "Alice"} -> Just $ Just $ UniqueName "Alice"-            CheckUnique Person{personName = "Bob"} -> Just Nothing-            _ -> Nothing-        ]-      result @?= [Just $ UniqueName "Alice", Nothing]--#if MIN_VERSION_persistent(2,11,0)-  , testCase "checkUniqueUpdateable" $ do-      result <- runMockSqlQueryT (mapM checkUniqueUpdateable [Entity 1 $ person "Alice", Entity 2 $ person "Bob"])-        [ withRecord @Person $ \case-            CheckUniqueUpdateable (Entity _ Person{personName = "Alice"}) -> Just $ Just $ UniqueName "Alice"-            CheckUniqueUpdateable (Entity _ Person{personName = "Bob"}) -> Just Nothing-            _ -> Nothing-        ]-      result @?= [Just $ UniqueName "Alice", Nothing]-#endif--  , testCase "deleteBy" $ do-      result <- runMockSqlQueryT (deleteBy $ UniqueName "Alice")-        [ withRecord @Person $ \case-            DeleteBy _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "insertUnique" $ do-      result <- runMockSqlQueryT (mapM insertUnique [person "Alice", person "Bob"])-        [ withRecord @Person $ \case-            InsertUnique Person{personName = "Alice"} -> Just $ Just 1-            InsertUnique Person{personName = "Bob"} -> Just Nothing-            _ -> Nothing-        ]-      result @?= [Just 1, Nothing]--  , testCase "upsert" $ do-      let alice = person "Alice"-      result <- runMockSqlQueryT (upsert alice [PersonAge =. 100])-        [ withRecord @Person $ \case-            Upsert _ _ -> Just $ Entity 1 alice-            _ -> Nothing-        ]-      result @?= Entity 1 alice--  , testCase "upsertBy" $ do-      let alice = person "Alice"-      result <- runMockSqlQueryT (upsertBy (UniqueName "Alice") alice [PersonAge =. 100])-        [ withRecord @Person $ \case-            UpsertBy _ _ _ -> Just $ Entity 1 alice-            _ -> Nothing-        ]-      result @?= Entity 1 alice--  , testCase "putMany" $ do-      result <- runMockSqlQueryT (putMany [person "Alice"])-        [ withRecord @Person $ \case-            PutMany _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "insertBy" $ do-      let alice = person "Alice"-      result <- runMockSqlQueryT (mapM insertBy [alice, person "Bob"])-        [ withRecord @Person $ \case-            InsertBy Person{personName = "Alice"} -> Just $ Left $ Entity 1 alice-            InsertBy Person{personName = "Bob"} -> Just $ Right 2-            _ -> Nothing-        ]-      result @?= [Left $ Entity 1 alice, Right 2]--  , testCase "insertUniqueEntity" $ do-      let bob = person "Bob"-      result <- runMockSqlQueryT (mapM insertUniqueEntity [person "Alice", bob])-        [ withRecord @Person $ \case-            InsertUniqueEntity Person{personName = "Alice"} -> Just Nothing-            InsertUniqueEntity Person{personName = "Bob"} -> Just $ Just $ Entity 1 bob-            _ -> Nothing-        ]-      result @?= [Nothing, Just $ Entity 1 bob]--  , testCase "replaceUnique" $ do-      result <- runMockSqlQueryT (mapM (uncurry replaceUnique) [(1, person "Alice"), (2, person "Bob")])-        [ withRecord @Person $ \case-            ReplaceUnique _ Person{personName = "Alice"} -> Just Nothing-            ReplaceUnique _ Person{personName = "Bob"} -> Just $ Just $ UniqueName "Bob"-            _ -> Nothing-        ]-      result @?= [Nothing, Just $ UniqueName "Bob"]--  , testCase "onlyUnique" $ do-      result <- runMockSqlQueryT (onlyUnique $ person "Alice")-        [ withRecord @Person $ \case-            OnlyUnique _ -> Just $ UniqueName "Alice"-            _ -> Nothing-        ]-      result @?= UniqueName "Alice"--  , testCase "selectSourceRes" $ do-      acquire <- runMockSqlQueryT (selectSourceRes [] [])-        [ mockSelectSource $ \_ _ -> Just-            [ Entity 1 $ person "Alice"-            , Entity 2 $ person "Bob"-            ]-        ]-      result <- Acquire.with acquire $ \conduit ->-        runConduit $ conduit .| Conduit.mapC getName .| Conduit.sinkList-      result @?= ["Alice", "Bob"]--  , testCase "selectFirst" $ do-      result1 <- runMockSqlQueryT (selectFirst [PersonName ==. "Alice"] [])-        [ withRecord @Person $ \case-            SelectFirst _ _ -> Just $ Just $ Entity 1 $ person "Alice"-            _ -> Nothing-        ]-      getName <$> result1 @?= Just "Alice"-      result2 <- runMockSqlQueryT (selectFirst [PersonName ==. "Alice"] [])-        [ withRecord @Person $ \case-            SelectFirst _ _ -> Just Nothing-            _ -> Nothing-        ]-      result2 @?= Nothing--  , testCase "selectKeysRes" $ do-      let keys = [1, 2, 3]-      acquire <- runMockSqlQueryT (selectKeysRes @_ @Person [] [])-        [ mockSelectKeys $ \_ _ -> Just keys-        ]-      result <- Acquire.with acquire $ \conduit ->-        runConduit $ conduit .| Conduit.sinkList-      result @?= keys--  , testCase "count" $ do-      result <- runMockSqlQueryT (count @Person [])-        [ withRecord @Person $ \case-            Count _ -> Just 10-            _ -> Nothing-        ]-      result @?= 10--#if MIN_VERSION_persistent(2,11,0)-  , testCase "exists" $ do-      result <- runMockSqlQueryT (exists @Person [])-        [ withRecord @Person $ \case-            Exists _ -> Just True-            _ -> Nothing-        ]-      result @?= True-#endif--  , testCase "selectSource" $ do-      result <- runResourceT $ runMockSqlQueryT-        (runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList)-        [ mockSelectSource $ \_ _ -> Just-            [ Entity 1 $ person "Alice"-            , Entity 2 $ person "Bob"-            ]-        ]-      result @?= ["Alice", "Bob"]--  , testCase "selectKeys" $ do-      let keys = [1, 2, 3]-      result <- runResourceT $ runMockSqlQueryT-        (runConduit $ selectKeys @Person [] [] .| Conduit.sinkList)-        [ mockSelectKeys $ \_ _ -> Just keys-        ]-      result @?= keys--  , testCase "selectList" $ do-      result <- runMockSqlQueryT (selectList [] [])-        [ withRecord @Person $ \case-            SelectList _ _ -> Just-              [ Entity 1 (person "Alice")-              , Entity 2 (person "Bob")-              ]-            _ -> Nothing-        ]-      map getName result @?= ["Alice", "Bob"]--  , testCase "selectKeysList" $ do-      let keys = [1, 2, 3]-      result <- runMockSqlQueryT (selectKeysList @Person [] [])-        [ withRecord @Person $ \case-            SelectKeysList _ _ -> Just keys-            _ -> Nothing-        ]-      result @?= keys--  , testCase "updateWhere" $ do-      result <- runMockSqlQueryT (updateWhere [] [PersonAge =. 100])-        [ withRecord @Person $ \case-            UpdateWhere _ _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "deleteWhere" $ do-      result <- runMockSqlQueryT (deleteWhere [PersonName ==. "Alice"])-        [ withRecord @Person $ \case-            DeleteWhere _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "updateWhereCount" $ do-      result <- runMockSqlQueryT (updateWhereCount [] [PersonAge =. 100])-        [ withRecord @Person $ \case-            UpdateWhereCount _ _ -> Just 10-            _ -> Nothing-        ]-      result @?= 10--  , testCase "deleteWhereCount" $ do-      result <- runMockSqlQueryT (deleteWhereCount [PersonName ==. "Alice"])-        [ withRecord @Person $ \case-            DeleteWhereCount _ -> Just 10-            _ -> Nothing-        ]-      result @?= 10--#if !MIN_VERSION_persistent(2,13,0)-  , testCase "deleteCascade" $ do-      result <- runMockSqlQueryT (deleteCascade @Person 1)-        [ withRecord @Person $ \case-            DeleteCascade _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "deleteCascadeWhere" $ do-      result <- runMockSqlQueryT (deleteCascadeWhere [PersonName ==. "Alice"])-        [ withRecord @Person $ \case-            DeleteCascadeWhere _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()-#endif--  , testCase "getFieldName" $ do-      result <- runMockSqlQueryT (getFieldName PersonName)-        [ withRecord @Person $ \case-            GetFieldName PersonName -> Just "\"name\""-            _ -> Nothing-        ]-      result @?= "\"name\""--  , testCase "getTableName" $ do-      result <- runMockSqlQueryT (getTableName $ person "Alice")-        [ withRecord @Person $ \case-            GetTableName _ -> Just "\"person\""-            _ -> Nothing-        ]-      result @?= "\"person\""--  , testCase "withRawQuery" $ do-      let query = "SELECT name FROM person"-          row1 = [toPersistValue @String "Alice"]-          row2 = [toPersistValue @String "Bob"]-          rows = [row1, row2]-      result <- runMockSqlQueryT (withRawQuery query [] Conduit.sinkList)-        [ mockWithRawQuery $ \sql _ ->-            if sql == query-              then Just rows-              else Nothing-        ]-      result @?= rows--  , testCase "rawQueryRes" $ do-      let row1 = [toPersistValue @String "Alice"]-          row2 = [toPersistValue @String "Bob"]-          rows = [row1, row2]-      acquire <- runMockSqlQueryT (rawQueryRes "SELECT name FROM person" [])-        [ mockRawQuery $ \_ _ -> Just rows-        ]-      result <- Acquire.with acquire $ \conduit ->-        runConduit $ conduit .| Conduit.sinkList-      result @?= rows--  , testCase "rawQuery" $ do-      let row1 = [toPersistValue @String "Alice"]-          row2 = [toPersistValue @String "Bob"]-          rows = [row1, row2]-      result <- runResourceT $ runMockSqlQueryT-        (runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.sinkList)-        [ mockRawQuery $ \_ _ -> Just rows-        ]-      result @?= rows--  , testCase "rawExecute" $ do-      result <- runMockSqlQueryT (rawExecute "DELETE FROM person" [])-        [ mockQuery $ \case-            RawExecute _ _ -> Just ()-            _ -> Nothing-        ]-      result @?= ()--  , testCase "rawExecuteCount" $ do-      result <- runMockSqlQueryT (rawExecuteCount "DELETE FROM person" [])-        [ mockQuery $ \case-            RawExecuteCount _ _ -> Just 10-            _ -> Nothing-        ]-      result @?= 10--  , testCase "rawSql" $ do-      let names = ["Alice", "Bob"] :: [String]-      result <- runMockSqlQueryT (rawSql "SELECT name FROM person" [])-        [ mockRawSql $ \_ _ -> Just $ map ((:[]) . toPersistValue) names-        ]-      map unSingle result @?= names-  ]

@@ -0,0 +1,621 @@+{- AUTOCOLLECT.TEST -}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module MockedTest (+  -- $AUTOCOLLECT.TEST.export$+) where++import Conduit (runConduit, runResourceT, (.|))+import qualified Conduit+import qualified Data.Acquire as Acquire+import qualified Data.Map.Strict as Map+import Database.Persist.Sql (+  Entity (..),+  Single (..),+  toPersistValue,+  toSqlKey,+  (=.),+  (==.),+ )+import Test.Tasty+import Test.Tasty.HUnit+import UnliftIO (SomeException, try)++import Database.Persist.Monad+import Database.Persist.Monad.TestUtils+import Example++test =+  testGroup+    "withTransaction"+    [ testCase "it doesn't error with MockSqlQueryT" $+        runMockSqlQueryT+          (withTransaction $ insert_ $ person "Alice")+          [ withRecord @Person $ \case+              Insert_ _ -> Just ()+              _ -> Nothing+          ]+    ]++test =+  testGroup+    "MockSqlQueryT"+    [ testCase "it errors if it could not find a mock" $ do+        result <- try $ runMockSqlQueryT getPeopleNames []+        case result of+          Right _ -> assertFailure "runMockSqlQueryT did not fail"+          Left e -> do+            let msg = head $ lines $ show (e :: SomeException)+            msg @?= "Could not find mock for query: SelectList{..}<Person>"+    , testCase "it continues after a mock doesn't match" $ do+        result <-+          runMockSqlQueryT+            getPeopleNames+            [ withRecord @Post $ \_ -> error "getPeopleNames matched Post record"+            , mockQuery $ \_ -> Nothing+            , withRecord @Person $ \case+                SelectList _ _ ->+                  Just+                    [ Entity (toSqlKey 1) (Person "Alice" 10)+                    , Entity (toSqlKey 2) (Person "Bob" 20)+                    ]+                _ -> Nothing+            ]++        result @?= ["Alice", "Bob"]+    ]++test =+  testGroup+    "Persistent API"+    [ testCase "get" $ do+        result <-+          runMockSqlQueryT+            (mapM get [1, 2])+            [ withRecord @Person $ \case+                Get n+                  | n == 1 -> Just $ Just $ person "Alice"+                  | n == 2 -> Just Nothing+                _ -> Nothing+            ]+        map (fmap personName) result @?= [Just "Alice", Nothing]+    , testCase "getMany" $ do+        result <-+          runMockSqlQueryT+            (getMany [1])+            [ withRecord @Person $ \case+                GetMany _ -> Just $ Map.fromList [(1, person "Alice")]+                _ -> Nothing+            ]+        personName <$> Map.lookup 1 result @?= Just "Alice"+    , testCase "getJust" $ do+        result <-+          runMockSqlQueryT+            (getJust 1)+            [ withRecord @Person $ \case+                GetJust _ -> Just $ person "Alice"+                _ -> Nothing+            ]+        personName result @?= "Alice"+    , testCase "getJustEntity" $ do+        result <-+          runMockSqlQueryT+            (getJustEntity 1)+            [ withRecord @Person $ \case+                GetJustEntity _ -> Just $ Entity 1 $ person "Alice"+                _ -> Nothing+            ]+        getName result @?= "Alice"+    , testCase "getEntity" $ do+        result <-+          runMockSqlQueryT+            (mapM getEntity [1, 2])+            [ withRecord @Person $ \case+                GetEntity n+                  | n == 1 -> Just $ Just $ Entity 1 $ person "Alice"+                  | n == 2 -> Just Nothing+                _ -> Nothing+            ]+        map (fmap getName) result @?= [Just "Alice", Nothing]+    , testCase "belongsTo" $ do+        let post1 = Post "Post #1" 1 (Just 1)+            post2 = Post "Post #2" 1 Nothing+        result <-+          runMockSqlQueryT+            (mapM (belongsTo postEditor) [post1, post2])+            [ withRecord @(Post, Person) $ \case+                BelongsTo _ Post{postEditor = Just 1} -> Just $ Just $ person "Alice"+                BelongsTo _ Post{postEditor = Nothing} -> Just Nothing+                _ -> Nothing+            ]+        map (fmap personName) result @?= [Just "Alice", Nothing]+    , testCase "belongsToJust" $ do+        let post1 = Post "Post #1" 1 Nothing+        result <-+          runMockSqlQueryT+            (belongsToJust postAuthor post1)+            [ withRecord @(Post, Person) $ \case+                BelongsToJust _ _ -> Just $ person "Alice"+                _ -> Nothing+            ]+        personName result @?= "Alice"+    , testCase "insert" $ do+        result <-+          runMockSqlQueryT+            (insert $ person "Alice")+            [ withRecord @Person $ \case+                Insert _ -> Just 1+                _ -> Nothing+            ]+        result @?= 1+    , testCase "insert_" $ do+        result <-+          runMockSqlQueryT+            (insert_ $ person "Alice")+            [ withRecord @Person $ \case+                Insert_ _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "insertMany" $ do+        result <-+          runMockSqlQueryT+            (insertMany [person "Alice", person "Bob"])+            [ withRecord @Person $ \case+                InsertMany records -> Just $ map fromIntegral [1 .. length records]+                _ -> Nothing+            ]+        result @?= [1, 2]+    , testCase "insertMany_" $ do+        result <-+          runMockSqlQueryT+            (insertMany_ [person "Alice", person "Bob"])+            [ withRecord @Person $ \case+                InsertMany_ _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "insertEntityMany" $ do+        result <-+          runMockSqlQueryT+            (insertEntityMany [Entity 1 $ person "Alice"])+            [ withRecord @Person $ \case+                InsertEntityMany _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "insertKey" $ do+        result <-+          runMockSqlQueryT+            (insertKey 1 $ person "Alice")+            [ withRecord @Person $ \case+                InsertKey _ _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "repsert" $ do+        result <-+          runMockSqlQueryT+            (repsert 1 $ person "Alice")+            [ withRecord @Person $ \case+                Repsert _ _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "repsertMany" $ do+        result <-+          runMockSqlQueryT+            (repsertMany [(1, person "Alice")])+            [ withRecord @Person $ \case+                RepsertMany _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "replace" $ do+        result <-+          runMockSqlQueryT+            (replace 1 $ person "Alice")+            [ withRecord @Person $ \case+                Replace _ _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "delete" $ do+        result <-+          runMockSqlQueryT+            (delete @Person 1)+            [ withRecord @Person $ \case+                Delete _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "update" $ do+        result <-+          runMockSqlQueryT+            (update 1 [PersonName =. "Alicia"])+            [ withRecord @Person $ \case+                Update _ _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "updateGet" $ do+        result <-+          runMockSqlQueryT+            (updateGet 1 [PersonName =. "Alicia"])+            [ withRecord @Person $ \case+                UpdateGet _ _ -> Just $ person "Alicia"+                _ -> Nothing+            ]+        personName result @?= "Alicia"+    , testCase "insertEntity" $ do+        let alice = person "Alice"+        result <-+          runMockSqlQueryT+            (insertEntity alice)+            [ withRecord @Person $ \case+                InsertEntity _ -> Just $ Entity 1 alice+                _ -> Nothing+            ]+        entityVal result @?= alice+    , testCase "insertRecord" $ do+        let alice = person "Alice"+        result <-+          runMockSqlQueryT+            (insertRecord alice)+            [ withRecord @Person $ \case+                InsertRecord _ -> Just alice+                _ -> Nothing+            ]+        result @?= alice+    , testCase "getBy" $ do+        result <-+          runMockSqlQueryT+            (mapM getBy [UniqueName "Alice", UniqueName "Bob"])+            [ withRecord @Person $ \case+                GetBy (UniqueName "Alice") -> Just $ Just $ Entity 1 $ person "Alice"+                GetBy (UniqueName "Bob") -> Just Nothing+                _ -> Nothing+            ]+        map (fmap getName) result @?= [Just "Alice", Nothing]+    , testCase "getByValue" $ do+        result <-+          runMockSqlQueryT+            (mapM getByValue [person "Alice", person "Bob"])+            [ withRecord @Person $ \case+                GetByValue Person{personName = "Alice"} -> Just $ Just $ Entity 1 $ person "Alice"+                GetByValue Person{personName = "Bob"} -> Just Nothing+                _ -> Nothing+            ]+        map (fmap getName) result @?= [Just "Alice", Nothing]+    , testCase "checkUnique" $ do+        result <-+          runMockSqlQueryT+            (mapM checkUnique [person "Alice", person "Bob"])+            [ withRecord @Person $ \case+                CheckUnique Person{personName = "Alice"} -> Just $ Just $ UniqueName "Alice"+                CheckUnique Person{personName = "Bob"} -> Just Nothing+                _ -> Nothing+            ]+        result @?= [Just $ UniqueName "Alice", Nothing]+    , testCase "checkUniqueUpdateable" $ do+        result <-+          runMockSqlQueryT+            (mapM checkUniqueUpdateable [Entity 1 $ person "Alice", Entity 2 $ person "Bob"])+            [ withRecord @Person $ \case+                CheckUniqueUpdateable (Entity _ Person{personName = "Alice"}) -> Just $ Just $ UniqueName "Alice"+                CheckUniqueUpdateable (Entity _ Person{personName = "Bob"}) -> Just Nothing+                _ -> Nothing+            ]+        result @?= [Just $ UniqueName "Alice", Nothing]+    , testCase "deleteBy" $ do+        result <-+          runMockSqlQueryT+            (deleteBy $ UniqueName "Alice")+            [ withRecord @Person $ \case+                DeleteBy _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "insertUnique" $ do+        result <-+          runMockSqlQueryT+            (mapM insertUnique [person "Alice", person "Bob"])+            [ withRecord @Person $ \case+                InsertUnique Person{personName = "Alice"} -> Just $ Just 1+                InsertUnique Person{personName = "Bob"} -> Just Nothing+                _ -> Nothing+            ]+        result @?= [Just 1, Nothing]+    , testCase "upsert" $ do+        let alice = person "Alice"+        result <-+          runMockSqlQueryT+            (upsert alice [PersonAge =. 100])+            [ withRecord @Person $ \case+                Upsert _ _ -> Just $ Entity 1 alice+                _ -> Nothing+            ]+        result @?= Entity 1 alice+    , testCase "upsertBy" $ do+        let alice = person "Alice"+        result <-+          runMockSqlQueryT+            (upsertBy (UniqueName "Alice") alice [PersonAge =. 100])+            [ withRecord @Person $ \case+                UpsertBy _ _ _ -> Just $ Entity 1 alice+                _ -> Nothing+            ]+        result @?= Entity 1 alice+    , testCase "putMany" $ do+        result <-+          runMockSqlQueryT+            (putMany [person "Alice"])+            [ withRecord @Person $ \case+                PutMany _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "insertBy" $ do+        let alice = person "Alice"+        result <-+          runMockSqlQueryT+            (mapM insertBy [alice, person "Bob"])+            [ withRecord @Person $ \case+                InsertBy Person{personName = "Alice"} -> Just $ Left $ Entity 1 alice+                InsertBy Person{personName = "Bob"} -> Just $ Right 2+                _ -> Nothing+            ]+        result @?= [Left $ Entity 1 alice, Right 2]+    , testCase "insertUniqueEntity" $ do+        let bob = person "Bob"+        result <-+          runMockSqlQueryT+            (mapM insertUniqueEntity [person "Alice", bob])+            [ withRecord @Person $ \case+                InsertUniqueEntity Person{personName = "Alice"} -> Just Nothing+                InsertUniqueEntity Person{personName = "Bob"} -> Just $ Just $ Entity 1 bob+                _ -> Nothing+            ]+        result @?= [Nothing, Just $ Entity 1 bob]+    , testCase "replaceUnique" $ do+        result <-+          runMockSqlQueryT+            (mapM (uncurry replaceUnique) [(1, person "Alice"), (2, person "Bob")])+            [ withRecord @Person $ \case+                ReplaceUnique _ Person{personName = "Alice"} -> Just Nothing+                ReplaceUnique _ Person{personName = "Bob"} -> Just $ Just $ UniqueName "Bob"+                _ -> Nothing+            ]+        result @?= [Nothing, Just $ UniqueName "Bob"]+    , testCase "onlyUnique" $ do+        result <-+          runMockSqlQueryT+            (onlyUnique $ person "Alice")+            [ withRecord @Person $ \case+                OnlyUnique _ -> Just $ UniqueName "Alice"+                _ -> Nothing+            ]+        result @?= UniqueName "Alice"+    , testCase "selectSourceRes" $ do+        acquire <-+          runMockSqlQueryT+            (selectSourceRes [] [])+            [ mockSelectSource $ \_ _ ->+                Just+                  [ Entity 1 $ person "Alice"+                  , Entity 2 $ person "Bob"+                  ]+            ]+        result <- Acquire.with acquire $ \conduit ->+          runConduit $ conduit .| Conduit.mapC getName .| Conduit.sinkList+        result @?= ["Alice", "Bob"]+    , testCase "selectFirst" $ do+        result1 <-+          runMockSqlQueryT+            (selectFirst [PersonName ==. "Alice"] [])+            [ withRecord @Person $ \case+                SelectFirst _ _ -> Just $ Just $ Entity 1 $ person "Alice"+                _ -> Nothing+            ]+        getName <$> result1 @?= Just "Alice"+        result2 <-+          runMockSqlQueryT+            (selectFirst [PersonName ==. "Alice"] [])+            [ withRecord @Person $ \case+                SelectFirst _ _ -> Just Nothing+                _ -> Nothing+            ]+        result2 @?= Nothing+    , testCase "selectKeysRes" $ do+        let keys = [1, 2, 3]+        acquire <-+          runMockSqlQueryT+            (selectKeysRes @_ @Person [] [])+            [ mockSelectKeys $ \_ _ -> Just keys+            ]+        result <- Acquire.with acquire $ \conduit ->+          runConduit $ conduit .| Conduit.sinkList+        result @?= keys+    , testCase "count" $ do+        result <-+          runMockSqlQueryT+            (count @Person [])+            [ withRecord @Person $ \case+                Count _ -> Just 10+                _ -> Nothing+            ]+        result @?= 10+    , testCase "exists" $ do+        result <-+          runMockSqlQueryT+            (exists @Person [])+            [ withRecord @Person $ \case+                Exists _ -> Just True+                _ -> Nothing+            ]+        result @?= True+    , testCase "selectSource" $ do+        result <-+          runResourceT $+            runMockSqlQueryT+              (runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList)+              [ mockSelectSource $ \_ _ ->+                  Just+                    [ Entity 1 $ person "Alice"+                    , Entity 2 $ person "Bob"+                    ]+              ]+        result @?= ["Alice", "Bob"]+    , testCase "selectKeys" $ do+        let keys = [1, 2, 3]+        result <-+          runResourceT $+            runMockSqlQueryT+              (runConduit $ selectKeys @Person [] [] .| Conduit.sinkList)+              [ mockSelectKeys $ \_ _ -> Just keys+              ]+        result @?= keys+    , testCase "selectList" $ do+        result <-+          runMockSqlQueryT+            (selectList [] [])+            [ withRecord @Person $ \case+                SelectList _ _ ->+                  Just+                    [ Entity 1 (person "Alice")+                    , Entity 2 (person "Bob")+                    ]+                _ -> Nothing+            ]+        map getName result @?= ["Alice", "Bob"]+    , testCase "selectKeysList" $ do+        let keys = [1, 2, 3]+        result <-+          runMockSqlQueryT+            (selectKeysList @Person [] [])+            [ withRecord @Person $ \case+                SelectKeysList _ _ -> Just keys+                _ -> Nothing+            ]+        result @?= keys+    , testCase "updateWhere" $ do+        result <-+          runMockSqlQueryT+            (updateWhere [] [PersonAge =. 100])+            [ withRecord @Person $ \case+                UpdateWhere _ _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "deleteWhere" $ do+        result <-+          runMockSqlQueryT+            (deleteWhere [PersonName ==. "Alice"])+            [ withRecord @Person $ \case+                DeleteWhere _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "updateWhereCount" $ do+        result <-+          runMockSqlQueryT+            (updateWhereCount [] [PersonAge =. 100])+            [ withRecord @Person $ \case+                UpdateWhereCount _ _ -> Just 10+                _ -> Nothing+            ]+        result @?= 10+    , testCase "deleteWhereCount" $ do+        result <-+          runMockSqlQueryT+            (deleteWhereCount [PersonName ==. "Alice"])+            [ withRecord @Person $ \case+                DeleteWhereCount _ -> Just 10+                _ -> Nothing+            ]+        result @?= 10+    , testCase "getFieldName" $ do+        result <-+          runMockSqlQueryT+            (getFieldName PersonName)+            [ withRecord @Person $ \case+                GetFieldName PersonName -> Just "\"name\""+                _ -> Nothing+            ]+        result @?= "\"name\""+    , testCase "getTableName" $ do+        result <-+          runMockSqlQueryT+            (getTableName $ person "Alice")+            [ withRecord @Person $ \case+                GetTableName _ -> Just "\"person\""+                _ -> Nothing+            ]+        result @?= "\"person\""+    , testCase "withRawQuery" $ do+        let query = "SELECT name FROM person"+            row1 = [toPersistValue @String "Alice"]+            row2 = [toPersistValue @String "Bob"]+            rows = [row1, row2]+        result <-+          runMockSqlQueryT+            (withRawQuery query [] Conduit.sinkList)+            [ mockWithRawQuery $ \sql _ ->+                if sql == query+                  then Just rows+                  else Nothing+            ]+        result @?= rows+    , testCase "rawQueryRes" $ do+        let row1 = [toPersistValue @String "Alice"]+            row2 = [toPersistValue @String "Bob"]+            rows = [row1, row2]+        acquire <-+          runMockSqlQueryT+            (rawQueryRes "SELECT name FROM person" [])+            [ mockRawQuery $ \_ _ -> Just rows+            ]+        result <- Acquire.with acquire $ \conduit ->+          runConduit $ conduit .| Conduit.sinkList+        result @?= rows+    , testCase "rawQuery" $ do+        let row1 = [toPersistValue @String "Alice"]+            row2 = [toPersistValue @String "Bob"]+            rows = [row1, row2]+        result <-+          runResourceT $+            runMockSqlQueryT+              (runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.sinkList)+              [ mockRawQuery $ \_ _ -> Just rows+              ]+        result @?= rows+    , testCase "rawExecute" $ do+        result <-+          runMockSqlQueryT+            (rawExecute "DELETE FROM person" [])+            [ mockQuery $ \case+                RawExecute _ _ -> Just ()+                _ -> Nothing+            ]+        result @?= ()+    , testCase "rawExecuteCount" $ do+        result <-+          runMockSqlQueryT+            (rawExecuteCount "DELETE FROM person" [])+            [ mockQuery $ \case+                RawExecuteCount _ _ -> Just 10+                _ -> Nothing+            ]+        result @?= 10+    , testCase "rawSql" $ do+        let names = ["Alice", "Bob"] :: [String]+        result <-+          runMockSqlQueryT+            (rawSql "SELECT name FROM person" [])+            [ mockRawSql $ \_ _ -> Just $ map ((: []) . toPersistValue) names+            ]+        map unSingle result @?= names+    ]

@@ -0,0 +1,32 @@+{- AUTOCOLLECT.TEST -}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}++module READMETest (+  -- $AUTOCOLLECT.TEST.export$+) where++import Test.Tasty.HUnit++import Database.Persist.Monad+import Database.Persist.Monad.TestUtils+import Example++test =+  testCase "withTransaction example works" $ do+    let foo :: MonadSqlQuery m => m ()+        foo = insert_ $ person "Alice"+        bar :: MonadSqlQuery m => m ()+        bar = insert_ $ person "Bob"+        fooAndBar :: MonadSqlQuery m => m ()+        fooAndBar = withTransaction $ foo >> bar+    runMockSqlQueryT+      fooAndBar+      [ withRecord @Person $ \case+          Insert_ _ -> Just ()+          _ -> Nothing+      , withRecord @Person $ \case+          Insert_ _ -> Just ()+          _ -> Nothing+      ]

@@ -1,6 +1,9 @@+{- AUTOCOLLECT.TEST -} {-# LANGUAGE CPP #-} -module SqlQueryRepTest where+module SqlQueryRepTest (+  -- $AUTOCOLLECT.TEST.export$+) where  import qualified Data.ByteString.Lazy.Char8 as Char8 import Test.Tasty@@ -8,32 +11,21 @@  import Generated -{-# ANN module "HLint: ignore" #-}- persistentVersionDir :: FilePath-#if MIN_VERSION_persistent(2,14,0)-persistentVersionDir = error "Running tests against persistent > 2.13 is not supported"+#if MIN_VERSION_persistent(2,15,0)+persistentVersionDir = error "Running tests against persistent > 2.14 is not supported"+#elif MIN_VERSION_persistent(2,14,0)+persistentVersionDir = "persistent-2.14/" #elif MIN_VERSION_persistent(2,13,0) persistentVersionDir = "persistent-2.13/"-#elif MIN_VERSION_persistent(2,12,0)-persistentVersionDir = "persistent-2.12/"-#elif MIN_VERSION_persistent(2,11,0)-persistentVersionDir = "persistent-2.11/"-#elif MIN_VERSION_persistent(2,10,0)-persistentVersionDir = "persistent-2.10/"-#elif MIN_VERSION_persistent(2,9,0)-persistentVersionDir = "persistent-2.9/"-#elif MIN_VERSION_persistent(2,8,0)-persistentVersionDir = "persistent-2.8/" #else-persistentVersionDir = error "Running tests against persistent < 2.8 is not supported"+persistentVersionDir = error "Running tests against persistent < 2.13 is not supported" #endif -tests :: TestTree-tests = testGroup "SqlQueryRep tests"-  [ golden "Show representation" (persistentVersionDir ++ "sqlqueryrep_show_representation.golden") $-      pure $ unlines allSqlQueryRepShowRepresentations-  ]+test =+  golden "Show representation" (persistentVersionDir ++ "sqlqueryrep_show_representation.golden") $+    pure $+      unlines allSqlQueryRepShowRepresentations  golden :: String -> FilePath -> IO String -> TestTree golden name fp action = goldenVsStringDiff name diffCmd ("test/goldens/" ++ fp) $ Char8.pack <$> action

@@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module TestUtils.DB-  ( BackendType(..)-  , allBackendTypes-  , withTestDB-  ) where+module TestUtils.DB (+  BackendType (..),+  allBackendTypes,+  withTestDB,+) where  import Control.Monad.Logger (runNoLoggingT) import qualified Data.ByteString.Char8 as Char8

@@ -1,17 +1,11 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -module TestUtils.Esqueleto-  ( esqueletoSelect-  ) where+module TestUtils.Esqueleto (+  esqueletoSelect,+) where -#if MIN_VERSION_esqueleto(3,5,0) import qualified Database.Esqueleto.Experimental as E import qualified Database.Esqueleto.Internal.Internal as E-#else-import qualified Database.Esqueleto as E-import qualified Database.Esqueleto.Internal.Sql as E-#endif  import Database.Persist.Monad (MonadSqlQuery, unsafeLiftSql) 

@@ -1,66 +0,0 @@-Get{..}<Person>-GetMany{..}<Person>-GetJust{..}<Person>-GetJustEntity{..}<Person>-GetEntity{..}<Person>-BelongsTo{..}<(Person,Post)>-BelongsToJust{..}<(Person,Post)>-Insert{..}<Person>-Insert_{..}<Person>-InsertMany{..}<Person>-InsertMany_{..}<Person>-InsertEntityMany{..}<Person>-InsertKey{..}<Person>-Repsert{..}<Person>-RepsertMany{..}<Person>-Replace{..}<Person>-Delete{..}<Person>-Update{..}<Person>-UpdateGet{..}<Person>-InsertEntity{..}<Person>-InsertRecord{..}<Person>-GetBy{..}<Person>-GetByValue{..}<Person>-CheckUnique{..}<Person>-DeleteBy{..}<Person>-InsertUnique{..}<Person>-Upsert{..}<Person>-UpsertBy{..}<Person>-PutMany{..}<Person>-InsertBy{..}<Person>-InsertUniqueEntity{..}<Person>-ReplaceUnique{..}<Person>-OnlyUnique{..}<Person>-SelectSourceRes{..}<Person>-SelectFirst{..}<Person>-SelectKeysRes{..}<Person>-Count{..}<Person>-SelectList{..}<Person>-SelectKeysList{..}<Person>-UpdateWhere{..}<Person>-DeleteWhere{..}<Person>-DeleteWhereCount{..}<Person>-UpdateWhereCount{..}<Person>-DeleteCascade{..}<Person>-DeleteCascadeWhere{..}<Person>-ParseMigration{..}-ParseMigration'{..}-PrintMigration{..}-ShowMigration{..}-GetMigration{..}-RunMigration{..}-RunMigrationQuiet{..}-RunMigrationSilent{..}-RunMigrationUnsafe{..}-RunMigrationUnsafeQuiet{..}-GetFieldName{..}<Person>-GetTableName{..}<Person>-WithRawQuery{..}-RawQueryRes{..}-RawExecute{..}-RawExecuteCount{..}-RawSql{..}-TransactionSave{..}-TransactionSaveWithIsolation{..}-TransactionUndo{..}-TransactionUndoWithIsolation{..}

@@ -1,68 +0,0 @@-Get{..}<Person>-GetMany{..}<Person>-GetJust{..}<Person>-GetJustEntity{..}<Person>-GetEntity{..}<Person>-BelongsTo{..}<(Person,Post)>-BelongsToJust{..}<(Person,Post)>-Insert{..}<Person>-Insert_{..}<Person>-InsertMany{..}<Person>-InsertMany_{..}<Person>-InsertEntityMany{..}<Person>-InsertKey{..}<Person>-Repsert{..}<Person>-RepsertMany{..}<Person>-Replace{..}<Person>-Delete{..}<Person>-Update{..}<Person>-UpdateGet{..}<Person>-InsertEntity{..}<Person>-InsertRecord{..}<Person>-GetBy{..}<Person>-GetByValue{..}<Person>-CheckUnique{..}<Person>-CheckUniqueUpdateable{..}<Person>-DeleteBy{..}<Person>-InsertUnique{..}<Person>-Upsert{..}<Person>-UpsertBy{..}<Person>-PutMany{..}<Person>-InsertBy{..}<Person>-InsertUniqueEntity{..}<Person>-ReplaceUnique{..}<Person>-OnlyUnique{..}<Person>-SelectSourceRes{..}<Person>-SelectFirst{..}<Person>-SelectKeysRes{..}<Person>-Count{..}<Person>-Exists{..}<Person>-SelectList{..}<Person>-SelectKeysList{..}<Person>-UpdateWhere{..}<Person>-DeleteWhere{..}<Person>-DeleteWhereCount{..}<Person>-UpdateWhereCount{..}<Person>-DeleteCascade{..}<Person>-DeleteCascadeWhere{..}<Person>-ParseMigration{..}-ParseMigration'{..}-PrintMigration{..}-ShowMigration{..}-GetMigration{..}-RunMigration{..}-RunMigrationQuiet{..}-RunMigrationSilent{..}-RunMigrationUnsafe{..}-RunMigrationUnsafeQuiet{..}-GetFieldName{..}<Person>-GetTableName{..}<Person>-WithRawQuery{..}-RawQueryRes{..}-RawExecute{..}-RawExecuteCount{..}-RawSql{..}-TransactionSave{..}-TransactionSaveWithIsolation{..}-TransactionUndo{..}-TransactionUndoWithIsolation{..}

@@ -1,68 +0,0 @@-Get{..}<Person>-GetMany{..}<Person>-GetJust{..}<Person>-GetJustEntity{..}<Person>-GetEntity{..}<Person>-BelongsTo{..}<(Person,Post)>-BelongsToJust{..}<(Person,Post)>-Insert{..}<Person>-Insert_{..}<Person>-InsertMany{..}<Person>-InsertMany_{..}<Person>-InsertEntityMany{..}<Person>-InsertKey{..}<Person>-Repsert{..}<Person>-RepsertMany{..}<Person>-Replace{..}<Person>-Delete{..}<Person>-Update{..}<Person>-UpdateGet{..}<Person>-InsertEntity{..}<Person>-InsertRecord{..}<Person>-GetBy{..}<Person>-GetByValue{..}<Person>-CheckUnique{..}<Person>-CheckUniqueUpdateable{..}<Person>-DeleteBy{..}<Person>-InsertUnique{..}<Person>-Upsert{..}<Person>-UpsertBy{..}<Person>-PutMany{..}<Person>-InsertBy{..}<Person>-InsertUniqueEntity{..}<Person>-ReplaceUnique{..}<Person>-OnlyUnique{..}<Person>-SelectSourceRes{..}<Person>-SelectFirst{..}<Person>-SelectKeysRes{..}<Person>-Count{..}<Person>-Exists{..}<Person>-SelectList{..}<Person>-SelectKeysList{..}<Person>-UpdateWhere{..}<Person>-DeleteWhere{..}<Person>-DeleteWhereCount{..}<Person>-UpdateWhereCount{..}<Person>-DeleteCascade{..}<Person>-DeleteCascadeWhere{..}<Person>-ParseMigration{..}-ParseMigration'{..}-PrintMigration{..}-ShowMigration{..}-GetMigration{..}-RunMigration{..}-RunMigrationQuiet{..}-RunMigrationSilent{..}-RunMigrationUnsafe{..}-RunMigrationUnsafeQuiet{..}-GetFieldName{..}<Person>-GetTableName{..}<Person>-WithRawQuery{..}-RawQueryRes{..}-RawExecute{..}-RawExecuteCount{..}-RawSql{..}-TransactionSave{..}-TransactionSaveWithIsolation{..}-TransactionUndo{..}-TransactionUndoWithIsolation{..}

@@ -0,0 +1,66 @@+Get{..}<Person>+GetMany{..}<Person>+GetJust{..}<Person>+GetJustEntity{..}<Person>+GetEntity{..}<Person>+BelongsTo{..}<(Person,Post)>+BelongsToJust{..}<(Person,Post)>+Insert{..}<Person>+Insert_{..}<Person>+InsertMany{..}<Person>+InsertMany_{..}<Person>+InsertEntityMany{..}<Person>+InsertKey{..}<Person>+Repsert{..}<Person>+RepsertMany{..}<Person>+Replace{..}<Person>+Delete{..}<Person>+Update{..}<Person>+UpdateGet{..}<Person>+InsertEntity{..}<Person>+InsertRecord{..}<Person>+GetBy{..}<Person>+GetByValue{..}<Person>+CheckUnique{..}<Person>+CheckUniqueUpdateable{..}<Person>+DeleteBy{..}<Person>+InsertUnique{..}<Person>+Upsert{..}<Person>+UpsertBy{..}<Person>+PutMany{..}<Person>+InsertBy{..}<Person>+InsertUniqueEntity{..}<Person>+ReplaceUnique{..}<Person>+OnlyUnique{..}<Person>+SelectSourceRes{..}<Person>+SelectFirst{..}<Person>+SelectKeysRes{..}<Person>+Count{..}<Person>+Exists{..}<Person>+SelectList{..}<Person>+SelectKeysList{..}<Person>+UpdateWhere{..}<Person>+DeleteWhere{..}<Person>+DeleteWhereCount{..}<Person>+UpdateWhereCount{..}<Person>+ParseMigration{..}+ParseMigration'{..}+PrintMigration{..}+ShowMigration{..}+GetMigration{..}+RunMigration{..}+RunMigrationQuiet{..}+RunMigrationSilent{..}+RunMigrationUnsafe{..}+RunMigrationUnsafeQuiet{..}+GetFieldName{..}<Person>+GetTableName{..}<Person>+WithRawQuery{..}+RawQueryRes{..}+RawExecute{..}+RawExecuteCount{..}+RawSql{..}+TransactionSave{..}+TransactionSaveWithIsolation{..}+TransactionUndo{..}+TransactionUndoWithIsolation{..}

@@ -1,62 +0,0 @@-Get{..}<Person>-GetMany{..}<Person>-GetJust{..}<Person>-GetJustEntity{..}<Person>-GetEntity{..}<Person>-BelongsTo{..}<(Person,Post)>-BelongsToJust{..}<(Person,Post)>-Insert{..}<Person>-Insert_{..}<Person>-InsertMany{..}<Person>-InsertMany_{..}<Person>-InsertEntityMany{..}<Person>-InsertKey{..}<Person>-Repsert{..}<Person>-RepsertMany{..}<Person>-Replace{..}<Person>-Delete{..}<Person>-Update{..}<Person>-UpdateGet{..}<Person>-InsertEntity{..}<Person>-InsertRecord{..}<Person>-GetBy{..}<Person>-GetByValue{..}<Person>-CheckUnique{..}<Person>-DeleteBy{..}<Person>-InsertUnique{..}<Person>-Upsert{..}<Person>-UpsertBy{..}<Person>-PutMany{..}<Person>-InsertBy{..}<Person>-InsertUniqueEntity{..}<Person>-ReplaceUnique{..}<Person>-OnlyUnique{..}<Person>-SelectSourceRes{..}<Person>-SelectFirst{..}<Person>-SelectKeysRes{..}<Person>-Count{..}<Person>-SelectList{..}<Person>-SelectKeysList{..}<Person>-UpdateWhere{..}<Person>-DeleteWhere{..}<Person>-DeleteWhereCount{..}<Person>-UpdateWhereCount{..}<Person>-DeleteCascade{..}<Person>-DeleteCascadeWhere{..}<Person>-ParseMigration{..}-ParseMigration'{..}-PrintMigration{..}-ShowMigration{..}-GetMigration{..}-RunMigration{..}-RunMigrationSilent{..}-RunMigrationUnsafe{..}-GetFieldName{..}<Person>-GetTableName{..}<Person>-WithRawQuery{..}-RawQueryRes{..}-RawExecute{..}-RawExecuteCount{..}-RawSql{..}-TransactionSave{..}-TransactionUndo{..}

@@ -1,64 +0,0 @@-Get{..}<Person>-GetMany{..}<Person>-GetJust{..}<Person>-GetJustEntity{..}<Person>-GetEntity{..}<Person>-BelongsTo{..}<(Person,Post)>-BelongsToJust{..}<(Person,Post)>-Insert{..}<Person>-Insert_{..}<Person>-InsertMany{..}<Person>-InsertMany_{..}<Person>-InsertEntityMany{..}<Person>-InsertKey{..}<Person>-Repsert{..}<Person>-RepsertMany{..}<Person>-Replace{..}<Person>-Delete{..}<Person>-Update{..}<Person>-UpdateGet{..}<Person>-InsertEntity{..}<Person>-InsertRecord{..}<Person>-GetBy{..}<Person>-GetByValue{..}<Person>-CheckUnique{..}<Person>-DeleteBy{..}<Person>-InsertUnique{..}<Person>-Upsert{..}<Person>-UpsertBy{..}<Person>-PutMany{..}<Person>-InsertBy{..}<Person>-InsertUniqueEntity{..}<Person>-ReplaceUnique{..}<Person>-OnlyUnique{..}<Person>-SelectSourceRes{..}<Person>-SelectFirst{..}<Person>-SelectKeysRes{..}<Person>-Count{..}<Person>-SelectList{..}<Person>-SelectKeysList{..}<Person>-UpdateWhere{..}<Person>-DeleteWhere{..}<Person>-DeleteWhereCount{..}<Person>-UpdateWhereCount{..}<Person>-DeleteCascade{..}<Person>-DeleteCascadeWhere{..}<Person>-ParseMigration{..}-ParseMigration'{..}-PrintMigration{..}-ShowMigration{..}-GetMigration{..}-RunMigration{..}-RunMigrationSilent{..}-RunMigrationUnsafe{..}-GetFieldName{..}<Person>-GetTableName{..}<Person>-WithRawQuery{..}-RawQueryRes{..}-RawExecute{..}-RawExecuteCount{..}-RawSql{..}-TransactionSave{..}-TransactionSaveWithIsolation{..}-TransactionUndo{..}-TransactionUndoWithIsolation{..}