persistent-mtl (empty) → 0.1.0.0

raw patch · 21 files changed

+3965/−0 lines, 21 filesdep +basedep +bytestringdep +conduit

Dependencies added: base, bytestring, conduit, containers, monad-logger, mtl, persistent, persistent-mtl, persistent-sqlite, persistent-template, resource-pool, resourcet, resourcet-pool, tasty, tasty-golden, tasty-hunit, text, transformers, unliftio, unliftio-core

Files

• CHANGELOG.md +6/−0
• LICENSE +11/−0
• README.md +281/−0
• persistent-mtl.cabal +90/−0
• src/Database/Persist/Monad.hs +117/−0
• src/Database/Persist/Monad/Class.hs +82/−0
• src/Database/Persist/Monad/Shim.hs +521/−0
• src/Database/Persist/Monad/SqlQueryRep.hs +652/−0
• src/Database/Persist/Monad/TestUtils.hs +235/−0
• test/Example.hs +141/−0
• test/Generated.hs +124/−0
• test/Integration.hs +761/−0
• test/Main.hs +17/−0
• test/MockSqlQueryT.hs +39/−0
• test/Mocked.hs +546/−0
• test/SqlQueryRepTest.hs +35/−0
• test/TestUtils/Match.hs +47/−0
• test/goldens/persistent-2.10/sqlqueryrep_show_representation.golden +66/−0
• test/goldens/persistent-2.11/sqlqueryrep_show_representation.golden +68/−0
• test/goldens/persistent-2.8/sqlqueryrep_show_representation.golden +62/−0
• test/goldens/persistent-2.9/sqlqueryrep_show_representation.golden +64/−0

@@ -0,0 +1,6 @@+# 0.1.0.0++Initial release+* `SqlQueryT` + `MonadSqlQuery`+* Autogenerated persistent API+* `MockQueryT`

@@ -0,0 +1,11 @@+Copyright 2020 Brandon Chinn++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,281 @@+# `persistent-mtl`++[![CircleCI](https://img.shields.io/circleci/build/github/brandonchinn178/persistent-mtl)](https://app.circleci.com/pipelines/github/brandonchinn178/persistent-mtl)+[![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)++Use the `persistent` API in your monad transformer stack, seamlessly interleaving business logic with database operations by simply dropping `SqlQueryT` into your stack.++Features:+* Easy integration into a monad transformer stack+* Monad type class to generalize functions that use database operations+* Simple transaction control+* Supports mocking database operations in tests++## Quickstart++```hs+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Logger (runStderrLoggingT)+import Database.Persist.Sql (Entity(..), toSqlKey, (<.))+import Database.Persist.Monad+import Database.Persist.Sqlite (withSqliteConn)+import Database.Persist.TH+import UnliftIO (MonadUnliftIO(..), wrappedWithRunInIO)++import Database.Persist.Monad.TestUtils (runMockSqlQueryT, withRecord)+import Test.Tasty.HUnit (Assertion, (@?=))++share [mkPersist sqlSettings, mkMigrate "migrate"] [persistLowerCase|+Person+  name String+  age Int+  deriving Show Eq+|]++newtype MyApp a = MyApp+  { unMyApp :: SqlQueryT IO a+  }+  deriving (Functor, Applicative, Monad, MonadIO, MonadSqlQuery)++instance MonadUnliftIO MyApp where+  withRunInIO = wrappedWithRunInIO MyApp unMyApp++getYoungPeople :: (MonadIO m, MonadSqlQuery m) => m [Entity Person]+getYoungPeople = selectList [PersonAge <. 18] []++main :: IO ()+main = runStderrLoggingT $ withSqliteConn ":memory:" $ \conn ->+  liftIO $ runSqlQueryT (BackendSingle conn) $ unMyApp $ do+    runMigration migrate+    insert_ $ Person "Alice" 25+    insert_ $ Person "Bob" 10+    youngsters <- getYoungPeople+    liftIO $ print youngsters++-- unit test with mocks!+unit_my_function :: Assertion+unit_my_function = do+  let person1 = Entity (toSqlKey 1) (Person "Child1" 10)++  result <- runMockSqlQueryT getYoungPeople+    [ withRecord @Person $ \case+        SelectList _ _ -> Just [person1]+        _ -> Nothing+    ]++  result @?= [person1]+```++## What's wrong with just using `persistent`?++### Using `persistent` in production code++`persistent` runs all of its functions in `SqlPersistT`, which is an alias for `ReaderT SqlBackend`. Since all functions run in this concrete monad and not a generalized type class, it becomes difficult to integrate database operations into your monad transformer stack. Below are some examples of trying to integrate `persistent` functions into a monad transformer application, and the drawbacks of each option.++#### Option 1: Add `SqlPersistT` to your monad transformer stack++One might look at the `SqlPersistT` type and think it's a monad transformer, and add it to their monad transformer stack. But since `persistent` functions run in the concrete `SqlPersistT` monad (and not with a type class), you'll need some way of lifting `SqlPersistT` into your application monad.++Before going further, I do want to point out that `SqlBackend` represents a single database connection, so adding `SqlPersistT` to your monad transformer stack would run your entire application in a single connection (read: single transaction)! So for most applications, this option probably won't work for you, but let's assume you have a use-case where this isn't an issue.++Option 1a is to write `liftSqlPersist` specifically for your application monad:++```hs+newtype MyApp a = MyApp (ReaderT MyAppConfig (SqlPersistT (LoggingT IO)) a)++-- Notice the duplication here: anything inside `SqlPersistT` in your stack+-- needs to go in here.+liftSqlPersist :: SqlPersistT (LoggingT IO) a -> MyApp a+liftSqlPersist = MyApp . lift+```++But then any function that runs database connections is taken out of mtl-style add needs to be concretely typed to `MyApp`++```hs+-- you originally had a nice mtl-style function with a generalized monad+foo :: MonadReader MyAppConfig m => m ()+foo = do+  config <- ask+  _ <- bar config+  return ()++-- but adding a database operation forces us to remove the generalization+foo :: MyApp ()+foo = do+  config <- ask+  _ <- bar config+  _ <- liftSqlPersist $ get $ configUserId config+  return ()+```++So then you might try option 1b and write a type class that will lift `SqlPersistT`:++```hs+class MonadLiftSqlPersist m where+  -- Remember how we had to duplicate anything inside `SqlPersistT` in your+  -- stack? The stack within `SqlPersistT` can be different between monads, so+  -- you need to define the inner type for each monad+  type Inner m :: Type -> Type++  liftSqlPersist :: SqlPersistT (Inner m) a -> m a++instance MonadLiftSqlPersist MyApp where+  type Inner MyApp = LoggingT IO+  liftSqlPersist = MyApp . lift+```++which still has the unfortunate problem of copy-pasting whatever is inside `SqlPersistT` into the `Inner` type family instance.++But the main problem with both of these options is that `liftSqlPersist` will only contain the context you put inside `SqlPersistT`, meaning that within a `liftSqlPersist` action, you can't get access to `MyAppConfig`! Of course, you could always make `SqlPersistT` the very first monad transformer in your stack, but that might not work in another situation. Plus, you'd have even more monad transformers to copy into the type of `liftSqlPersist`.++#### Option 2: Manually run `runSqlPool` every time you run a `persistent` function++Here, you might store the `Pool SqlBackend` in your monad transformer stack and then use `runSqlPool` to immediately unwrap `SqlPersistT`.++```hs+data MyAppConfig = MyAppConfig+  { backendPool :: Pool SqlBackend+  , ...+  }++runQuery :: MonadReader MyAppConfig m => SqlPersistT m a -> m a+runQuery m = do+  MyAppConfig{backendPool} <- ask+  runSqlPool m backendPool++foo :: MonadReader MyAppConfig m => m ()+foo = do+  config <- ask+  _ <- bar config+  _ <- runQuery $ get $ configUserId config+  return ()+```++Great! Let me first say that this is *not a bad solution*. You could even make your own type class like `MonadHasBackendPool` to abstract away monads that contain a `Pool SqlBackend`, not necessarily the whole `MyAppConfig`.++There are two drawbacks with this approach, one minor drawback and one major drawback. The minor drawback is that you have to put the `Pool SqlBackend` into your environment yourself. It would be great if there could be a monad transformer and type class already made for you to easily plug it in. It's not that much code, so this isn't a big deal, but if you're quickly bootstrapping a new project with persistent, it'd be nice to reach for something already built.++The major drawback with this approach is transactions and composability. `runSqlPool` (and `runQuery` in this example) runs its action within a single transaction. Say you have two functions that run separate, composable actions that interleave business logic and database operations:++```hs+foo :: MonadReader MyAppConfig m => m ()+foo = do+  -- business logic+  runQuery $ insert_ $ ...+  -- more business logic++bar :: MonadReader MyAppConfig m => m ()+bar = do+  -- business logic+  runQuery $ insert_ $ ...+  -- more business logic+```++There is no way to compose `foo` and `bar` so that it all runs within a single database transaction. You could try++```hs+fooAndBar :: MonadReader MyAppConfig m => m ()+fooAndBar = runQuery $ do+  lift foo+  -- something else+  lift bar+```++but `foo` and `bar` each run their own `runQuery` function, so actually, `fooAndBar` uses three connections (i.e. three transactions): one connection from `runQuery` in `fooAndBar` and one connection each from `foo` and `bar`.++#### Option 3: `persistent-mtl`++So what does `persistent-mtl` do differently?++1. It stores the entire `Pool SqlBackend` in `SqlQueryT`, which means you *can* add `SqlQueryT` to your monad transformer stack. Remember that the problem with adding `SqlPersistT` to your monad transformer stack is that your entire application would run with a single database connection, aka a single database transaction.+1. It provides a `MonadSqlQuery` type class out of the box and all of `persistent`'s functions lifted to use `MonadSqlQuery`+1. It provides a `withTransaction` function that runs the given action within a single transaction. For example,++    ```hs+    foo :: MonadSqlQuery m => m ()+    foo = do+      -- business logic+      insert_ $ ...+      -- more business logic++    bar :: MonadSqlQuery m => m ()+    bar = do+      -- business logic+      insert_ $ ...+      -- more business logic++    fooAndBar :: MonadSqlQuery m => m ()+    fooAndBar = withTransaction $ do+      foo+      -- something else+      bar+    ```++    `fooAndBar` will run both `foo` and `bar` in the same transaction. Note that `foo` and `bar` themselves don't say anything about transactions. By default, using a `persistent` function without `withTransaction` will run each query in its own transaction. And if `foo` did use `withTransaction`, it would start a transaction within a transaction (if the SQL backend supports it). Now, `foo` and `bar` are composable!++In summary, `persistent-mtl` takes all the good things about option 2, implements them out of the box (so you don't have to do it yourself), and makes your business logic functions composable with transactions behaving the way YOU want.++### Testing functions that use `persistent` operations++Generally, I would recommend someone using `persistent` in their application to make a monad type class containing the API for their domain, like++```hs+class MonadAppService m where+  getYoungPeople :: m [Entity Person]++instance MonadAppService MyApp where+  getYoungPeople = selectList [PersonAge <. 18] []+```++so that writing unit tests would mock out domain-level abstractions. I generally wouldn't recommend mocking out the entire database state; if you're testing complex database queries, you should just write integration tests and check that the queries do what you expect on an actual database.++But maybe you have a small function that uses `selectList` and it's not worth making a whole type class to wrap that call. With `persistent`, `selectList` runs a `SqlPersistT` action, which is completely un-introspectable. Sure, you could pass in a `SqlBackend` that intercepts all queries, but you'd be mocking extremely low level behavior — your mock would need to know the exact `SELECT` query `selectList` sends.++`persistent-mtl`, on the other hand, provides `MockSqlQueryT` which you can use to execute your `MonadSqlQuery` functions with a list of mocks, where a mock intercepts `SqlQueryRep`, a data representation of each `persistent` function, and returns the result. For example, to mock `selectList`, you'd simply do++```hs+runMockSqlQueryT getYoungPeople+  [ withRecord @Person $ \case+      SelectList _ _ -> Just mockedPersonList+      _ -> Nothing+  ]+```++and `MockSqlQueryT` would intercept a `selectList` call for a `Person` record and return your mocked result. Each `persistent` function has a corresponding data type constructor (with a few exceptions, such as `selectSource`, which works differently).++If your function does some complex raw SQL queries, you can intercept those like this:++```hs+crazyFunction :: MonadSqlQuery m => String -> m [Int]+crazyFunction postTitle = rawSql+  "SELECT age FROM person INNER JOIN post ON person.id = post.author WHERE post.title = ?"+  [toPersistValue postTitle]++let mockRawSql = mockQuery $ \case+      RawSql _ [toPersistValue "foo"] -> Just [1]+      RawSql _ [toPersistValue "bar"] -> Just [2]+      _ -> Nothing++-- returns [1]+runMockSqlQueryT (crazyFunction "foo") [mockRawSql]++-- returns [2]+runMockSqlQueryT (crazyFunction "bar") [mockRawSql]++-- error: Could not find mock for query+runMockSqlQueryT (crazyFunction "baz") [mockRawSql]+```

