{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Test.MockCat.WithMock
( withMock
, expects
, called
, with
, calledInOrder
, calledInSequence
, times
, once
, never
, atLeast
, anything
, WithMockContext(..)
, MonadWithMockContext(..)
, Expectation(..)
, Expectations(..)
) where
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT(..), runReaderT, MonadReader(..), ask)
import Control.Concurrent.STM (TVar, newTVarIO, readTVarIO, modifyTVar', atomically)
import Control.Monad.State (State, get, put, modify, execState)
import Test.MockCat.Verify
( ResolvableParamsOf
, ResolvableMock
, requireResolved
, verifyCount
, verifyOrder
, verifyResolvedAny
, verifyCallCount
, ResolvedMock(..)
, TimesSpec(..)
, times
, once
, never
, atLeast
, anything
)
import Test.MockCat.Internal.Types
( CountVerifyMethod(..)
, VerifyOrderMethod(..)
)
import Test.MockCat.Param (Param(..), param)
import Data.Kind (Type)
import Data.Proxy (Proxy(..))
newtype WithMockContext = WithMockContext (TVar [IO ()])
class MonadWithMockContext m where
askWithMockContext :: m WithMockContext
instance {-# OVERLAPPABLE #-} (MonadReader WithMockContext m) => MonadWithMockContext m where
askWithMockContext :: m WithMockContext
askWithMockContext = m WithMockContext
forall r (m :: * -> *). MonadReader r m => m r
ask
data Expectation params where
CountExpectation :: CountVerifyMethod -> params -> Expectation params
CountAnyExpectation :: CountVerifyMethod -> Expectation params
OrderExpectation :: VerifyOrderMethod -> [params] -> Expectation params
SimpleExpectation :: params -> Expectation params
AnyExpectation :: Expectation params
newtype Expectations params a = Expectations (State [Expectation params] a)
deriving ((forall a b.
(a -> b) -> Expectations params a -> Expectations params b)
-> (forall a b.
a -> Expectations params b -> Expectations params a)
-> Functor (Expectations params)
forall a b. a -> Expectations params b -> Expectations params a
forall a b.
(a -> b) -> Expectations params a -> Expectations params b
forall params a b.
a -> Expectations params b -> Expectations params a
forall params a b.
(a -> b) -> Expectations params a -> Expectations params b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall params a b.
(a -> b) -> Expectations params a -> Expectations params b
fmap :: forall a b.
(a -> b) -> Expectations params a -> Expectations params b
$c<$ :: forall params a b.
a -> Expectations params b -> Expectations params a
<$ :: forall a b. a -> Expectations params b -> Expectations params a
Functor, Functor (Expectations params)
Functor (Expectations params) =>
(forall a. a -> Expectations params a)
-> (forall a b.
Expectations params (a -> b)
-> Expectations params a -> Expectations params b)
-> (forall a b c.
(a -> b -> c)
-> Expectations params a
-> Expectations params b
-> Expectations params c)
-> (forall a b.
Expectations params a
-> Expectations params b -> Expectations params b)
-> (forall a b.
Expectations params a
-> Expectations params b -> Expectations params a)
-> Applicative (Expectations params)
forall params. Functor (Expectations params)
forall a. a -> Expectations params a
forall params a. a -> Expectations params a
forall a b.
Expectations params a
-> Expectations params b -> Expectations params a
forall a b.
Expectations params a
-> Expectations params b -> Expectations params b
forall a b.
Expectations params (a -> b)
-> Expectations params a -> Expectations params b
forall params a b.
Expectations params a
-> Expectations params b -> Expectations params a
forall params a b.
Expectations params a
-> Expectations params b -> Expectations params b
forall params a b.
Expectations params (a -> b)
-> Expectations params a -> Expectations params b
forall a b c.
(a -> b -> c)
-> Expectations params a
-> Expectations params b
-> Expectations params c
forall params a b c.
(a -> b -> c)
-> Expectations params a
-> Expectations params b
-> Expectations params 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
$cpure :: forall params a. a -> Expectations params a
pure :: forall a. a -> Expectations params a
$c<*> :: forall params a b.
Expectations params (a -> b)
-> Expectations params a -> Expectations params b
<*> :: forall a b.
Expectations params (a -> b)
-> Expectations params a -> Expectations params b
$cliftA2 :: forall params a b c.
(a -> b -> c)
-> Expectations params a
-> Expectations params b
-> Expectations params c
liftA2 :: forall a b c.
(a -> b -> c)
-> Expectations params a
-> Expectations params b
-> Expectations params c
$c*> :: forall params a b.
Expectations params a
-> Expectations params b -> Expectations params b
*> :: forall a b.
Expectations params a
-> Expectations params b -> Expectations params b
$c<* :: forall params a b.
Expectations params a
-> Expectations params b -> Expectations params a
<* :: forall a b.
Expectations params a
-> Expectations params b -> Expectations params a
Applicative, Applicative (Expectations params)
Applicative (Expectations params) =>
(forall a b.
Expectations params a
-> (a -> Expectations params b) -> Expectations params b)
-> (forall a b.
Expectations params a
-> Expectations params b -> Expectations params b)
-> (forall a. a -> Expectations params a)
-> Monad (Expectations params)
forall params. Applicative (Expectations params)
forall a. a -> Expectations params a
forall params a. a -> Expectations params a
forall a b.
Expectations params a
-> Expectations params b -> Expectations params b
forall a b.
Expectations params a
-> (a -> Expectations params b) -> Expectations params b
forall params a b.
Expectations params a
-> Expectations params b -> Expectations params b
forall params a b.
Expectations params a
-> (a -> Expectations params b) -> Expectations params 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
$c>>= :: forall params a b.
Expectations params a
-> (a -> Expectations params b) -> Expectations params b
>>= :: forall a b.
Expectations params a
-> (a -> Expectations params b) -> Expectations params b
$c>> :: forall params a b.
Expectations params a
-> Expectations params b -> Expectations params b
>> :: forall a b.
Expectations params a
-> Expectations params b -> Expectations params b
$creturn :: forall params a. a -> Expectations params a
return :: forall a. a -> Expectations params a
Monad)
runExpectations :: Expectations params a -> [Expectation params]
runExpectations :: forall params a. Expectations params a -> [Expectation params]
runExpectations (Expectations State [Expectation params] a
s) = State [Expectation params] a
-> [Expectation params] -> [Expectation params]
forall s a. State s a -> s -> s
execState State [Expectation params] a
s []
addExpectation :: Expectation params -> Expectations params ()
addExpectation :: forall params. Expectation params -> Expectations params ()
addExpectation Expectation params
exp = State [Expectation params] () -> Expectations params ()
forall params a.
State [Expectation params] a -> Expectations params a
Expectations (State [Expectation params] () -> Expectations params ())
-> State [Expectation params] () -> Expectations params ()
forall a b. (a -> b) -> a -> b
$ ([Expectation params] -> [Expectation params])
-> State [Expectation params] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Expectation params]
-> [Expectation params] -> [Expectation params]
forall a. [a] -> [a] -> [a]
++ [Expectation params
exp])
withMock :: ReaderT WithMockContext IO a -> IO a
withMock :: forall a. ReaderT WithMockContext IO a -> IO a
withMock ReaderT WithMockContext IO a
action = do
TVar [IO ()]
ctxVar <- [IO ()] -> IO (TVar [IO ()])
forall a. a -> IO (TVar a)
newTVarIO []
let ctx :: WithMockContext
ctx = TVar [IO ()] -> WithMockContext
WithMockContext TVar [IO ()]
ctxVar
a
result <- ReaderT WithMockContext IO a -> WithMockContext -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT WithMockContext IO a
action WithMockContext
ctx
[IO ()]
actions <- TVar [IO ()] -> IO [IO ()]
forall a. TVar a -> IO a
readTVarIO TVar [IO ()]
ctxVar
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [IO ()]
actions
a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
verifyExpectation ::
( ResolvableMock m
, ResolvableParamsOf m ~ params
, Show params
, Eq params
) =>
m ->
Expectation params ->
IO ()
verifyExpectation :: forall m params.
(ResolvableMock m, ResolvableParamsOf m ~ params, Show params,
Eq params) =>
m -> Expectation params -> IO ()
verifyExpectation m
mockFn Expectation params
expectation = do
ResolvedMock params
resolved <- m -> IO (ResolvedMock params)
forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
Typeable (InvocationRecorder params)) =>
target -> IO (ResolvedMock params)
requireResolved m
mockFn
case Expectation params
expectation of
CountExpectation CountVerifyMethod
method params
args ->
m -> ResolvableParamsOf m -> CountVerifyMethod -> IO ()
forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m)) =>
m -> ResolvableParamsOf m -> CountVerifyMethod -> IO ()
verifyCount m
mockFn params
ResolvableParamsOf m
args CountVerifyMethod
method
CountAnyExpectation CountVerifyMethod
count ->
Maybe MockName
-> InvocationRecorder params -> CountVerifyMethod -> IO ()
forall params.
Maybe MockName
-> InvocationRecorder params -> CountVerifyMethod -> IO ()
verifyCallCount (ResolvedMock params -> Maybe MockName
forall params. ResolvedMock params -> Maybe MockName
resolvedMockName ResolvedMock params
resolved) (ResolvedMock params -> InvocationRecorder params
forall params. ResolvedMock params -> InvocationRecorder params
resolvedMockRecorder ResolvedMock params
resolved) CountVerifyMethod
count
OrderExpectation VerifyOrderMethod
method [params]
argsList ->
VerifyOrderMethod -> m -> [ResolvableParamsOf m] -> IO ()
forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m),
Show (ResolvableParamsOf m)) =>
VerifyOrderMethod -> m -> [ResolvableParamsOf m] -> IO ()
verifyOrder VerifyOrderMethod
method m
mockFn [params]
[ResolvableParamsOf m]
argsList
SimpleExpectation params
_ ->
ResolvedMock params -> IO ()
forall params. ResolvedMock params -> IO ()
verifyResolvedAny ResolvedMock params
resolved
Expectation params
AnyExpectation ->
ResolvedMock params -> IO ()
forall params. ResolvedMock params -> IO ()
verifyResolvedAny ResolvedMock params
resolved
infixl 0 `expects`
class exp where
type ExpParams exp :: Type
:: exp -> Proxy (ExpParams exp)
instance ExtractParams (Expectations params ()) where
type ExpParams (Expectations params ()) = params
extractParams :: Expectations params ()
-> Proxy (ExpParams (Expectations params ()))
extractParams Expectations params ()
_ = Proxy params
Proxy (ExpParams (Expectations params ()))
forall {k} (t :: k). Proxy t
Proxy
instance ExtractParams (fn -> Expectations params ()) where
type ExpParams (fn -> Expectations params ()) = params
extractParams :: (fn -> Expectations params ())
-> Proxy (ExpParams (fn -> Expectations params ()))
extractParams fn -> Expectations params ()
_ = Proxy params
Proxy (ExpParams (fn -> Expectations params ()))
forall {k} (t :: k). Proxy t
Proxy
class BuildExpectations fn exp where
buildExpectations :: fn -> exp -> [Expectation (ResolvableParamsOf fn)]
instance forall fn params. (ResolvableParamsOf fn ~ params) => BuildExpectations fn (Expectations params ()) where
buildExpectations :: fn
-> Expectations params () -> [Expectation (ResolvableParamsOf fn)]
buildExpectations fn
_ = Expectations params () -> [Expectation params]
Expectations params () -> [Expectation (ResolvableParamsOf fn)]
forall params a. Expectations params a -> [Expectation params]
runExpectations
instance forall fn params. (ResolvableParamsOf fn ~ params) => BuildExpectations fn (fn -> Expectations params ()) where
buildExpectations :: fn
-> (fn -> Expectations params ())
-> [Expectation (ResolvableParamsOf fn)]
buildExpectations fn
fn fn -> Expectations params ()
f = Expectations params () -> [Expectation params]
forall params a. Expectations params a -> [Expectation params]
runExpectations (fn -> Expectations params ()
f fn
fn)
expects ::
forall m fn exp params.
( MonadIO m
, MonadWithMockContext m
, ResolvableMock fn
, ResolvableParamsOf fn ~ params
, ExtractParams exp
, ExpParams exp ~ params
, BuildExpectations fn exp
, Show params
, Eq params
) =>
m fn ->
exp ->
m fn
expects :: forall (m :: * -> *) fn exp params.
(MonadIO m, MonadWithMockContext m, ResolvableMock fn,
ResolvableParamsOf fn ~ params, ExtractParams exp,
ExpParams exp ~ params, BuildExpectations fn exp, Show params,
Eq params) =>
m fn -> exp -> m fn
expects m fn
mockFnM exp
exp = do
(WithMockContext TVar [IO ()]
ctxVar) <- m WithMockContext
forall (m :: * -> *). MonadWithMockContext m => m WithMockContext
askWithMockContext
let Proxy params
_ = exp -> Proxy (ExpParams exp)
forall exp. ExtractParams exp => exp -> Proxy (ExpParams exp)
extractParams exp
exp :: Proxy params
fn
mockFn <- m fn
mockFnM
let expectations :: [Expectation (ResolvableParamsOf fn)]
expectations = fn -> exp -> [Expectation (ResolvableParamsOf fn)]
forall fn exp.
BuildExpectations fn exp =>
fn -> exp -> [Expectation (ResolvableParamsOf fn)]
buildExpectations fn
mockFn exp
exp
let actions :: [IO ()]
actions = (Expectation params -> IO ()) -> [Expectation params] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map (fn -> Expectation params -> IO ()
forall m params.
(ResolvableMock m, ResolvableParamsOf m ~ params, Show params,
Eq params) =>
m -> Expectation params -> IO ()
verifyExpectation fn
mockFn) [Expectation params]
[Expectation (ResolvableParamsOf fn)]
expectations
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [IO ()] -> ([IO ()] -> [IO ()]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [IO ()]
ctxVar ([IO ()] -> [IO ()] -> [IO ()]
forall a. [a] -> [a] -> [a]
++ [IO ()]
actions)
fn -> m fn
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure fn
mockFn
class Called params where
called :: TimesSpec -> Expectations params ()
instance {-# OVERLAPPABLE #-} Called params where
called :: TimesSpec -> Expectations params ()
called (TimesSpec CountVerifyMethod
method) = do
Expectation params -> Expectations params ()
forall params. Expectation params -> Expectations params ()
addExpectation (CountVerifyMethod -> Expectation params
forall params. CountVerifyMethod -> Expectation params
CountAnyExpectation CountVerifyMethod
method)
class WithArgs exp args params | exp args -> params where
with :: exp -> args -> Expectations params ()
instance {-# OVERLAPPING #-}
WithArgs (Expectations params ()) params params
where
with :: Expectations params () -> params -> Expectations params ()
with Expectations params ()
expM params
args = do
Expectations params ()
expM
State [Expectation params] () -> Expectations params ()
forall params a.
State [Expectation params] a -> Expectations params a
Expectations (State [Expectation params] () -> Expectations params ())
-> State [Expectation params] () -> Expectations params ()
forall a b. (a -> b) -> a -> b
$ do
[Expectation params]
exps <- StateT [Expectation params] Identity [Expectation params]
forall s (m :: * -> *). MonadState s m => m s
get
case [Expectation params] -> [Expectation params]
forall a. [a] -> [a]
reverse [Expectation params]
exps of
[] -> MockName -> State [Expectation params] ()
forall a. HasCallStack => MockName -> a
error MockName
"with: no expectation to add arguments to"
(CountAnyExpectation CountVerifyMethod
method : [Expectation params]
rest) -> do
[Expectation params] -> State [Expectation params] ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Expectation params] -> [Expectation params]
forall a. [a] -> [a]
reverse [Expectation params]
rest)
([Expectation params] -> [Expectation params])
-> State [Expectation params] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Expectation params]
-> [Expectation params] -> [Expectation params]
forall a. [a] -> [a] -> [a]
++ [CountVerifyMethod -> params -> Expectation params
forall params. CountVerifyMethod -> params -> Expectation params
CountExpectation CountVerifyMethod
method params
args])
[Expectation params]
_ -> MockName -> State [Expectation params] ()
forall a. HasCallStack => MockName -> a
error MockName
"with: can only add arguments to count-only expectations"
instance {-# OVERLAPPABLE #-}
(params ~ Param a, Show a, Eq a) =>
WithArgs (Expectations params ()) a params
where
with :: Expectations params () -> a -> Expectations params ()
with Expectations params ()
expM a
rawValue = do
Expectations params ()
expM
State [Expectation params] () -> Expectations params ()
forall params a.
State [Expectation params] a -> Expectations params a
Expectations (State [Expectation params] () -> Expectations params ())
-> State [Expectation params] () -> Expectations params ()
forall a b. (a -> b) -> a -> b
$ do
[Expectation (Param a)]
exps <- StateT [Expectation params] Identity [Expectation (Param a)]
forall s (m :: * -> *). MonadState s m => m s
get
case [Expectation (Param a)] -> [Expectation (Param a)]
forall a. [a] -> [a]
reverse [Expectation (Param a)]
exps of
[] -> MockName -> State [Expectation params] ()
forall a. HasCallStack => MockName -> a
error MockName
"with: no expectation to add arguments to"
(CountAnyExpectation CountVerifyMethod
method : [Expectation (Param a)]
rest) -> do
[Expectation (Param a)] -> State [Expectation params] ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Expectation (Param a)] -> [Expectation (Param a)]
forall a. [a] -> [a]
reverse [Expectation (Param a)]
rest)
([Expectation (Param a)] -> [Expectation (Param a)])
-> State [Expectation params] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Expectation (Param a)]
-> [Expectation (Param a)] -> [Expectation (Param a)]
forall a. [a] -> [a] -> [a]
++ [CountVerifyMethod -> Param a -> Expectation (Param a)
forall params. CountVerifyMethod -> params -> Expectation params
CountExpectation CountVerifyMethod
method (a -> Param a
forall v. (Show v, Eq v) => v -> Param v
param a
rawValue)])
[Expectation (Param a)]
_ -> MockName -> State [Expectation params] ()
forall a. HasCallStack => MockName -> a
error MockName
"with: can only add arguments to count-only expectations"
class CalledInOrder args params | args -> params where
calledInOrder :: args -> Expectations params ()
instance
(params ~ Param a, Show a, Eq a) =>
CalledInOrder [a] params
where
calledInOrder :: [a] -> Expectations params ()
calledInOrder [a]
args =
Expectation params -> Expectations params ()
forall params. Expectation params -> Expectations params ()
addExpectation (VerifyOrderMethod -> [params] -> Expectation params
forall params. VerifyOrderMethod -> [params] -> Expectation params
OrderExpectation VerifyOrderMethod
ExactlySequence ((a -> params) -> [a] -> [params]
forall a b. (a -> b) -> [a] -> [b]
map a -> params
a -> Param a
forall v. (Show v, Eq v) => v -> Param v
param [a]
args))
class CalledInSequence args params | args -> params where
calledInSequence :: args -> Expectations params ()
instance
(params ~ Param a, Show a, Eq a) =>
CalledInSequence [a] params
where
calledInSequence :: [a] -> Expectations params ()
calledInSequence [a]
args =
Expectation params -> Expectations params ()
forall params. Expectation params -> Expectations params ()
addExpectation (VerifyOrderMethod -> [params] -> Expectation params
forall params. VerifyOrderMethod -> [params] -> Expectation params
OrderExpectation VerifyOrderMethod
PartiallySequence ((a -> params) -> [a] -> [params]
forall a b. (a -> b) -> [a] -> [b]
map a -> params
a -> Param a
forall v. (Show v, Eq v) => v -> Param v
param [a]
args))