{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module defines monads for working with mocks.  HMock tests run in the
-- 'MockT' monad transformer.  A more limited monad, 'MockSetup', is used for
-- setting up defaults for each class.  Both are instances of the 'MockContext'
-- monad, which defines a shared API.
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

-- | Runs a test in the 'MockT' monad, handling all of the mocks.
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

-- | Runs a test in the 'MockT' monad.  The test can unlift other MockT pieces
-- to the base monad while still acting on the same set of expectations.  This
-- can be useful for testing concurrency or similar mechanisms.
--
-- @
-- test = 'withMockT' '$' \inMockT -> do
--    'Test.HMock.Expectable.expect' '$' ...
--
--    'liftIO' '$' 'Control.Concurrent.forkIO' '$' inMockT firstThread
--    'liftIO' '$' 'Control.Concurrent.forkIO' '$' inMockT secondThread
-- @
--
-- This is a low-level primitive.  Consider using the @unliftio@ package for
-- higher level implementations of multithreading and other primitives.
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

-- | Starts a nested block within 'MockT'.  The nested block has its own set of
-- expectations, which must be fulfilled before the end of the block.
--
-- Beware: use of 'nestMockT' might signify that you are doing too much in a
-- single test.  Consider splitting large tests into a separate test for each
-- case.
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

-- | Starts a nested block within 'MockT'.  The nested block has its own set of
-- expectations, which must be fulfilled before the end of the block.  It can
-- unlift other MockT pieces to the base monad while still acting on the same
-- set of expectations.  This can be useful for testing concurrency or similar
-- mechanisms.
--
-- Beware: use of 'nestMockT' might signify that you are doing too much in a
-- single test.  Consider splitting large tests into a separate test for each
-- case.
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

-- | Sets the severity for ambiguous actions.  An ambiguous action is one that
-- matches expectations in more than one way.  If this is not set to `Error`,
-- the most recently added expectation will take precedence.
--
-- This defaults to 'Ignore'.
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

-- | Sets the severity for uninteresting actions.  An uninteresting action is
-- one for which no expectations or other configuration have been added that
-- mention the method at all.  If this is not set to `Error`, then uninteresting
-- methods are treated just like unexpected methods.
--
-- Before you weaken this check, consider that the labeling of methods as
-- "uninteresting" is non-compositional.  A change in one part of your test can
-- result in a formerly uninteresting action being considered interesting in a
-- different part of the test.
--
-- This defaults to 'Error'.
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

-- | Sets the severity for unexpected actions.  An unexpected action is one that
-- doesn't match any expectations *and* isn't explicitly allowed by
-- `allowUnexpected`.  If this is not set to `Error`, the action returns its
-- default response.
--
-- This defaults to 'Error'.
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

-- | Sets the severity for unmet expectations.  An unmet expectation happens
-- when an expectation is added, but either the test (or nesting level) ends or
-- 'verifyExpectations' is used before a matching action takes place.
--
-- This defaults to 'Error'.
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

-- | Fetches a 'String' that describes the current set of outstanding
-- expectations.  This is sometimes useful for debugging test code.  The exact
-- format is not specified.
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

-- | Verifies that all mock expectations are satisfied.  If there is a nested
-- block in effect, only the expectations of that nested block are verified
-- You normally don't need to do this, because it happens automatically at the
-- end of your test or nested block.  However, it's occasionally useful to check
-- expectations early.
--
-- Beware: use of 'verifyExpectations' might signify that you are doing too much
-- in a single test.  Consider splitting large tests into a separate test for
-- each case.
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

-- | Adds a handler for unexpected actions.  Matching calls will not fail, but
-- will use a default response instead.  The rule passed in must have zero or
-- one responses: if there is a response, @'allowUnexpected' (m
-- 'Test.HMock.Rule.|=>' r)@ is equivalent to @'allowUnexpected' m >>
-- 'byDefault' (m 'Test.HMock.Rule.|=>' r)@.
--
-- The difference between 'Test.HMock.Expectable.expectAny' and
-- 'allowUnexpected' is subtle, but comes down to ambiguity:
--
-- * 'allowUnexpected' is not an expectation, so it cannot be ambiguous.  It
--   only has an effect if no true expectation matches, regardless of when the
--   expectations were added.
-- * 'Test.HMock.Expectable.expectAny' adds an expectation, so if another
--   expectation is in effect at the same time, a call to the method is
--   ambiguous.  If ambiguity checking is enabled, the method will throw an
--   error; otherwise, the more recently added of the two expectations is used.
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]
:)

-- | Sets a default action for *expected* matching calls.  The new default only
-- applies to calls for which an expectation exists, but it lacks an explicit
-- response.  The rule passed in must have exactly one response.
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."

-- | Adds a side-effect, which happens whenever a matching call occurs, in
-- addition to the usual response.  The return value is entirely ignored.
--
-- Be warned: using side effects makes it easy to break abstraction boundaries.
-- Be aware that there may be other uses of a method besides the one which you
-- intend to intercept here.  If possible, add the desired behavior to the
-- response for the matching expectation instead.
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."