@@ -0,0 +1,90 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b4cebf2dfec7ddb84809e77bf7c91ea81fd89f22a13763b7ee032b13313dfebd++name:           persistent-mtl+version:        0.1.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.+category:       Database+homepage:       https://github.com/brandonchinn178/persistent-mtl#readme+bug-reports:    https://github.com/brandonchinn178/persistent-mtl/issues+maintainer:     Brandon Chinn <brandonchinn178@gmail.com>+license:        BSD3+license-file:   LICENSE+build-type:     Simple+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.8/sqlqueryrep_show_representation.golden+    test/goldens/persistent-2.9/sqlqueryrep_show_representation.golden++source-repository head+  type: git+  location: https://github.com/brandonchinn178/persistent-mtl++library+  exposed-modules:+      Database.Persist.Monad+      Database.Persist.Monad.Class+      Database.Persist.Monad.Shim+      Database.Persist.Monad.SqlQueryRep+      Database.Persist.Monad.TestUtils+  other-modules:+      Paths_persistent_mtl+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.10 && <5+    , conduit >=1.3.0.3 && <2+    , containers >=0.5.10.2 && <0.7+    , mtl >=2.2.2 && <3+    , persistent >=2.8.2 && <3+    , resource-pool >=0.2.3.2 && <0.3+    , resourcet >=1.2.1 && <2+    , resourcet-pool >=0.1.0.0 && <0.2+    , text >=1.2.3.0 && <2+    , transformers >=0.5.2.0 && <0.6+    , unliftio-core >=0.1.2.0 && <0.3+  default-language: Haskell2010++test-suite persistent-mtl-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Example+      Generated+      Integration+      Mocked+      MockSqlQueryT+      SqlQueryRepTest+      TestUtils.Match+      Paths_persistent_mtl+  hs-source-dirs:+      test+  ghc-options: -Wall+  build-depends:+      base+    , bytestring+    , conduit+    , containers+    , monad-logger+    , persistent+    , persistent-mtl+    , persistent-sqlite+    , persistent-template+    , resourcet+    , tasty+    , tasty-golden+    , tasty-hunit+    , text+    , unliftio+  default-language: Haskell2010

