{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Database.Persist.Monad.TestUtils (
MockSqlQueryT,
runMockSqlQueryT,
withRecord,
mockQuery,
MockQuery,
mockSelectSource,
mockSelectKeys,
mockWithRawQuery,
mockRawQuery,
mockRawSql,
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 (..))
newtype MockSqlQueryT m a = MockSqlQueryT
{ forall (m :: * -> *) a.
MockSqlQueryT m a -> ReaderT [MockQuery] m a
unMockSqlQueryT :: ReaderT [MockQuery] m a
}
deriving
( 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
<$ :: forall a b. a -> MockSqlQueryT m b -> MockSqlQueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MockSqlQueryT m b -> MockSqlQueryT m a
fmap :: forall a b. (a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockSqlQueryT m a -> MockSqlQueryT m b
Functor
, 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
<* :: forall a b.
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
*> :: forall a b.
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 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> MockSqlQueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MockSqlQueryT m a
Applicative
, 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 :: forall a. a -> MockSqlQueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MockSqlQueryT m a
>> :: forall a b.
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
>>= :: forall a 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
Monad
, 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 :: forall a. IO a -> MockSqlQueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MockSqlQueryT m a
MonadIO
, 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 :: forall a. ResourceT IO a -> MockSqlQueryT m a
$cliftResourceT :: forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> MockSqlQueryT m a
MonadResource
)
runMockSqlQueryT :: MockSqlQueryT m a -> [MockQuery] -> m a
runMockSqlQueryT :: forall (m :: * -> *) a. MockSqlQueryT m a -> [MockQuery] -> m a
runMockSqlQueryT MockSqlQueryT m a
action [MockQuery]
mockQueries = (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` [MockQuery]
mockQueries) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MockSqlQueryT m a -> ReaderT [MockQuery] m a
unMockSqlQueryT 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 :: forall record a.
Typeable record =>
SqlQueryRep record a -> MockSqlQueryT m a
runQueryRep SqlQueryRep record a
rep = do
[MockQuery]
mockQueries <- forall (m :: * -> *) a.
ReaderT [MockQuery] m a -> MockSqlQueryT m a
MockSqlQueryT forall r (m :: * -> *). MonadReader r m => m r
ask
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Could not find mock for query: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SqlQueryRep record a
rep) forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$
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) = forall record a.
Typeable record =>
SqlQueryRep record a -> Maybe (IO a)
f SqlQueryRep record a
rep
withTransaction :: forall a. TransactionM (MockSqlQueryT m) a -> MockSqlQueryT m a
withTransaction = forall a. a -> a
id
data MockQuery = MockQuery (forall record a. (Typeable record) => SqlQueryRep record a -> Maybe (IO a))
withRecord :: forall record. (Typeable record) => (forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
withRecord :: forall record.
Typeable record =>
(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 a b. (a -> b) -> a -> b
$ \(SqlQueryRep record a
rep :: SqlQueryRep someRecord result) ->
case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @record @someRecord of
Just record :~: record
Refl -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SqlQueryRep record a -> Maybe a
f SqlQueryRep record a
rep
Maybe (record :~: record)
Nothing -> forall a. Maybe a
Nothing
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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record a. Typeable record => SqlQueryRep record a -> Maybe a
f)
mockSelectSource :: forall record. (Typeable record) => ([Filter record] -> [SelectOpt record] -> Maybe [Entity record]) -> MockQuery
mockSelectSource :: forall record.
Typeable record =>
([Filter record] -> [SelectOpt record] -> Maybe [Entity record])
-> MockQuery
mockSelectSource [Filter record] -> [SelectOpt record] -> Maybe [Entity record]
f = forall record.
Typeable record =>
(forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
withRecord @record 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 = forall a. IO a -> (a -> IO ()) -> Acquire a
Acquire.mkAcquire (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
Conduit.yieldMany mono
entities) (\ConduitT i (Element mono) m ()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
in forall {m :: * -> *} {mono} {i}.
(Monad m, MonoFoldable mono) =>
mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire 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
_ -> forall a. Maybe a
Nothing
mockSelectKeys :: forall record. (Typeable record) => ([Filter record] -> [SelectOpt record] -> Maybe [Key record]) -> MockQuery
mockSelectKeys :: forall record.
Typeable record =>
([Filter record] -> [SelectOpt record] -> Maybe [Key record])
-> MockQuery
mockSelectKeys [Filter record] -> [SelectOpt record] -> Maybe [Key record]
f = forall record.
Typeable record =>
(forall a. SqlQueryRep record a -> Maybe a) -> MockQuery
withRecord @record 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 = forall a. IO a -> (a -> IO ()) -> Acquire a
Acquire.mkAcquire (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
Conduit.yieldMany mono
keys) (\ConduitT i (Element mono) m ()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
in forall {m :: * -> *} {mono} {i}.
(Monad m, MonoFoldable mono) =>
mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire 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
_ -> forall a. Maybe a
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 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 = forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
Conduit.runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
Conduit.yieldMany [[PersistValue]]
rows forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM [PersistValue] Void IO a
conduit
in [[PersistValue]] -> IO a
outputRows forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [PersistValue] -> Maybe [[PersistValue]]
f Text
sql [PersistValue]
vals
SqlQueryRep record a
_ -> forall a. Maybe a
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 a b. (a -> b) -> a -> b
$ \case
RawQueryRes Text
sql [PersistValue]
vals ->
let toAcquire :: mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire mono
rows = forall a. IO a -> (a -> IO ()) -> Acquire a
Acquire.mkAcquire (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
Conduit.yieldMany mono
rows) (\ConduitT i (Element mono) m ()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *} {mono} {i}.
(Monad m, MonoFoldable mono) =>
mono -> Acquire (ConduitT i (Element mono) m ())
toAcquire forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [PersistValue] -> Maybe [[PersistValue]]
f Text
sql [PersistValue]
vals
SqlQueryRep record a
_ -> forall a. Maybe a
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 a b. (a -> b) -> a -> b
$ \case
RawSql Text
sql [PersistValue]
vals ->
let fromRow :: [PersistValue] -> a
fromRow = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow
in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [PersistValue] -> a
fromRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [PersistValue] -> Maybe [[PersistValue]]
f Text
sql [PersistValue]
vals
SqlQueryRep record a
_ -> forall a. Maybe a
Nothing