{-|
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 #-}
{-# LANGUAGE TypeFamilies #-}

module Database.Persist.Monad.TestUtils
  ( MockSqlQueryT
  , runMockSqlQueryT
  , withRecord
  , mockQuery
  , MockQuery

  -- * Specialized helpers
  , mockSelectSource
  , mockSelectKeys
  , mockWithRawQuery
  , mockRawQuery
  , mockRawSql

  -- * Re-exports
  , SqlQueryRep(..)
  ) 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
  { MockSqlQueryT m a -> ReaderT [MockQuery] m a
unMockSqlQueryT :: ReaderT [MockQuery] m a
  } deriving
    ( a -> MockSqlQueryT m b -> MockSqlQueryT m a
(a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
(forall a b. (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b)
-> (forall a b. a -> MockSqlQueryT m b -> MockSqlQueryT m a)
-> Functor (MockSqlQueryT m)
forall a b. a -> MockSqlQueryT m b -> MockSqlQueryT m a
forall a b. (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MockSqlQueryT m b -> MockSqlQueryT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MockSqlQueryT m b -> MockSqlQueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MockSqlQueryT m b -> MockSqlQueryT m a
fmap :: (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
Functor
    , Functor (MockSqlQueryT m)
a -> MockSqlQueryT m a
Functor (MockSqlQueryT m)
-> (forall a. a -> MockSqlQueryT m a)
-> (forall a b.
    MockSqlQueryT m (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b)
-> (forall a b c.
    (a -> b -> c)
    -> MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m c)
-> (forall a b.
    MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b)
-> (forall a b.
    MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m a)
-> Applicative (MockSqlQueryT m)
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m a
MockSqlQueryT m (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
(a -> b -> c)
-> MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m c
forall a. a -> MockSqlQueryT m a
forall a b.
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m a
forall a b.
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
forall a b.
MockSqlQueryT m (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
forall a b c.
(a -> b -> c)
-> MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (MockSqlQueryT m)
forall (m :: * -> *) a. Applicative m => a -> MockSqlQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
forall (m :: * -> *) a b.
Applicative m =>
MockSqlQueryT m (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m c
<* :: MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m a
*> :: MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
liftA2 :: (a -> b -> c)
-> MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m c
<*> :: MockSqlQueryT m (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
MockSqlQueryT m (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
pure :: a -> MockSqlQueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MockSqlQueryT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (MockSqlQueryT m)
Applicative
    , Applicative (MockSqlQueryT m)
a -> MockSqlQueryT m a
Applicative (MockSqlQueryT m)
-> (forall a b.
    MockSqlQueryT m a -> (a -> MockSqlQueryT m b) -> MockSqlQueryT m b)
-> (forall a b.
    MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b)
-> (forall a. a -> MockSqlQueryT m a)
-> Monad (MockSqlQueryT m)
MockSqlQueryT m a -> (a -> MockSqlQueryT m b) -> MockSqlQueryT m b
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
forall a. a -> MockSqlQueryT m a
forall a b.
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
forall a b.
MockSqlQueryT m a -> (a -> MockSqlQueryT m b) -> MockSqlQueryT m b
forall (m :: * -> *). Monad m => Applicative (MockSqlQueryT m)
forall (m :: * -> *) a. Monad m => a -> MockSqlQueryT m a
forall (m :: * -> *) a b.
Monad m =>
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
forall (m :: * -> *) a b.
Monad m =>
MockSqlQueryT m a -> (a -> MockSqlQueryT m b) -> MockSqlQueryT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> MockSqlQueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MockSqlQueryT m a
>> :: MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MockSqlQueryT m a -> MockSqlQueryT m b -> MockSqlQueryT m b
>>= :: MockSqlQueryT m a -> (a -> MockSqlQueryT m b) -> MockSqlQueryT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MockSqlQueryT m a -> (a -> MockSqlQueryT m b) -> MockSqlQueryT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (MockSqlQueryT m)
Monad
    , Monad (MockSqlQueryT m)
Monad (MockSqlQueryT m)
-> (forall a. IO a -> MockSqlQueryT m a)
-> MonadIO (MockSqlQueryT m)
IO a -> MockSqlQueryT m a
forall a. IO a -> MockSqlQueryT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (MockSqlQueryT m)
forall (m :: * -> *) a. MonadIO m => IO a -> MockSqlQueryT m a
liftIO :: IO a -> MockSqlQueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MockSqlQueryT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (MockSqlQueryT m)
MonadIO
    , MonadIO (MockSqlQueryT m)
MonadIO (MockSqlQueryT m)
-> (forall a. ResourceT IO a -> MockSqlQueryT m a)
-> MonadResource (MockSqlQueryT m)
ResourceT IO a -> MockSqlQueryT m a
forall a. ResourceT IO a -> MockSqlQueryT m a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
forall (m :: * -> *). MonadResource m => MonadIO (MockSqlQueryT m)
forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> MockSqlQueryT m a
liftResourceT :: ResourceT IO a -> MockSqlQueryT m a
$cliftResourceT :: forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> MockSqlQueryT m a
$cp1MonadResource :: forall (m :: * -> *). MonadResource m => MonadIO (MockSqlQueryT m)
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 :: MockSqlQueryT m a -> [MockQuery] -> m a
runMockSqlQueryT MockSqlQueryT m a
action [MockQuery]
mockQueries = (ReaderT [MockQuery] m a -> [MockQuery] -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` [MockQuery]
mockQueries) (ReaderT [MockQuery] m a -> m a)
-> (MockSqlQueryT m a -> ReaderT [MockQuery] m a)
-> MockSqlQueryT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockSqlQueryT m a -> ReaderT [MockQuery] m a
forall (m :: * -> *) a.
MockSqlQueryT m a -> ReaderT [MockQuery] m a
unMockSqlQueryT (MockSqlQueryT m a -> m a) -> MockSqlQueryT m a -> m a
forall a b. (a -> b) -> a -> b
$ MockSqlQueryT m a
action

instance MonadIO m => MonadSqlQuery (MockSqlQueryT m) where
  type TransactionM (MockSqlQueryT m) = MockSqlQueryT m

  runQueryRep :: SqlQueryRep record a -> MockSqlQueryT m a
runQueryRep SqlQueryRep record a
rep = do
    [MockQuery]
mockQueries <- ReaderT [MockQuery] m [MockQuery] -> MockSqlQueryT m [MockQuery]
forall (m :: * -> *) a.
ReaderT [MockQuery] m a -> MockSqlQueryT m a
MockSqlQueryT ReaderT [MockQuery] m [MockQuery]
forall r (m :: * -> *). MonadReader r m => m r
ask
    MockSqlQueryT m a
-> (IO a -> MockSqlQueryT m a) -> Maybe (IO a) -> MockSqlQueryT m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> MockSqlQueryT m a
forall a. HasCallStack => [Char] -> a
error ([Char] -> MockSqlQueryT m a) -> [Char] -> MockSqlQueryT m a
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not find mock for query: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SqlQueryRep record a -> [Char]
forall a. Show a => a -> [Char]
show SqlQueryRep record a
rep) IO a -> MockSqlQueryT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
      (Maybe (IO a) -> MockSqlQueryT m a)
-> Maybe (IO a) -> MockSqlQueryT m a
forall a b. (a -> b) -> a -> b
$ [Maybe (IO a)] -> Maybe (IO a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe (IO a)] -> Maybe (IO a)) -> [Maybe (IO a)] -> Maybe (IO a)
forall a b. (a -> b) -> a -> b
$ (MockQuery -> Maybe (IO a)) -> [MockQuery] -> [Maybe (IO a)]
forall a b. (a -> b) -> [a] -> [b]
map MockQuery -> Maybe (IO a)
tryMockQuery [MockQuery]
mockQueries
    where
      tryMockQuery :: MockQuery -> Maybe (IO a)
tryMockQuery (MockQuery forall record a.
Typeable record =>
SqlQueryRep record a -> Maybe (IO a)
f) = SqlQueryRep record a -> Maybe (IO a)
forall record a.
Typeable record =>
SqlQueryRep record a -> Maybe (IO a)
f SqlQueryRep record a
rep

  withTransaction :: TransactionM (MockSqlQueryT m) a -> MockSqlQueryT m a
withTransaction = TransactionM (MockSqlQueryT m) a -> MockSqlQueryT m a
forall a. a -> a
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 :: (forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
withRecord forall a. SqlQueryRep record a -> Maybe a
f = (forall record a.
 Typeable record =>
 SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
MockQuery ((forall record a.
  Typeable record =>
  SqlQueryRep record a -> Maybe (IO a))
 -> MockQuery)
-> (forall record a.
    Typeable record =>
    SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
forall a b. (a -> b) -> a -> b
$ \(SqlQueryRep record a
rep :: SqlQueryRep someRecord result) ->
  case (Typeable record, Typeable record) => Maybe (record :~: record)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @record @someRecord of
    Just record :~: record
Refl -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> Maybe a -> Maybe (IO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQueryRep record a -> Maybe a
forall a. SqlQueryRep record a -> Maybe a
f SqlQueryRep record a
SqlQueryRep record a
rep
    Maybe (record :~: record)
Nothing -> Maybe (IO a)
forall a. Maybe a
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 :: (forall record a.
 Typeable record =>
 SqlQueryRep record a -> Maybe a)
-> MockQuery
mockQuery forall record a. Typeable record => SqlQueryRep record a -> Maybe a
f = (forall record a.
 Typeable record =>
 SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
MockQuery ((a -> IO a) -> Maybe a -> Maybe (IO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Maybe (IO a))
-> (SqlQueryRep record a -> Maybe a)
-> SqlQueryRep record a
-> Maybe (IO a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQueryRep record a -> Maybe a
forall record a. Typeable record => SqlQueryRep record a -> Maybe a
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 :: ([Filter record] -> [SelectOpt record] -> Maybe [Entity record])
-> MockQuery
mockSelectSource [Filter record] -> [SelectOpt record] -> Maybe [Entity record]
f = Typeable record =>
(forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
forall record.
Typeable record =>
(forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
withRecord @record ((forall a. SqlQueryRep record a -> Maybe a) -> MockQuery)
-> (forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
forall a b. (a -> b) -> a -> b
$ \case
  SelectSourceRes [Filter record]
filters [SelectOpt record]
opts ->
    let toAcquire :: mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire mono
entities = IO (ConduitT i (Element mono) m ())
-> (ConduitT i (Element mono) m () -> IO ())
-> Acquire (ConduitT i (Element mono) m ())
forall a. IO a -> (a -> IO ()) -> Acquire a
Acquire.mkAcquire (ConduitT i (Element mono) m ()
-> IO (ConduitT i (Element mono) m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConduitT i (Element mono) m ()
 -> IO (ConduitT i (Element mono) m ()))
-> ConduitT i (Element mono) m ()
-> IO (ConduitT i (Element mono) m ())
forall a b. (a -> b) -> a -> b
$ mono -> ConduitT i (Element mono) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
Conduit.yieldMany mono
entities) (\ConduitT i (Element mono) m ()
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    in [Entity record] -> a
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire ([Entity record] -> a) -> Maybe [Entity record] -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter record] -> [SelectOpt record] -> Maybe [Entity record]
f [Filter record]
filters [SelectOpt record]
opts
  SqlQueryRep record a
_ -> Maybe a
forall a. Maybe a
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 :: ([Filter record] -> [SelectOpt record] -> Maybe [Key record])
-> MockQuery
mockSelectKeys [Filter record] -> [SelectOpt record] -> Maybe [Key record]
f = Typeable record =>
(forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
forall record.
Typeable record =>
(forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
withRecord @record ((forall a. SqlQueryRep record a -> Maybe a) -> MockQuery)
-> (forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
forall a b. (a -> b) -> a -> b
$ \case
  SelectKeysRes [Filter record]
filters [SelectOpt record]
opts ->
    let toAcquire :: mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire mono
keys = IO (ConduitT i (Element mono) m ())
-> (ConduitT i (Element mono) m () -> IO ())
-> Acquire (ConduitT i (Element mono) m ())
forall a. IO a -> (a -> IO ()) -> Acquire a
Acquire.mkAcquire (ConduitT i (Element mono) m ()
-> IO (ConduitT i (Element mono) m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConduitT i (Element mono) m ()
 -> IO (ConduitT i (Element mono) m ()))
-> ConduitT i (Element mono) m ()
-> IO (ConduitT i (Element mono) m ())
forall a b. (a -> b) -> a -> b
$ mono -> ConduitT i (Element mono) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
Conduit.yieldMany mono
keys) (\ConduitT i (Element mono) m ()
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    in [Key record] -> a
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire ([Key record] -> a) -> Maybe [Key record] -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter record] -> [SelectOpt record] -> Maybe [Key record]
f [Filter record]
filters [SelectOpt record]
opts
  SqlQueryRep record a
_ -> Maybe a
forall a. Maybe a
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 :: (Text -> [PersistValue] -> Maybe [[PersistValue]]) -> MockQuery
mockWithRawQuery Text -> [PersistValue] -> Maybe [[PersistValue]]
f = (forall record a.
 Typeable record =>
 SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
MockQuery ((forall record a.
  Typeable record =>
  SqlQueryRep record a -> Maybe (IO a))
 -> MockQuery)
-> (forall record a.
    Typeable record =>
    SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
forall a b. (a -> b) -> a -> b
$ \case
  WithRawQuery Text
sql [PersistValue]
vals ConduitM [PersistValue] Void IO a
conduit ->
    let outputRows :: [[PersistValue]] -> IO a
outputRows [[PersistValue]]
rows = ConduitT () Void IO a -> IO a
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
Conduit.runConduit (ConduitT () Void IO a -> IO a) -> ConduitT () Void IO a -> IO a
forall a b. (a -> b) -> a -> b
$ [[PersistValue]] -> ConduitT () (Element [[PersistValue]]) IO ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
Conduit.yieldMany [[PersistValue]]
rows ConduitT () [PersistValue] IO ()
-> ConduitM [PersistValue] Void IO a -> ConduitT () Void IO a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM [PersistValue] Void IO a
conduit
    in [[PersistValue]] -> IO a
outputRows ([[PersistValue]] -> IO a)
-> Maybe [[PersistValue]] -> Maybe (IO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [PersistValue] -> Maybe [[PersistValue]]
f Text
sql [PersistValue]
vals
  SqlQueryRep record a
_ -> Maybe (IO a)
forall a. Maybe a
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 :: (Text -> [PersistValue] -> Maybe [[PersistValue]]) -> MockQuery
mockRawQuery Text -> [PersistValue] -> Maybe [[PersistValue]]
f = (forall record a.
 Typeable record =>
 SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
MockQuery ((forall record a.
  Typeable record =>
  SqlQueryRep record a -> Maybe (IO a))
 -> MockQuery)
-> (forall record a.
    Typeable record =>
    SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
forall a b. (a -> b) -> a -> b
$ \case
  RawQueryRes Text
sql [PersistValue]
vals ->
    let toAcquire :: mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire mono
rows = IO (ConduitT i (Element mono) m ())
-> (ConduitT i (Element mono) m () -> IO ())
-> Acquire (ConduitT i (Element mono) m ())
forall a. IO a -> (a -> IO ()) -> Acquire a
Acquire.mkAcquire (ConduitT i (Element mono) m ()
-> IO (ConduitT i (Element mono) m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConduitT i (Element mono) m ()
 -> IO (ConduitT i (Element mono) m ()))
-> ConduitT i (Element mono) m ()
-> IO (ConduitT i (Element mono) m ())
forall a b. (a -> b) -> a -> b
$ mono -> ConduitT i (Element mono) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
Conduit.yieldMany mono
rows) (\ConduitT i (Element mono) m ()
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    in a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> ([[PersistValue]] -> a) -> [[PersistValue]] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[PersistValue]] -> a
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire ([[PersistValue]] -> IO a)
-> Maybe [[PersistValue]] -> Maybe (IO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [PersistValue] -> Maybe [[PersistValue]]
f Text
sql [PersistValue]
vals
  SqlQueryRep record a
_ -> Maybe (IO a)
forall a. Maybe a
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 :: (Text -> [PersistValue] -> Maybe [[PersistValue]]) -> MockQuery
mockRawSql Text -> [PersistValue] -> Maybe [[PersistValue]]
f = (forall record a.
 Typeable record =>
 SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
MockQuery ((forall record a.
  Typeable record =>
  SqlQueryRep record a -> Maybe (IO a))
 -> MockQuery)
-> (forall record a.
    Typeable record =>
    SqlQueryRep record a -> Maybe (IO a))
-> MockQuery
forall a b. (a -> b) -> a -> b
$ \case
  RawSql Text
sql [PersistValue]
vals ->
    let fromRow :: [PersistValue] -> a
fromRow = (Text -> a) -> (a -> a) -> Either Text a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> (Text -> [Char]) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack) a -> a
forall a. a -> a
id (Either Text a -> a)
-> ([PersistValue] -> Either Text a) -> [PersistValue] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text a
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow
    in [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> IO [a])
-> ([[PersistValue]] -> [a]) -> [[PersistValue]] -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PersistValue] -> a) -> [[PersistValue]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [PersistValue] -> a
fromRow ([[PersistValue]] -> IO [a])
-> Maybe [[PersistValue]] -> Maybe (IO [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [PersistValue] -> Maybe [[PersistValue]]
f Text
sql [PersistValue]
vals
  SqlQueryRep record a
_ -> Maybe (IO a)
forall a. Maybe a
Nothing