@@ -0,0 +1,117 @@+{-|+Module: Database.Persist.Monad++Defines the 'SqlQueryT' monad transformer that has a 'MonadSqlQuery' instance+to execute @persistent@ database operations.++Usage:++@+myFunction :: (MonadSqlQuery m, MonadIO m) => m ()+myFunction = do+  insert_ $ Person { name = \"Alice\", age = Just 25 }+  insert_ $ Person { name = \"Bob\", age = Nothing }++  -- some other business logic++  personList <- selectList [] []+  liftIO $ print (personList :: [Person])++  -- everything in here will run in a transaction+  withTransaction $+    selectFirst [PersonAge >. 30] [] >>= \\case+      Nothing -> insert_ $ Person { name = \"Claire\", age = Just 50 }+      Just (Entity key person) -> replace key person{ age = Just (age person - 10) }++  -- some more business logic++  return ()+@+-}++{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Database.Persist.Monad+  (+  -- * Type class for executing database queries+    MonadSqlQuery+  , withTransaction+  , SqlQueryRep(..)++  -- * SqlQueryT monad transformer+  , SqlQueryT+  , runSqlQueryT++  -- * Lifted functions+  , module Database.Persist.Monad.Shim+  ) where++import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.IO.Unlift (MonadUnliftIO(..), wrappedWithRunInIO)+import Control.Monad.Reader (ReaderT, ask, local, runReaderT)+import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.Trans.Resource (MonadResource)+import Data.Acquire (withAcquire)+import Data.Pool (Pool)+import Data.Pool.Acquire (poolToAcquire)+import Database.Persist.Sql (SqlBackend, runSqlConn)++import Database.Persist.Monad.Class+import Database.Persist.Monad.Shim+import Database.Persist.Monad.SqlQueryRep++{- SqlQueryT monad -}++data SqlQueryEnv = SqlQueryEnv+  { backendPool :: Pool SqlBackend+  , currentConn :: Maybe SqlBackend+  }++-- | The monad transformer that implements 'MonadSqlQuery'.+newtype SqlQueryT m a = SqlQueryT+  { unSqlQueryT :: ReaderT SqlQueryEnv m a+  } deriving+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadTrans+    , MonadResource+    )++instance MonadUnliftIO m => MonadSqlQuery (SqlQueryT m) where+  runQueryRep queryRep = do+    SqlQueryEnv{currentConn} <- SqlQueryT ask+    case currentConn of+      Just conn -> runWithConn conn+      Nothing -> withTransactionConn runWithConn+    where+      runWithConn = runReaderT (runSqlQueryRep queryRep)++  withTransaction action = withTransactionConn $ \_ -> action++instance MonadUnliftIO m => MonadUnliftIO (SqlQueryT m) where+  withRunInIO = wrappedWithRunInIO SqlQueryT unSqlQueryT++{- Running SqlQueryT -}++-- | Run the 'SqlQueryT' monad transformer with the given backend.+runSqlQueryT :: Pool SqlBackend -> SqlQueryT m a -> m a+runSqlQueryT backendPool = (`runReaderT` env) . unSqlQueryT+  where+    env = SqlQueryEnv { currentConn = Nothing, .. }++-- | Start a new transaction and get the connection.+withTransactionConn :: MonadUnliftIO m => (SqlBackend -> SqlQueryT m a) -> SqlQueryT m a+withTransactionConn f = do+  SqlQueryEnv{backendPool} <- SqlQueryT ask+  withAcquire (poolToAcquire backendPool) $ \conn ->+    SqlQueryT . local (setCurrentConn conn) . unSqlQueryT $+      runSqlConn (lift $ f conn) conn+  where+    setCurrentConn conn env = env { currentConn = Just conn }

@@ -0,0 +1,82 @@+{-|+Module: Database.Persist.Monad.Class++Defines the 'MonadSqlQuery' type class that a monad can make an instance of+in order to interpret how to run a+'Database.Persist.Monad.SqlQueryRep.SqlQueryRep' sent by a lifted function from+@Database.Persist.Monad.Shim@.+-}++module Database.Persist.Monad.Class+  ( MonadSqlQuery(..)+  ) 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.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+import Data.Typeable (Typeable)++import Database.Persist.Monad.SqlQueryRep (SqlQueryRep)++-- | The type-class for monads that can run persistent database queries.+class Monad m => MonadSqlQuery m where+  -- | The main function that interprets a SQL query operation and runs it+  -- in the monadic context.+  runQueryRep :: Typeable record => SqlQueryRep record a -> m a++  -- | Run all queries in the given action using the same database connection.+  --+  -- You should make sure to not fork any threads within this action. This+  -- will almost certainly cause problems.+  -- https://github.com/brandonchinn178/persistent-mtl/issues/7+  withTransaction :: m a -> m a++{- Instances for common monad transformers -}++instance MonadSqlQuery m => MonadSqlQuery (Reader.ReaderT r m) where+  runQueryRep = lift . runQueryRep+  withTransaction = Reader.mapReaderT withTransaction++instance MonadSqlQuery m => MonadSqlQuery (Except.ExceptT e m) where+  runQueryRep = lift . runQueryRep+  withTransaction = Except.mapExceptT withTransaction++instance MonadSqlQuery m => MonadSqlQuery (Identity.IdentityT m) where+  runQueryRep = lift . runQueryRep+  withTransaction = Identity.mapIdentityT withTransaction++instance MonadSqlQuery m => MonadSqlQuery (Maybe.MaybeT m) where+  runQueryRep = lift . runQueryRep+  withTransaction = Maybe.mapMaybeT withTransaction++instance (Monoid w, MonadSqlQuery m) => MonadSqlQuery (RWS.Lazy.RWST r w s m) where+  runQueryRep = lift . runQueryRep+  withTransaction = RWS.Lazy.mapRWST withTransaction++instance (Monoid w, MonadSqlQuery m) => MonadSqlQuery (RWS.Strict.RWST r w s m) where+  runQueryRep = lift . runQueryRep+  withTransaction = RWS.Strict.mapRWST withTransaction++instance MonadSqlQuery m => MonadSqlQuery (State.Lazy.StateT s m) where+  runQueryRep = lift . runQueryRep+  withTransaction = State.Lazy.mapStateT withTransaction++instance MonadSqlQuery m => MonadSqlQuery (State.Strict.StateT s m) where+  runQueryRep = lift . runQueryRep+  withTransaction = State.Strict.mapStateT withTransaction++instance (Monoid w, MonadSqlQuery m) => MonadSqlQuery (Writer.Lazy.WriterT w m) where+  runQueryRep = lift . runQueryRep+  withTransaction = Writer.Lazy.mapWriterT withTransaction++instance (Monoid w, MonadSqlQuery m) => MonadSqlQuery (Writer.Strict.WriterT w m) where+  runQueryRep = lift . runQueryRep+  withTransaction = Writer.Strict.mapWriterT withTransaction

@@ -0,0 +1,521 @@+{-|+Module: Database.Persist.Monad.Shim++Defines all the @persistent@ functions lifted into 'MonadSqlQuery'.++This file is autogenerated, to keep it in sync with+@Database.Persist.Monad.SqlQueryRep@.+-}++{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PatternSynonyms #-}++module Database.Persist.Monad.Shim where++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Resource (MonadResource)+import Data.Acquire (Acquire, allocateAcquire)+import Data.Conduit (ConduitM)+import Data.Int (Int64)+import Data.Map (Map)+import Data.Text (Text)+import Data.Typeable (Typeable)+import Data.Void (Void)+import Database.Persist.Sql hiding (pattern Update)+import GHC.Stack (HasCallStack)++import Database.Persist.Monad.Class (MonadSqlQuery(..))+import Database.Persist.Monad.SqlQueryRep (SqlQueryRep(..))++{-# ANN module "HLint: ignore" #-}++-- | The lifted version of 'Database.Persist.Sql.get'+get+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> m (Maybe record)+get a1 = runQueryRep $ Get a1++-- | The lifted version of 'Database.Persist.Sql.getMany'+getMany+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Key record] -> m (Map (Key record) record)+getMany a1 = runQueryRep $ GetMany a1++-- | The lifted version of 'Database.Persist.Sql.getJust'+getJust+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> m record+getJust a1 = runQueryRep $ GetJust a1++-- | The lifted version of 'Database.Persist.Sql.getJustEntity'+getJustEntity+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> m (Entity record)+getJustEntity a1 = runQueryRep $ GetJustEntity a1++-- | The lifted version of 'Database.Persist.Sql.getEntity'+getEntity+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> m (Maybe (Entity record))+getEntity a1 = runQueryRep $ GetEntity a1++-- | The lifted version of 'Database.Persist.Sql.belongsTo'+belongsTo+  :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend, Typeable record1, Typeable record2, MonadSqlQuery m)+  => (record1 -> Maybe (Key record2)) -> record1 -> m (Maybe record2)+belongsTo a1 a2 = runQueryRep $ BelongsTo a1 a2++-- | The lifted version of 'Database.Persist.Sql.belongsToJust'+belongsToJust+  :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend, Typeable record1, Typeable record2, MonadSqlQuery m)+  => (record1 -> Key record2) -> record1 -> m record2+belongsToJust a1 a2 = runQueryRep $ BelongsToJust a1 a2++-- | The lifted version of 'Database.Persist.Sql.insert'+insert+  :: (PersistRecordBackend record SqlBackend, 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)+  => record -> m ()+insert_ a1 = runQueryRep $ Insert_ a1++-- | The lifted version of 'Database.Persist.Sql.insertMany'+insertMany+  :: (PersistRecordBackend record SqlBackend, 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)+  => [record] -> m ()+insertMany_ a1 = runQueryRep $ InsertMany_ a1++-- | The lifted version of 'Database.Persist.Sql.insertEntityMany'+insertEntityMany+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Entity record] -> m ()+insertEntityMany a1 = runQueryRep $ InsertEntityMany a1++-- | The lifted version of 'Database.Persist.Sql.insertKey'+insertKey+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> record -> m ()+insertKey a1 a2 = runQueryRep $ InsertKey a1 a2++-- | The lifted version of 'Database.Persist.Sql.repsert'+repsert+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> record -> m ()+repsert a1 a2 = runQueryRep $ Repsert a1 a2++-- | The lifted version of 'Database.Persist.Sql.repsertMany'+repsertMany+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [(Key record, record)] -> m ()+repsertMany a1 = runQueryRep $ RepsertMany a1++-- | The lifted version of 'Database.Persist.Sql.replace'+replace+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> record -> m ()+replace a1 a2 = runQueryRep $ Replace a1 a2++-- | The lifted version of 'Database.Persist.Sql.delete'+delete+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> m ()+delete a1 = runQueryRep $ Delete a1++-- | The lifted version of 'Database.Persist.Sql.update'+update+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> [Update record] -> m ()+update a1 a2 = runQueryRep $ Update a1 a2++-- | The lifted version of 'Database.Persist.Sql.updateGet'+updateGet+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> [Update record] -> m record+updateGet a1 a2 = runQueryRep $ UpdateGet a1 a2++-- | The lifted version of 'Database.Persist.Sql.insertEntity'+insertEntity+  :: (PersistRecordBackend record SqlBackend, 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)+  => record -> m record+insertRecord a1 = runQueryRep $ InsertRecord a1++-- | The lifted version of 'Database.Persist.Sql.getBy'+getBy+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => 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+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => Unique record -> m ()+deleteBy a1 = runQueryRep $ DeleteBy a1++-- | The lifted version of 'Database.Persist.Sql.insertUnique'+insertUnique+  :: (PersistRecordBackend record SqlBackend, 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)+  => 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)+  => 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)+  => [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)+  => 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)+  => record -> m (Maybe (Entity record))+insertUniqueEntity a1 = runQueryRep $ InsertUniqueEntity a1++-- | The lifted version of 'Database.Persist.Sql.replaceUnique'+replaceUnique+  :: (PersistRecordBackend record SqlBackend, Eq (Unique record), Eq record, Typeable record, MonadSqlQuery m)+  => 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)+  => [Filter record] -> [SelectOpt record] -> m (Acquire (ConduitM () (Entity record) m2 ()))+selectSourceRes a1 a2 = runQueryRep $ SelectSourceRes a1 a2++-- | The lifted version of 'Database.Persist.Sql.selectFirst'+selectFirst+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> [SelectOpt record] -> m (Maybe (Entity record))+selectFirst a1 a2 = runQueryRep $ SelectFirst a1 a2++-- | The lifted version of 'Database.Persist.Sql.selectKeysRes'+selectKeysRes+  :: (MonadIO m2, PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> [SelectOpt record] -> m (Acquire (ConduitM () (Key record) m2 ()))+selectKeysRes a1 a2 = runQueryRep $ SelectKeysRes a1 a2++-- | The lifted version of 'Database.Persist.Sql.count'+count+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [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+  :: (PersistRecordBackend record SqlBackend, MonadResource m, Typeable record, MonadSqlQuery m)+  => [Filter record] -> [SelectOpt record] -> ConduitM () (Entity record) m ()+selectSource a1 a2 = fromAcquire $ runQueryRep $ SelectSourceRes a1 a2++-- | The lifted version of 'Database.Persist.Sql.selectKeys'+selectKeys+  :: (PersistRecordBackend record SqlBackend, MonadResource m, Typeable record, MonadSqlQuery m)+  => [Filter record] -> [SelectOpt record] -> ConduitM () (Key record) m ()+selectKeys a1 a2 = fromAcquire $ runQueryRep $ SelectKeysRes a1 a2++-- | The lifted version of 'Database.Persist.Sql.selectList'+selectList+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> [SelectOpt record] -> m [Entity record]+selectList a1 a2 = runQueryRep $ SelectList a1 a2++-- | The lifted version of 'Database.Persist.Sql.selectKeysList'+selectKeysList+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> [SelectOpt record] -> m [Key record]+selectKeysList a1 a2 = runQueryRep $ SelectKeysList a1 a2++-- | The lifted version of 'Database.Persist.Sql.updateWhere'+updateWhere+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> [Update record] -> m ()+updateWhere a1 a2 = runQueryRep $ UpdateWhere a1 a2++-- | The lifted version of 'Database.Persist.Sql.deleteWhere'+deleteWhere+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> m ()+deleteWhere a1 = runQueryRep $ DeleteWhere a1++-- | The lifted version of 'Database.Persist.Sql.deleteWhereCount'+deleteWhereCount+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> m Int64+deleteWhereCount a1 = runQueryRep $ DeleteWhereCount a1++-- | The lifted version of 'Database.Persist.Sql.updateWhereCount'+updateWhereCount+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> [Update record] -> m Int64+updateWhereCount a1 a2 = runQueryRep $ UpdateWhereCount a1 a2++-- | The lifted version of 'Database.Persist.Sql.deleteCascade'+deleteCascade+  :: (DeleteCascade record SqlBackend, Typeable record, MonadSqlQuery m)+  => Key record -> m ()+deleteCascade a1 = runQueryRep $ DeleteCascade a1++-- | The lifted version of 'Database.Persist.Sql.deleteCascadeWhere'+deleteCascadeWhere+  :: (DeleteCascade record SqlBackend, Typeable record, MonadSqlQuery m)+  => [Filter record] -> m ()+deleteCascadeWhere a1 = runQueryRep $ DeleteCascadeWhere a1++-- | The lifted version of 'Database.Persist.Sql.parseMigration'+parseMigration+  :: (HasCallStack, MonadSqlQuery m)+  => Migration -> m (Either [Text] CautiousMigration)+parseMigration a1 = runQueryRep $ ParseMigration a1++-- | The lifted version of 'Database.Persist.Sql.parseMigration''+parseMigration'+  :: (HasCallStack, MonadSqlQuery m)+  => Migration -> m CautiousMigration+parseMigration' a1 = runQueryRep $ ParseMigration' a1++-- | The lifted version of 'Database.Persist.Sql.printMigration'+printMigration+  :: (HasCallStack, MonadSqlQuery m)+  => Migration -> m ()+printMigration a1 = runQueryRep $ PrintMigration a1++-- | The lifted version of 'Database.Persist.Sql.showMigration'+showMigration+  :: (HasCallStack, MonadSqlQuery m)+  => Migration -> m [Text]+showMigration a1 = runQueryRep $ ShowMigration a1++-- | The lifted version of 'Database.Persist.Sql.getMigration'+getMigration+  :: (HasCallStack, MonadSqlQuery m)+  => Migration -> m [Sql]+getMigration a1 = runQueryRep $ GetMigration a1++-- | The lifted version of 'Database.Persist.Sql.runMigration'+runMigration+  :: (MonadSqlQuery m)+  => 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+  :: (MonadSqlQuery m)+  => Migration -> m [Text]+runMigrationSilent a1 = runQueryRep $ RunMigrationSilent a1++-- | The lifted version of 'Database.Persist.Sql.runMigrationUnsafe'+runMigrationUnsafe+  :: (MonadSqlQuery m)+  => 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+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => EntityField record typ -> m Text+getFieldName a1 = runQueryRep $ GetFieldName a1++-- | The lifted version of 'Database.Persist.Sql.getTableName'+getTableName+  :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m)+  => record -> m Text+getTableName a1 = runQueryRep $ GetTableName a1++-- | The lifted version of 'Database.Persist.Sql.withRawQuery'+withRawQuery+  :: (MonadSqlQuery m)+  => Text -> [PersistValue] -> ConduitM [PersistValue] Void IO a -> m a+withRawQuery a1 a2 a3 = runQueryRep $ WithRawQuery a1 a2 a3++-- | The lifted version of 'Database.Persist.Sql.rawQueryRes'+rawQueryRes+  :: (MonadIO m2, MonadSqlQuery m)+  => Text -> [PersistValue] -> m (Acquire (ConduitM () [PersistValue] m2 ()))+rawQueryRes a1 a2 = runQueryRep $ RawQueryRes a1 a2++-- | The lifted version of 'Database.Persist.Sql.rawQuery'+rawQuery+  :: (MonadResource m, MonadSqlQuery m)+  => Text -> [PersistValue] -> ConduitM () [PersistValue] m ()+rawQuery a1 a2 = fromAcquire $ runQueryRep $ RawQueryRes a1 a2++-- | The lifted version of 'Database.Persist.Sql.rawExecute'+rawExecute+  :: (MonadSqlQuery m)+  => Text -> [PersistValue] -> m ()+rawExecute a1 a2 = runQueryRep $ RawExecute a1 a2++-- | The lifted version of 'Database.Persist.Sql.rawExecuteCount'+rawExecuteCount+  :: (MonadSqlQuery m)+  => Text -> [PersistValue] -> m Int64+rawExecuteCount a1 a2 = runQueryRep $ RawExecuteCount a1 a2++-- | The lifted version of 'Database.Persist.Sql.rawSql'+rawSql+  :: (RawSql a, MonadSqlQuery m)+  => Text -> [PersistValue] -> m [a]+rawSql a1 a2 = runQueryRep $ RawSql a1 a2++-- | The lifted version of 'Database.Persist.Sql.transactionSave'+transactionSave+  :: (MonadSqlQuery m)+  => 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+  :: (MonadSqlQuery m)+  => 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++{- Helpers -}++-- | A helper for functions that return a conduit.+fromAcquire :: MonadResource m => m (Acquire (ConduitM i o m a)) -> ConduitM i o m a+fromAcquire getAcquire = do+  (_, conduit) <- lift $ getAcquire >>= allocateAcquire+  conduit

@@ -0,0 +1,652 @@+{-|+Module: Database.Persist.Monad.SqlQueryRep++Defines the 'SqlQueryRep' data type that contains a constructor corresponding+to a @persistent@ function.++This file is autogenerated, to keep it in sync with+@Database.Persist.Monad.Shim@.+-}++{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Database.Persist.Monad.SqlQueryRep+  ( SqlQueryRep(..)+  , runSqlQueryRep+  ) where++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.Acquire (Acquire)+import Data.Conduit (ConduitM)+import Data.Int (Int64)+import Data.Map (Map)+import Data.Proxy (Proxy(..))+import Data.Text (Text)+import Data.Typeable (Typeable, eqT, typeRep, (:~:)(..))+import Data.Void (Void)+import Database.Persist.Sql as Persist hiding (pattern Update)+import GHC.Stack (HasCallStack)++{-# ANN module "HLint: ignore" #-}++-- | The data type containing a constructor for each persistent function we'd+-- like to lift into 'Database.Persist.Monad.MonadSqlQuery'.+--+-- The @record@ type parameter contains the 'PersistEntity' types used in a+-- given function.+--+-- We're using a free-monads-like technique here to allow us to introspect+-- persistent functions in 'Database.Persist.Monad.MonadSqlQuery', e.g. to+-- mock out persistent calls in tests.+data SqlQueryRep record a where+  -- | Constructor corresponding to 'Persist.get'+  Get+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> SqlQueryRep record (Maybe record)++  -- | Constructor corresponding to 'Persist.getMany'+  GetMany+    :: (PersistRecordBackend record SqlBackend)+    => [Key record] -> SqlQueryRep record (Map (Key record) record)++  -- | Constructor corresponding to 'Persist.getJust'+  GetJust+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> SqlQueryRep record record++  -- | Constructor corresponding to 'Persist.getJustEntity'+  GetJustEntity+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> SqlQueryRep record (Entity record)++  -- | Constructor corresponding to 'Persist.getEntity'+  GetEntity+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> SqlQueryRep record (Maybe (Entity record))++  -- | Constructor corresponding to 'Persist.belongsTo'+  BelongsTo+    :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend)+    => (record1 -> Maybe (Key record2)) -> record1 -> SqlQueryRep (record1, record2) (Maybe record2)++  -- | Constructor corresponding to 'Persist.belongsToJust'+  BelongsToJust+    :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend)+    => (record1 -> Key record2) -> record1 -> SqlQueryRep (record1, record2) record2++  -- | Constructor corresponding to 'Persist.insert'+  Insert+    :: (PersistRecordBackend record SqlBackend)+    => record -> SqlQueryRep record (Key record)++  -- | Constructor corresponding to 'Persist.insert_'+  Insert_+    :: (PersistRecordBackend record SqlBackend)+    => record -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.insertMany'+  InsertMany+    :: (PersistRecordBackend record SqlBackend)+    => [record] -> SqlQueryRep record [Key record]++  -- | Constructor corresponding to 'Persist.insertMany_'+  InsertMany_+    :: (PersistRecordBackend record SqlBackend)+    => [record] -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.insertEntityMany'+  InsertEntityMany+    :: (PersistRecordBackend record SqlBackend)+    => [Entity record] -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.insertKey'+  InsertKey+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> record -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.repsert'+  Repsert+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> record -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.repsertMany'+  RepsertMany+    :: (PersistRecordBackend record SqlBackend)+    => [(Key record, record)] -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.replace'+  Replace+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> record -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.delete'+  Delete+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.update'+  Update+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> [Update record] -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.updateGet'+  UpdateGet+    :: (PersistRecordBackend record SqlBackend)+    => Key record -> [Update record] -> SqlQueryRep record record++  -- | Constructor corresponding to 'Persist.insertEntity'+  InsertEntity+    :: (PersistRecordBackend record SqlBackend)+    => record -> SqlQueryRep record (Entity record)++  -- | Constructor corresponding to 'Persist.insertRecord'+  InsertRecord+    :: (PersistRecordBackend record SqlBackend)+    => record -> SqlQueryRep record record++  -- | Constructor corresponding to 'Persist.getBy'+  GetBy+    :: (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+    :: (PersistRecordBackend record SqlBackend)+    => Unique record -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.insertUnique'+  InsertUnique+    :: (PersistRecordBackend record SqlBackend)+    => record -> SqlQueryRep record (Maybe (Key record))++#if MIN_VERSION_persistent(2,10,0)+  -- | Constructor corresponding to 'Persist.upsert'+  Upsert+    :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey 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)+    => Unique record -> record -> [Update record] -> SqlQueryRep record (Entity record)++  -- | Constructor corresponding to 'Persist.putMany'+  PutMany+    :: (PersistRecordBackend record SqlBackend)+    => [record] -> SqlQueryRep record ()++#if MIN_VERSION_persistent(2,10,0)+  -- | Constructor corresponding to 'Persist.insertBy'+  InsertBy+    :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey 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)+    => record -> SqlQueryRep record (Maybe (Entity record))++  -- | Constructor corresponding to 'Persist.replaceUnique'+  ReplaceUnique+    :: (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)+    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record (Acquire (ConduitM () (Entity record) m2 ()))++  -- | Constructor corresponding to 'Persist.selectFirst'+  SelectFirst+    :: (PersistRecordBackend record SqlBackend)+    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record (Maybe (Entity record))++  -- | Constructor corresponding to 'Persist.selectKeysRes'+  SelectKeysRes+    :: (MonadIO m2, PersistRecordBackend record SqlBackend)+    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record (Acquire (ConduitM () (Key record) m2 ()))++  -- | Constructor corresponding to 'Persist.count'+  Count+    :: (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+    :: (PersistRecordBackend record SqlBackend)+    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record [Entity record]++  -- | Constructor corresponding to 'Persist.selectKeysList'+  SelectKeysList+    :: (PersistRecordBackend record SqlBackend)+    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record [Key record]++  -- | Constructor corresponding to 'Persist.updateWhere'+  UpdateWhere+    :: (PersistRecordBackend record SqlBackend)+    => [Filter record] -> [Update record] -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.deleteWhere'+  DeleteWhere+    :: (PersistRecordBackend record SqlBackend)+    => [Filter record] -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.deleteWhereCount'+  DeleteWhereCount+    :: (PersistRecordBackend record SqlBackend)+    => [Filter record] -> SqlQueryRep record Int64++  -- | Constructor corresponding to 'Persist.updateWhereCount'+  UpdateWhereCount+    :: (PersistRecordBackend record SqlBackend)+    => [Filter record] -> [Update record] -> SqlQueryRep record Int64++  -- | Constructor corresponding to 'Persist.deleteCascade'+  DeleteCascade+    :: (DeleteCascade record SqlBackend)+    => Key record -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.deleteCascadeWhere'+  DeleteCascadeWhere+    :: (DeleteCascade record SqlBackend)+    => [Filter record] -> SqlQueryRep record ()++  -- | Constructor corresponding to 'Persist.parseMigration'+  ParseMigration+    :: (HasCallStack)+    => Migration -> SqlQueryRep Void (Either [Text] CautiousMigration)++  -- | Constructor corresponding to 'Persist.parseMigration''+  ParseMigration'+    :: (HasCallStack)+    => Migration -> SqlQueryRep Void CautiousMigration++  -- | Constructor corresponding to 'Persist.printMigration'+  PrintMigration+    :: (HasCallStack)+    => Migration -> SqlQueryRep Void ()++  -- | Constructor corresponding to 'Persist.showMigration'+  ShowMigration+    :: (HasCallStack)+    => Migration -> SqlQueryRep Void [Text]++  -- | Constructor corresponding to 'Persist.getMigration'+  GetMigration+    :: (HasCallStack)+    => Migration -> SqlQueryRep Void [Sql]++  -- | Constructor corresponding to 'Persist.runMigration'+  RunMigration+    :: ()+    => 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+    :: ()+    => Migration -> SqlQueryRep Void [Text]++  -- | Constructor corresponding to 'Persist.runMigrationUnsafe'+  RunMigrationUnsafe+    :: ()+    => 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+    :: (PersistRecordBackend record SqlBackend)+    => EntityField record typ -> SqlQueryRep record Text++  -- | Constructor corresponding to 'Persist.getTableName'+  GetTableName+    :: (PersistRecordBackend record SqlBackend)+    => record -> SqlQueryRep record Text++  -- | Constructor corresponding to 'Persist.withRawQuery'+  WithRawQuery+    :: ()+    => Text -> [PersistValue] -> ConduitM [PersistValue] Void IO a -> SqlQueryRep Void a++  -- | Constructor corresponding to 'Persist.rawQueryRes'+  RawQueryRes+    :: (MonadIO m2)+    => Text -> [PersistValue] -> SqlQueryRep Void (Acquire (ConduitM () [PersistValue] m2 ()))++  -- | Constructor corresponding to 'Persist.rawExecute'+  RawExecute+    :: ()+    => Text -> [PersistValue] -> SqlQueryRep Void ()++  -- | Constructor corresponding to 'Persist.rawExecuteCount'+  RawExecuteCount+    :: ()+    => Text -> [PersistValue] -> SqlQueryRep Void Int64++  -- | Constructor corresponding to 'Persist.rawSql'+  RawSql+    :: (RawSql a)+    => Text -> [PersistValue] -> SqlQueryRep Void [a]++  -- | Constructor corresponding to 'Persist.transactionSave'+  TransactionSave+    :: ()+    => 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++instance Typeable record => Show (SqlQueryRep record a) where+  show = \case+    Get{} -> "Get{..}" ++ record+    GetMany{} -> "GetMany{..}" ++ record+    GetJust{} -> "GetJust{..}" ++ record+    GetJustEntity{} -> "GetJustEntity{..}" ++ record+    GetEntity{} -> "GetEntity{..}" ++ record+    BelongsTo{} -> "BelongsTo{..}" ++ record+    BelongsToJust{} -> "BelongsToJust{..}" ++ record+    Insert{} -> "Insert{..}" ++ record+    Insert_{} -> "Insert_{..}" ++ record+    InsertMany{} -> "InsertMany{..}" ++ record+    InsertMany_{} -> "InsertMany_{..}" ++ record+    InsertEntityMany{} -> "InsertEntityMany{..}" ++ record+    InsertKey{} -> "InsertKey{..}" ++ record+    Repsert{} -> "Repsert{..}" ++ record+    RepsertMany{} -> "RepsertMany{..}" ++ record+    Replace{} -> "Replace{..}" ++ record+    Delete{} -> "Delete{..}" ++ record+    Update{} -> "Update{..}" ++ record+    UpdateGet{} -> "UpdateGet{..}" ++ record+    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+    DeleteCascade{} -> "DeleteCascade{..}" ++ record+    DeleteCascadeWhere{} -> "DeleteCascadeWhere{..}" ++ record+    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+    RawQueryRes{} -> "RawQueryRes{..}" ++ record+    RawExecute{} -> "RawExecute{..}" ++ record+    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+    where+      record = case recordTypeRep of+        Just recordType -> "<" ++ show recordType ++ ">"+        Nothing -> ""+      recordTypeRep = case eqT @record @Void of+        Just Refl -> Nothing+        Nothing -> Just $ typeRep $ Proxy @record++-- | A helper to execute the actual @persistent@ function corresponding to+-- each 'SqlQueryRep' data constructor.+runSqlQueryRep :: MonadUnliftIO m => SqlQueryRep record a -> Persist.SqlPersistT m a+runSqlQueryRep = \case+  Get a1 -> Persist.get a1+  GetMany a1 -> Persist.getMany a1+  GetJust a1 -> Persist.getJust a1+  GetJustEntity a1 -> Persist.getJustEntity a1+  GetEntity a1 -> Persist.getEntity a1+  BelongsTo a1 a2 -> Persist.belongsTo a1 a2+  BelongsToJust a1 a2 -> Persist.belongsToJust a1 a2+  Insert a1 -> Persist.insert a1+  Insert_ a1 -> Persist.insert_ a1+  InsertMany a1 -> Persist.insertMany a1+  InsertMany_ a1 -> Persist.insertMany_ a1+  InsertEntityMany a1 -> Persist.insertEntityMany a1+  InsertKey a1 a2 -> Persist.insertKey a1 a2+  Repsert a1 a2 -> Persist.repsert a1 a2+  RepsertMany a1 -> Persist.repsertMany a1+  Replace a1 a2 -> Persist.replace a1 a2+  Delete a1 -> Persist.delete a1+  Update a1 a2 -> Persist.update a1 a2+  UpdateGet a1 a2 -> Persist.updateGet a1 a2+  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+  DeleteCascade a1 -> Persist.deleteCascade a1+  DeleteCascadeWhere a1 -> Persist.deleteCascadeWhere a1+  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+  RawQueryRes a1 a2 -> Persist.rawQueryRes a1 a2+  RawExecute a1 a2 -> Persist.rawExecute a1 a2+  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

@@ -0,0 +1,235 @@+{-|+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 #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Database.Persist.Monad.TestUtils+  ( MockSqlQueryT+  , runMockSqlQueryT+  , withRecord+  , mockQuery+  , MockQuery+  -- * Specialized helpers+  , mockSelectSource+  , mockSelectKeys+  , mockWithRawQuery+  , mockRawQuery+  , mockRawSql+  ) where++import Conduit ((.|))+import qualified Conduit+import Control.Monad (msum)+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 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+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , 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+--   ]+-- @+runMockSqlQueryT :: MockSqlQueryT m a -> [MockQuery] -> m a+runMockSqlQueryT action mockQueries = (`runReaderT` mockQueries) . unMockSqlQueryT $ action++instance MonadIO m => MonadSqlQuery (MockSqlQueryT m) where+  runQueryRep rep = do+    mockQueries <- MockSqlQueryT ask+    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'.+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)+-- @+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'.+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+-- @+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+  _ -> 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+  _ -> 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+  _ -> 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+  _ -> 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+  _ -> Nothing

@@ -0,0 +1,141 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+{-# OPTIONS_GHC -Wno-missing-methods #-}++module Example+  ( TestApp+  , runTestApp++    -- * Person+  , Person(..)+  , person+  , getPeople+  , getPeopleNames+  , getName+  , nameAndAge++    -- * Post+  , Post(..)+  , post+  , getPosts+  , getPostTitles++    -- * Persistent+  , EntityField(..)+  , Unique(..)+  , migration+  ) where++import Control.Arrow ((&&&))+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Logger (runNoLoggingT)+import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)+import qualified Data.Text as Text+import Database.Persist.Sql (Entity(..), EntityField, Key, Unique, toSqlKey)+import Database.Persist.Sqlite (withSqlitePool)+import Database.Persist.TH+    ( mkDeleteCascade+    , mkMigrate+    , mkPersist+    , persistLowerCase+    , share+    , sqlSettings+    )+import UnliftIO (MonadUnliftIO(..), withSystemTempDirectory, wrappedWithRunInIO)++import Database.Persist.Monad++share+  [ mkPersist sqlSettings+  , mkDeleteCascade sqlSettings+  , mkMigrate "migration"+  ]+  [persistLowerCase|+Person+  name String+  age Int+  removedColumn String SafeToRemove+  UniqueName name+  deriving Show Eq++Post+  title String+  author PersonId+  editor PersonId Maybe+  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+  fromInteger = toSqlKey . fromInteger++instance Num (Key Post) where+  fromInteger = toSqlKey . fromInteger++newtype TestApp a = TestApp+  { unTestApp :: SqlQueryT (ResourceT IO) a+  } deriving+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadSqlQuery+    , MonadResource+    )++instance MonadUnliftIO TestApp where+  withRunInIO = wrappedWithRunInIO TestApp unTestApp++runTestApp :: TestApp a -> IO a+runTestApp m =+  withSystemTempDirectory "persistent-mtl-testapp" $ \dir -> do+    let db = Text.pack $ dir ++ "/db.sqlite"+    runNoLoggingT $ withSqlitePool db 5 $ \pool ->+      liftIO . runResourceT . runSqlQueryT pool . unTestApp $ do+        _ <- runMigrationSilent migration+        m++{- Person functions -}++person :: String -> Person+person name = Person name 0++getName :: Entity Person -> String+getName = personName . entityVal++getPeople :: MonadSqlQuery m => m [Person]+getPeople = map entityVal <$> selectList [] []++getPeopleNames :: MonadSqlQuery m => m [String]+getPeopleNames = map personName <$> getPeople++nameAndAge :: Person -> (String, Int)+nameAndAge = personName &&& personAge++{- Post functions -}++post :: String -> Key Person -> Post+post title author = Post title author Nothing++getPosts :: MonadSqlQuery m => m [Post]+getPosts = map entityVal <$> selectList [] []++getPostTitles :: MonadSqlQuery m => m [String]+getPostTitles = map postTitle <$> getPosts

@@ -0,0 +1,124 @@+{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}++{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PatternSynonyms #-}++module Generated where++import Data.Acquire (Acquire)+import Data.Conduit (ConduitM)+import Data.Int (Int64)+import Data.Map (Map)+import Data.Text (Text)+import Data.Void (Void)+import Database.Persist.Sql hiding (pattern Update)++import Database.Persist.Monad+import Example++{-# ANN module "HLint: ignore" #-}++allSqlQueryRepShowRepresentations :: [String]+allSqlQueryRepShowRepresentations =+  [ show (Get undefined :: SqlQueryRep Person (Maybe Person))+  , show (GetMany undefined :: SqlQueryRep Person (Map (Key Person) Person))+  , show (GetJust undefined :: SqlQueryRep Person Person)+  , show (GetJustEntity undefined :: SqlQueryRep Person (Entity Person))+  , show (GetEntity undefined :: SqlQueryRep Person (Maybe (Entity Person)))+  , show (BelongsTo undefined undefined :: SqlQueryRep (Person, Post) (Maybe Post))+  , show (BelongsToJust undefined undefined :: SqlQueryRep (Person, Post) Post)+  , show (Insert undefined :: SqlQueryRep Person (Key Person))+  , show (Insert_ undefined :: SqlQueryRep Person ())+  , show (InsertMany undefined :: SqlQueryRep Person [Key Person])+  , show (InsertMany_ undefined :: SqlQueryRep Person ())+  , show (InsertEntityMany undefined :: SqlQueryRep Person ())+  , show (InsertKey undefined undefined :: SqlQueryRep Person ())+  , show (Repsert undefined undefined :: SqlQueryRep Person ())+  , show (RepsertMany undefined :: SqlQueryRep Person ())+  , show (Replace undefined undefined :: SqlQueryRep Person ())+  , show (Delete undefined :: SqlQueryRep Person ())+  , show (Update undefined undefined :: SqlQueryRep Person ())+  , show (UpdateGet undefined undefined :: SqlQueryRep Person Person)+  , 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)+  , show (DeleteCascade undefined :: SqlQueryRep Person ())+  , show (DeleteCascadeWhere undefined :: SqlQueryRep Person ())+  , 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)+  , show (RawQueryRes undefined undefined :: SqlQueryRep Void (Acquire (ConduitM () [PersistValue] IO ())))+  , show (RawExecute undefined undefined :: SqlQueryRep Void ())+  , 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+  ]

@@ -0,0 +1,761 @@+{-# LANGUAGE CPP #-}+{-# 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)+import Database.Persist.Sql+    ( Entity(..)+    , PersistField+    , PersistRecordBackend+    , PersistValue+    , Single(..)+    , SqlBackend+    , fromPersistValue+    , (=.)+    , (==.)+    )+#if MIN_VERSION_persistent(2,9,0)+import Database.Persist.Sql (IsolationLevel(..))+#endif+import Test.Tasty+import Test.Tasty.HUnit+import UnliftIO (Exception, MonadIO, MonadUnliftIO, liftIO, throwIO, try)++import Database.Persist.Monad+import Example+import TestUtils.Match (Match(..), (@?~))++tests :: TestTree+tests = testGroup "Integration tests"+  [ testWithTransaction+  , testPersistentAPI+  ]++testWithTransaction :: TestTree+testWithTransaction = testGroup "withTransaction"+  [ testCase "it uses the same transaction" $ do+      -- without transactions, the INSERT shouldn't be rolled back+      runTestApp $ do+        catchTestError $ insertAndFail $ person "Alice"+        result <- getPeopleNames+        liftIO $ result @?= ["Alice"]++      -- with transactions, the INSERT should be rolled back+      runTestApp $ do+        catchTestError $ withTransaction $ insertAndFail $ person "Alice"+        result <- getPeopleNames+        liftIO $ result @?= []+  ]++testPersistentAPI :: TestTree+testPersistentAPI = testGroup "Persistent API"+  [ testCase "get" $ do+      result <- runTestApp $ do+        insert_ $ person "Alice"+        mapM get [1, 2]+      map (fmap personName) result @?= [Just "Alice", Nothing]++  , testCase "getMany" $ do+      result <- runTestApp $ do+        insert_ $ person "Alice"+        getMany [1]+      personName <$> Map.lookup 1 result @?= Just "Alice"++  , testCase "getJust" $ do+      result <- runTestApp $ do+        insert_ $ person "Alice"+        getJust 1+      personName result @?= "Alice"++  , testCase "getJustEntity" $ do+      result <- runTestApp $ do+        insert_ $ person "Alice"+        getJustEntity 1+      getName result @?= "Alice"++  , testCase "getEntity" $ do+      result <- runTestApp $ do+        insert_ $ person "Alice"+        mapM getEntity [1, 2]+      map (fmap getName) result @?= [Just "Alice", Nothing]++  , testCase "belongsTo" $ do+      result <- runTestApp $ 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 $ 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 $ do+        aliceKey <- insert $ person "Alice"+        people <- getPeopleNames+        return (aliceKey, people)+      result @?= (1, ["Alice"])++  , testCase "insert_" $ do+      result <- runTestApp $ do+        result <- insert_ $ person "Alice"+        people <- getPeopleNames+        return (result, people)+      result @?= ((), ["Alice"])++  , testCase "insertMany" $ do+      result <- runTestApp $ do+        keys <- insertMany [person "Alice", person "Bob"]+        people <- getPeopleNames+        return (keys, people)+      result @?= ([1, 2], ["Alice", "Bob"])++  , testCase "insertMany_" $ do+      result <- runTestApp $ do+        result <- insertMany_ [person "Alice", person "Bob"]+        people <- getPeopleNames+        return (result, people)+      result @?= ((), ["Alice", "Bob"])++  , testCase "insertEntityMany" $ do+      result <- runTestApp $ do+        result <- insertEntityMany+          [ Entity 1 $ person "Alice"+          , Entity 2 $ person "Bob"+          ]+        people <- getPeopleNames+        return (result, people)+      result @?= ((), ["Alice", "Bob"])++  , testCase "insertKey" $ do+      result <- runTestApp $ do+        result <- insertKey 1 $ person "Alice"+        people <- getPeopleNames+        return (result, people)+      result @?= ((), ["Alice"])++  , testCase "repsert" $ do+      result <- runTestApp $ 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 $ 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 $ do+        let alice = person "Alice"+        insert_ alice+        replace 1 $ alice { personAge = 100 }+        getJust 1+      personAge result @?= 100++  , testCase "delete" $ do+      result <- runTestApp $ do+        aliceKey <- insert $ person "Alice"+        delete aliceKey+        getPeople+      result @?= []++  , testCase "update" $ do+      result <- runTestApp $ do+        key <- insert $ person "Alice"+        update key [PersonName =. "Alicia"]+        getPeopleNames+      result @?= ["Alicia"]++  , testCase "updateGet" $ do+      (updateResult, getResult) <- runTestApp $ do+        key <- insert $ person "Alice"+        updateResult <- updateGet key [PersonName =. "Alicia"]+        getResult <- getJust key+        return (updateResult, getResult)+      updateResult @?= getResult++  , testCase "insertEntity" $ do+      (insertResult, getResult) <- runTestApp $ do+        insertResult <- insertEntity $ person "Alice"+        getResult <- getJust $ entityKey insertResult+        return (insertResult, getResult)+      entityVal insertResult @?= getResult++  , testCase "insertRecord" $ do+      (insertResult, getResult) <- runTestApp $ do+        insertResult <- insertRecord $ person "Alice"+        getResult <- getJust 1+        return (insertResult, getResult)+      insertResult @?= getResult++  , testCase "getBy" $ do+      result <- runTestApp $ do+        insert_ $ person "Alice"+        mapM getBy [UniqueName "Alice", UniqueName "Bob"]+      map (fmap getName) result @?= [Just "Alice", Nothing]++  , testCase "getByValue" $ do+      result <- runTestApp $ do+        let alice = person "Alice"+        insert_ alice+        mapM getByValue [alice, person "Bob"]+      map (fmap getName) result @?= [Just "Alice", Nothing]++  , testCase "checkUnique" $ do+      result <- runTestApp $ 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 $ 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 $ do+        insert_ $ person "Alice"+        deleteBy $ UniqueName "Alice"+        getPeople+      result @?= []++  , testCase "insertUnique" $ do+      (result1, result2, people) <- runTestApp $ 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 $ 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 $ 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 $ 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 $ 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 $ 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 $ 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 $ onlyUnique $ person "Alice"+      result @?= UniqueName "Alice"++  , testCase "selectSourceRes" $ do+      result <- runTestApp $ 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 $ do+        insert_ $ person "Alice"+        sequence+          [ selectFirst [PersonName ==. "Alice"] []+          , selectFirst [PersonName ==. "Bob"] []+          ]+      map (fmap getName) result @?= [Just "Alice", Nothing]++  , testCase "selectKeysRes" $ do+      result <- runTestApp $ 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 $ 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 $ do+        insertMany_ [person "Alice", person "Bob"]+        exists [PersonName ==. "Alice"]+      result @?= True+#endif++  , testCase "selectSource" $ do+      result <- runTestApp $ do+        insertMany_ [person "Alice", person "Bob"]+        runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList+      result @?= ["Alice", "Bob"]++  , testCase "selectKeys" $ do+      result <- runTestApp $ do+        insertMany_ [person "Alice", person "Bob"]+        runConduit $ selectKeys @Person [] [] .| Conduit.sinkList+      result @?= [1, 2]++  , testCase "selectList" $ do+      result <- runTestApp $ do+        insert_ $ person "Alice"+        insert_ $ person "Bob"+        selectList [] []+      map getName result @?= ["Alice", "Bob"]++  , testCase "selectKeysList" $ do+      result <- runTestApp $ do+        insert_ $ person "Alice"+        insert_ $ person "Bob"+        selectKeysList @Person [] []+      result @?= [1, 2]++  , testCase "updateWhere" $ do+      result <- runTestApp $ do+        insertMany_ [person "Alice", person "Bob"]+        updateWhere [PersonName ==. "Alice"] [PersonAge =. 100]+        getPeople+      map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]++  , testCase "deleteWhere" $ do+      result <- runTestApp $ do+        insertMany_ [person "Alice", person "Bob"]+        deleteWhere [PersonName ==. "Alice"]+        getPeopleNames+      result @?= ["Bob"]++  , testCase "updateWhereCount" $ do+      (rowsUpdated, people) <- runTestApp $ 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 $ do+        insertMany_ [person "Alice", person "Bob"]+        rowsDeleted <- deleteWhereCount [PersonName ==. "Alice"]+        names <- getPeopleNames+        return (rowsDeleted, names)+      rowsDeleted @?= 1+      names @?= ["Bob"]++  , testCase "deleteCascade" $ do+      (people, posts) <- runTestApp $ 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 $ 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"]++  , testCase "parseMigration" $ do+      result <- runTestApp $ do+        setupUnsafeMigration+        parseMigration migration+      result @?~ Right @[Text]+        [ Match+            ( 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+        , Match (True, "DROP TABLE \"person\"")+        , Anything+        , Anything+        , Match (False, "DROP TABLE \"person_backup\"")+        ]++  , testCase "parseMigration'" $ do+      let action f = runTestApp $ do+            setupUnsafeMigration+            f migration++      result <- action parseMigration+      result' <- action parseMigration'+      Right result' @?= result++  , testCase "printMigration" $+      runTestApp $ do+        setupUnsafeMigration+        printMigration migration++  , testCase "showMigration" $ do+      result <- runTestApp $ do+        setupUnsafeMigration+        showMigration migration+      result @?~+        [ Match $ 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+        , Match "DROP TABLE \"person\";"+        , Anything+        , Anything+        , Match "DROP TABLE \"person_backup\";"+        ]++  , testCase "getMigration" $ do+      result <- runTestApp $ do+        setupUnsafeMigration+        getMigration migration+      result @?~+        [ Match $ 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+        , Match "DROP TABLE \"person\""+        , Anything+        , Anything+        , Match "DROP TABLE \"person_backup\""+        ]++  , testCase "runMigration" $ do+      result <- runTestApp $ do+        setupSafeMigration+        runMigration migration+        getSchemaColumnNames "person"+      assertNotIn "removed_column" result++#if MIN_VERSION_persistent(2,10,2)+  , testCase "runMigrationQuiet" $ do+      (withQuiet, cols) <- runTestApp $ do+        setupSafeMigration+        sql <- runMigrationQuiet migration+        cols <- getSchemaColumnNames "person"+        return (sql, cols)+      withSilent <- runTestApp $ do+        setupSafeMigration+        runMigrationSilent migration+      assertNotIn "removed_column" cols+      withQuiet @?= withSilent+#endif++  , testCase "runMigrationSilent" $ do+      (sqlPlanned, sqlExecuted, cols) <- runTestApp $ do+        setupSafeMigration+        sqlPlanned <- getMigration migration+        sqlExecuted <- runMigrationSilent migration+        cols <- getSchemaColumnNames "person"+        return (sqlPlanned, sqlExecuted, cols)+      assertNotIn "removed_column" cols+      sqlExecuted @?= sqlPlanned++  , testCase "runMigrationUnsafe" $ do+      result <- runTestApp $ do+        setupUnsafeMigration+        runMigrationUnsafe migration+        getSchemaColumnNames "person"+      assertNotIn "removed_column" result++#if MIN_VERSION_persistent(2,10,2)+  , testCase "runMigrationUnsafeQuiet" $ do+      (sqlPlanned, sqlExecuted, cols) <- runTestApp $ do+        setupUnsafeMigration+        sqlPlanned <- getMigration migration+        sqlExecuted <- runMigrationUnsafeQuiet migration+        cols <- getSchemaColumnNames "person"+        return (sqlPlanned, sqlExecuted, cols)+      assertNotIn "removed_column" cols+      sqlExecuted @?= sqlPlanned+#endif++  , testCase "getFieldName" $ do+      result <- runTestApp $+        getFieldName PersonName+      result @?= "\"name\""++  , testCase "getTableName" $ do+      result <- runTestApp $+        getTableName $ person "Alice"+      result @?= "\"person\""++  , testCase "withRawQuery" $ do+      result <- runTestApp $ 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 $ 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 $ 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 $ 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 $ 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 $ do+        insertMany_ [person "Alice", person "Bob"]+        rawSql @(Single String) "SELECT name FROM person" []+      map unSingle result @?= ["Alice", "Bob"]++  , testCase "transactionSave" $ do+      result1 <- runTestApp $ do+        catchTestError $ withTransaction $ do+          insert_ $ person "Alice"+          insertAndFail $ person "Bob"+        getPeopleNames+      result1 @?= []++      result2 <- runTestApp $ 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 $ do+        catchTestError $ withTransaction $ do+          insert_ $ person "Alice"+          insertAndFail $ person "Bob"+        getPeopleNames+      result1 @?= []++      result2 <- runTestApp $ do+        catchTestError $ withTransaction $ do+          insert_ $ person "Alice"+          transactionSaveWithIsolation Serializable+          insertAndFail $ person "Bob"+        getPeopleNames+      result2 @?= ["Alice"]+#endif++  , testCase "transactionUndo" $ do+      result <- runTestApp $ withTransaction $ do+        insert_ $ person "Alice"+        transactionUndo+        getPeopleNames+      result @?= []++#if MIN_VERSION_persistent(2,9,0)+  , testCase "transactionUndoWithIsolation" $ do+      result <- runTestApp $ withTransaction $ do+        insert_ $ person "Alice"+        transactionUndoWithIsolation Serializable+        getPeopleNames+      result @?= []+#endif+  ]++{- 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 => String -> m [String]+getSchemaColumnNames tableName = map unSingle <$> rawSql sql []+  where+    sql = Text.pack $ "SELECT name FROM pragma_table_info('" ++ 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 ::+  ( MonadIO m+  , MonadSqlQuery m+  , PersistRecordBackend record SqlBackend+  , Typeable record+  )+  => record -> m ()+insertAndFail record = do+  insert_ record+  throwIO TestError++assertNotIn :: (Eq a, Show a) => a -> [a] -> Assertion+assertNotIn a as = as @?= filter (/= a) as

@@ -0,0 +1,17 @@+import Test.Tasty++import qualified Integration+import qualified MockSqlQueryT+import qualified Mocked+import qualified SqlQueryRepTest++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "persistent-mtl"+  [ Mocked.tests+  , Integration.tests+  , MockSqlQueryT.tests+  , SqlQueryRepTest.tests+  ]

@@ -0,0 +1,39 @@+{-# 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+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"]+  ]

@@ -0,0 +1,546 @@+{-# 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++  , 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 @?= ()++  , 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,35 @@+{-# LANGUAGE CPP #-}++module SqlQueryRepTest where++import qualified Data.ByteString.Lazy.Char8 as Char8+import Test.Tasty+import Test.Tasty.Golden++import Generated++{-# ANN module "HLint: ignore" #-}++persistentVersionDir :: FilePath+#if 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 = undefined+#endif++tests :: TestTree+tests = testGroup "SqlQueryRep tests"+  [ 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+  where+    diffCmd expected actual = ["diff", "-u", expected, actual]

@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE IncoherentInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module TestUtils.Match+  ( Match(..)+  , (@?~)+  , CanMatch(..)+  ) where++import Test.Tasty.HUnit (Assertion, assertFailure)++data Match a = Match a | Anything++instance Show a => Show (Match a) where+  show Anything = "[...]"+  show (Match a) = show a++-- | An HUnit operator for checking that the given arguments match.+(@?~) :: (CanMatch actual expected, Show actual, Show expected) => actual -> expected -> Assertion+(@?~) actual expected =+  if matches actual expected+    then return ()+    else assertFailure $ unlines+      [ "Expected:"+      , "  " ++ show expected+      , "Got:"+      , "  " ++ show actual+      ]++class CanMatch a b where+  matches :: a -> b -> Bool++instance {-# OVERLAPPABLE #-} Eq a => CanMatch a a where+  matches = (==)++instance CanMatch a b => CanMatch a (Match b) where+  matches _ Anything = True+  matches a (Match b) = matches a b++instance CanMatch a b => CanMatch [a] [b] where+  matches as bs = length as == length bs && and (zipWith matches as bs)++instance (CanMatch a c, CanMatch b d) => CanMatch (Either a b) (Either c d) where+  matches (Left a) (Left c) = matches a c+  matches (Right b) (Right d) = matches b d+  matches _ _ = False

@@ -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>+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{..}

@@ -0,0 +1,68 @@+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,62 @@+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{..}

@@ -0,0 +1,64 @@+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{..}