{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Test.HMock.MockT
( MockT,
runMockT,
withMockT,
nestMockT,
withNestedMockT,
Severity (..),
setAmbiguityCheck,
setUninterestingActionCheck,
setUnexpectedActionCheck,
setUnmetExpectationCheck,
describeExpectations,
verifyExpectations,
MockSetup,
MockContext,
allowUnexpected,
byDefault,
whenever,
)
where
import Control.Monad (join)
import Control.Monad.Reader
( MonadReader (..),
runReaderT,
)
import Control.Monad.Trans (lift)
import Data.List (intercalate)
import Data.Maybe (listToMaybe)
import Data.Proxy (Proxy (Proxy))
import GHC.Stack (callStack)
import Test.HMock.ExpectContext (MockableMethod)
import Test.HMock.Internal.ExpectSet
import Test.HMock.Internal.Rule (Rule ((:=>)))
import Test.HMock.Internal.State
import Test.HMock.Internal.Step (SingleRule ((:->)), Step (Step))
import Test.HMock.Internal.Util (locate)
import Test.HMock.Rule (Expectable (toRule))
import UnliftIO
runMockT :: forall m a. MonadIO m => MockT m a -> m a
runMockT :: MockT m a -> m a
runMockT MockT m a
test = ((forall a. MockT m a -> m a) -> MockT m a) -> m a
forall (m :: * -> *) b.
MonadIO m =>
((forall a. MockT m a -> m a) -> MockT m b) -> m b
withMockT (forall a. MockT m a -> m a) -> MockT m a
constTest
where
constTest :: (forall b. MockT m b -> m b) -> MockT m a
constTest :: (forall a. MockT m a -> m a) -> MockT m a
constTest forall a. MockT m a -> m a
_inMockT = MockT m a
test
withMockT ::
forall m b. MonadIO m => ((forall a. MockT m a -> m a) -> MockT m b) -> m b
withMockT :: ((forall a. MockT m a -> m a) -> MockT m b) -> m b
withMockT (forall a. MockT m a -> m a) -> MockT m b
test = do
MockState m
state <- Maybe (MockState m) -> m (MockState m)
forall (m :: * -> *).
MonadIO m =>
Maybe (MockState m) -> m (MockState m)
initMockState Maybe (MockState m)
forall a. Maybe a
Nothing
let inMockT :: forall a. MockT m a -> m a
inMockT :: MockT m a -> m a
inMockT MockT m a
m = ReaderT (MockState m) m a -> MockState m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (MockT m a -> ReaderT (MockState m) m a
forall (m :: * -> *) a. MockT m a -> ReaderT (MockState m) m a
unMockT MockT m a
m) MockState m
state
(ReaderT (MockState m) m b -> MockState m -> m b)
-> MockState m -> ReaderT (MockState m) m b -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (MockState m) m b -> MockState m -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT MockState m
state (ReaderT (MockState m) m b -> m b)
-> ReaderT (MockState m) m b -> m b
forall a b. (a -> b) -> a -> b
$
MockT m b -> ReaderT (MockState m) m b
forall (m :: * -> *) a. MockT m a -> ReaderT (MockState m) m a
unMockT (MockT m b -> ReaderT (MockState m) m b)
-> MockT m b -> ReaderT (MockState m) m b
forall a b. (a -> b) -> a -> b
$ do
b
a <- (forall a. MockT m a -> m a) -> MockT m b
test forall a. MockT m a -> m a
inMockT
MockT m ()
forall (m :: * -> *). MonadIO m => MockT m ()
verifyExpectations
b -> MockT m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a
nestMockT :: forall m a. MonadIO m => MockT m a -> MockT m a
nestMockT :: MockT m a -> MockT m a
nestMockT MockT m a
nest = ((forall a. MockT m a -> m a) -> MockT m a) -> MockT m a
forall (m :: * -> *) b.
MonadIO m =>
((forall a. MockT m a -> m a) -> MockT m b) -> MockT m b
withNestedMockT (forall a. MockT m a -> m a) -> MockT m a
constNest
where
constNest :: (forall b. MockT m b -> m b) -> MockT m a
constNest :: (forall a. MockT m a -> m a) -> MockT m a
constNest forall a. MockT m a -> m a
_inMockT = MockT m a
nest
withNestedMockT ::
forall m b.
MonadIO m =>
((forall a. MockT m a -> m a) -> MockT m b) ->
MockT m b
withNestedMockT :: ((forall a. MockT m a -> m a) -> MockT m b) -> MockT m b
withNestedMockT (forall a. MockT m a -> m a) -> MockT m b
nest = do
MockState m
parent <- ReaderT (MockState m) m (MockState m) -> MockT m (MockState m)
forall (m :: * -> *) a. ReaderT (MockState m) m a -> MockT m a
MockT ReaderT (MockState m) m (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
MockState m
state <- m (MockState m) -> MockT m (MockState m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MockState m) -> MockT m (MockState m))
-> m (MockState m) -> MockT m (MockState m)
forall a b. (a -> b) -> a -> b
$ Maybe (MockState m) -> m (MockState m)
forall (m :: * -> *).
MonadIO m =>
Maybe (MockState m) -> m (MockState m)
initMockState (MockState m -> Maybe (MockState m)
forall a. a -> Maybe a
Just MockState m
parent)
MockState m -> MockT m b -> MockT m b
forall (m :: * -> *) a.
Monad m =>
MockState m -> MockT m a -> MockT m a
withState MockState m
state (MockT m b -> MockT m b) -> MockT m b -> MockT m b
forall a b. (a -> b) -> a -> b
$ do
b
a <- (forall a. MockT m a -> m a) -> MockT m b
nest ((ReaderT (MockState m) m a -> MockState m -> m a)
-> MockState m -> ReaderT (MockState m) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (MockState m) m a -> MockState m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT MockState m
state (ReaderT (MockState m) m a -> m a)
-> (MockT m a -> ReaderT (MockState m) m a) -> MockT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockT m a -> ReaderT (MockState m) m a
forall (m :: * -> *) a. MockT m a -> ReaderT (MockState m) m a
unMockT)
MockT m ()
forall (m :: * -> *). MonadIO m => MockT m ()
verifyExpectations
b -> MockT m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a
where
withState :: MockState m -> MockT m a -> MockT m a
withState MockState m
state = ReaderT (MockState m) m a -> MockT m a
forall (m :: * -> *) a. ReaderT (MockState m) m a -> MockT m a
MockT (ReaderT (MockState m) m a -> MockT m a)
-> (MockT m a -> ReaderT (MockState m) m a)
-> MockT m a
-> MockT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MockState m -> MockState m)
-> ReaderT (MockState m) m a -> ReaderT (MockState m) m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (MockState m -> MockState m -> MockState m
forall a b. a -> b -> a
const MockState m
state) (ReaderT (MockState m) m a -> ReaderT (MockState m) m a)
-> (MockT m a -> ReaderT (MockState m) m a)
-> MockT m a
-> ReaderT (MockState m) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockT m a -> ReaderT (MockState m) m a
forall (m :: * -> *) a. MockT m a -> ReaderT (MockState m) m a
unMockT
setAmbiguityCheck :: MonadIO m => Severity -> MockT m ()
setAmbiguityCheck :: Severity -> MockT m ()
setAmbiguityCheck Severity
severity = MockSetup m () -> MockT m ()
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m () -> MockT m ()) -> MockSetup m () -> MockT m ()
forall a b. (a -> b) -> a -> b
$ do
MockState m
state <- ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
STM () -> MockSetup m ()
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM () -> MockSetup m ()) -> STM () -> MockSetup m ()
forall a b. (a -> b) -> a -> b
$ TVar Severity -> Severity -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (MockState m -> TVar Severity
forall (m :: * -> *). MockState m -> TVar Severity
mockAmbiguitySeverity MockState m
state) Severity
severity
setUninterestingActionCheck :: MonadIO m => Severity -> MockT m ()
setUninterestingActionCheck :: Severity -> MockT m ()
setUninterestingActionCheck Severity
severity = MockSetup m () -> MockT m ()
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m () -> MockT m ()) -> MockSetup m () -> MockT m ()
forall a b. (a -> b) -> a -> b
$ do
MockState m
state <- ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
STM () -> MockSetup m ()
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM () -> MockSetup m ()) -> STM () -> MockSetup m ()
forall a b. (a -> b) -> a -> b
$ TVar Severity -> Severity -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (MockState m -> TVar Severity
forall (m :: * -> *). MockState m -> TVar Severity
mockUninterestingSeverity MockState m
state) Severity
severity
setUnexpectedActionCheck :: MonadIO m => Severity -> MockT m ()
setUnexpectedActionCheck :: Severity -> MockT m ()
setUnexpectedActionCheck Severity
severity = MockSetup m () -> MockT m ()
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m () -> MockT m ()) -> MockSetup m () -> MockT m ()
forall a b. (a -> b) -> a -> b
$ do
MockState m
state <- ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
STM () -> MockSetup m ()
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM () -> MockSetup m ()) -> STM () -> MockSetup m ()
forall a b. (a -> b) -> a -> b
$ TVar Severity -> Severity -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (MockState m -> TVar Severity
forall (m :: * -> *). MockState m -> TVar Severity
mockUnexpectedSeverity MockState m
state) Severity
severity
setUnmetExpectationCheck :: MonadIO m => Severity -> MockT m ()
setUnmetExpectationCheck :: Severity -> MockT m ()
setUnmetExpectationCheck Severity
severity = MockSetup m () -> MockT m ()
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m () -> MockT m ()) -> MockSetup m () -> MockT m ()
forall a b. (a -> b) -> a -> b
$ do
MockState m
state <- ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
STM () -> MockSetup m ()
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM () -> MockSetup m ()) -> STM () -> MockSetup m ()
forall a b. (a -> b) -> a -> b
$ TVar Severity -> Severity -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (MockState m -> TVar Severity
forall (m :: * -> *). MockState m -> TVar Severity
mockUnmetSeverity MockState m
state) Severity
severity
describeExpectations :: MonadIO m => MockT m String
describeExpectations :: MockT m String
describeExpectations = MockSetup m String -> MockT m String
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m String -> MockT m String)
-> MockSetup m String -> MockT m String
forall a b. (a -> b) -> a -> b
$ do
[MockState m]
states <- MockState m -> [MockState m]
forall (m :: * -> *). MockState m -> [MockState m]
allStates (MockState m -> [MockState m])
-> MockSetup m (MockState m) -> MockSetup m [MockState m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
[ExpectSet (Step m)]
expectSets <- (MockState m -> MockSetup m (ExpectSet (Step m)))
-> [MockState m] -> MockSetup m [ExpectSet (Step m)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (STM (ExpectSet (Step m)) -> MockSetup m (ExpectSet (Step m))
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM (ExpectSet (Step m)) -> MockSetup m (ExpectSet (Step m)))
-> (MockState m -> STM (ExpectSet (Step m)))
-> MockState m
-> MockSetup m (ExpectSet (Step m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (ExpectSet (Step m)) -> STM (ExpectSet (Step m))
forall a. TVar a -> STM a
readTVar (TVar (ExpectSet (Step m)) -> STM (ExpectSet (Step m)))
-> (MockState m -> TVar (ExpectSet (Step m)))
-> MockState m
-> STM (ExpectSet (Step m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockState m -> TVar (ExpectSet (Step m))
forall (m :: * -> *). MockState m -> TVar (ExpectSet (Step m))
mockExpectSet) [MockState m]
states
String -> MockSetup m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> MockSetup m String) -> String -> MockSetup m String
forall a b. (a -> b) -> a -> b
$
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n----- (next layer) -----\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
ExpectSet (Step m) -> String
forall step. Show step => ExpectSet step -> String
formatExpectSet (ExpectSet (Step m) -> String) -> [ExpectSet (Step m)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExpectSet (Step m)]
expectSets
verifyExpectations :: MonadIO m => MockT m ()
verifyExpectations :: MockT m ()
verifyExpectations = MockT m (MockT m ()) -> MockT m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (MockT m (MockT m ()) -> MockT m ())
-> MockT m (MockT m ()) -> MockT m ()
forall a b. (a -> b) -> a -> b
$ do
MockSetup m (MockT m ()) -> MockT m (MockT m ())
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m (MockT m ()) -> MockT m (MockT m ()))
-> MockSetup m (MockT m ()) -> MockT m (MockT m ())
forall a b. (a -> b) -> a -> b
$ do
MockState m
states <- ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
ExpectSet (Step m)
expectSet <- STM (ExpectSet (Step m)) -> MockSetup m (ExpectSet (Step m))
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM (ExpectSet (Step m)) -> MockSetup m (ExpectSet (Step m)))
-> STM (ExpectSet (Step m)) -> MockSetup m (ExpectSet (Step m))
forall a b. (a -> b) -> a -> b
$ TVar (ExpectSet (Step m)) -> STM (ExpectSet (Step m))
forall a. TVar a -> STM a
readTVar (TVar (ExpectSet (Step m)) -> STM (ExpectSet (Step m)))
-> TVar (ExpectSet (Step m)) -> STM (ExpectSet (Step m))
forall a b. (a -> b) -> a -> b
$ MockState m -> TVar (ExpectSet (Step m))
forall (m :: * -> *). MockState m -> TVar (ExpectSet (Step m))
mockExpectSet MockState m
states
Severity
missingSev <- STM Severity -> MockSetup m Severity
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM Severity -> MockSetup m Severity)
-> STM Severity -> MockSetup m Severity
forall a b. (a -> b) -> a -> b
$ TVar Severity -> STM Severity
forall a. TVar a -> STM a
readTVar (TVar Severity -> STM Severity) -> TVar Severity -> STM Severity
forall a b. (a -> b) -> a -> b
$ MockState m -> TVar Severity
forall (m :: * -> *). MockState m -> TVar Severity
mockUnmetSeverity MockState m
states
case ExpectSet (Step m) -> ExpectSet (Step m)
forall step. ExpectSet step -> ExpectSet step
excess ExpectSet (Step m)
expectSet of
ExpectSet (Step m)
ExpectNothing -> MockT m () -> MockSetup m (MockT m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> MockT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
ExpectSet (Step m)
missing ->
MockT m () -> MockSetup m (MockT m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (MockT m () -> MockSetup m (MockT m ()))
-> MockT m () -> MockSetup m (MockT m ())
forall a b. (a -> b) -> a -> b
$
Severity -> String -> MockT m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
missingSev (String -> MockT m ()) -> String -> MockT m ()
forall a b. (a -> b) -> a -> b
$
String
"Unmet expectations:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpectSet (Step m) -> String
forall step. Show step => ExpectSet step -> String
formatExpectSet ExpectSet (Step m)
missing
allowUnexpected ::
forall cls name m r rule ctx.
( MonadIO m,
MockableMethod cls name m r,
Expectable cls name m r rule,
MockContext ctx
) =>
rule ->
ctx m ()
allowUnexpected :: rule -> ctx m ()
allowUnexpected rule
e = MockSetup m () -> ctx m ()
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m () -> ctx m ()) -> MockSetup m () -> ctx m ()
forall a b. (a -> b) -> a -> b
$ case rule -> Rule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r ex.
Expectable cls name m r ex =>
ex -> Rule cls name m r
toRule rule
e of
WholeMethodMatcher cls name m r
_ :=> (Action cls name m r -> MockT m r
_ : Action cls name m r -> MockT m r
_ : [Action cls name m r -> MockT m r]
_) -> String -> MockSetup m ()
forall a. HasCallStack => String -> a
error String
"allowUnexpected may not have multiple responses."
WholeMethodMatcher cls name m r
m :=> [Action cls name m r -> MockT m r]
r -> do
Proxy cls -> MockSetup m ()
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, Typeable m, MonadIO m) =>
proxy cls -> MockSetup m ()
initClassIfNeeded (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls)
MockState m
state <- ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
STM () -> MockSetup m ()
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM () -> MockSetup m ()) -> STM () -> MockSetup m ()
forall a b. (a -> b) -> a -> b
$
TVar [Step m] -> ([Step m] -> [Step m]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar'
(MockState m -> TVar [Step m]
forall (m :: * -> *). MockState m -> TVar [Step m]
mockAllowUnexpected MockState m
state)
(Located (SingleRule cls name m r) -> Step m
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
MockableMethod cls name m r =>
Located (SingleRule cls name m r) -> Step m
Step (CallStack
-> SingleRule cls name m r -> Located (SingleRule cls name m r)
forall a. CallStack -> a -> Located a
locate CallStack
HasCallStack => CallStack
callStack (WholeMethodMatcher cls name m r
m WholeMethodMatcher cls name m r
-> Maybe (Action cls name m r -> MockT m r)
-> SingleRule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
WholeMethodMatcher cls name m r
-> Maybe (Action cls name m r -> MockT m r)
-> SingleRule cls name m r
:-> [Action cls name m r -> MockT m r]
-> Maybe (Action cls name m r -> MockT m r)
forall a. [a] -> Maybe a
listToMaybe [Action cls name m r -> MockT m r]
r)) Step m -> [Step m] -> [Step m]
forall a. a -> [a] -> [a]
:)
byDefault ::
forall cls name m r ctx.
( MonadIO m,
MockableMethod cls name m r,
MockContext ctx
) =>
Rule cls name m r ->
ctx m ()
byDefault :: Rule cls name m r -> ctx m ()
byDefault (WholeMethodMatcher cls name m r
m :=> [Action cls name m r -> MockT m r
r]) = MockSetup m () -> ctx m ()
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m () -> ctx m ()) -> MockSetup m () -> ctx m ()
forall a b. (a -> b) -> a -> b
$ do
Proxy cls -> MockSetup m ()
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, Typeable m, MonadIO m) =>
proxy cls -> MockSetup m ()
initClassIfNeeded (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls)
MockState m
state <- ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
STM () -> MockSetup m ()
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM () -> MockSetup m ()) -> STM () -> MockSetup m ()
forall a b. (a -> b) -> a -> b
$
TVar [Step m] -> ([Step m] -> [Step m]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar'
(MockState m -> TVar [Step m]
forall (m :: * -> *). MockState m -> TVar [Step m]
mockDefaults MockState m
state)
(Located (SingleRule cls name m r) -> Step m
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
MockableMethod cls name m r =>
Located (SingleRule cls name m r) -> Step m
Step (CallStack
-> SingleRule cls name m r -> Located (SingleRule cls name m r)
forall a. CallStack -> a -> Located a
locate CallStack
HasCallStack => CallStack
callStack (WholeMethodMatcher cls name m r
m WholeMethodMatcher cls name m r
-> Maybe (Action cls name m r -> MockT m r)
-> SingleRule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
WholeMethodMatcher cls name m r
-> Maybe (Action cls name m r -> MockT m r)
-> SingleRule cls name m r
:-> (Action cls name m r -> MockT m r)
-> Maybe (Action cls name m r -> MockT m r)
forall a. a -> Maybe a
Just Action cls name m r -> MockT m r
r)) Step m -> [Step m] -> [Step m]
forall a. a -> [a] -> [a]
:)
byDefault Rule cls name m r
_ = String -> ctx m ()
forall a. HasCallStack => String -> a
error String
"Defaults must have exactly one response."
whenever ::
forall cls name m r ctx.
( MonadIO m,
MockableMethod cls name m r,
MockContext ctx
) =>
Rule cls name m r ->
ctx m ()
whenever :: Rule cls name m r -> ctx m ()
whenever (WholeMethodMatcher cls name m r
m :=> [Action cls name m r -> MockT m r
r]) = MockSetup m () -> ctx m ()
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m () -> ctx m ()) -> MockSetup m () -> ctx m ()
forall a b. (a -> b) -> a -> b
$ do
Proxy cls -> MockSetup m ()
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, Typeable m, MonadIO m) =>
proxy cls -> MockSetup m ()
initClassIfNeeded (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls)
MockState m
state <- ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
STM () -> MockSetup m ()
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM () -> MockSetup m ()) -> STM () -> MockSetup m ()
forall a b. (a -> b) -> a -> b
$
TVar [Step m] -> ([Step m] -> [Step m]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar'
(MockState m -> TVar [Step m]
forall (m :: * -> *). MockState m -> TVar [Step m]
mockSideEffects MockState m
state)
(Located (SingleRule cls name m r) -> Step m
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
MockableMethod cls name m r =>
Located (SingleRule cls name m r) -> Step m
Step (CallStack
-> SingleRule cls name m r -> Located (SingleRule cls name m r)
forall a. CallStack -> a -> Located a
locate CallStack
HasCallStack => CallStack
callStack (WholeMethodMatcher cls name m r
m WholeMethodMatcher cls name m r
-> Maybe (Action cls name m r -> MockT m r)
-> SingleRule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
WholeMethodMatcher cls name m r
-> Maybe (Action cls name m r -> MockT m r)
-> SingleRule cls name m r
:-> (Action cls name m r -> MockT m r)
-> Maybe (Action cls name m r -> MockT m r)
forall a. a -> Maybe a
Just Action cls name m r -> MockT m r
r)) Step m -> [Step m] -> [Step m]
forall a. a -> [a] -> [a]
:)
whenever Rule cls name m r
_ = String -> ctx m ()
forall a. HasCallStack => String -> a
error String
"Side effects must have exactly one response."