{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use null" #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
module Test.MockCat.Internal.Builder where


import Control.Concurrent.STM
  ( TVar
  , atomically
  , modifyTVar'
  , newTVarIO
  , readTVar
  , readTVarIO
  , writeTVar
  )
import Data.Maybe
import Test.MockCat.Cons (Head(..), (:>)(..))
import Test.MockCat.Param
import Test.MockCat.AssociationList (lookup, update, insert, empty, member)
import Prelude hiding (lookup)
import Control.Monad.State
import Test.MockCat.Internal.Types
import Test.MockCat.Internal.Message

-- | Class for building a curried function.
-- The purpose of this class is to automatically generate and provide
-- an implementation for the corresponding curried function type (such as `a -> b -> ... -> IO r`)
-- when given the argument list type of the mock (`Param a :> Param b :> ...`).
-- @args@ is the argument list type of the mock.
-- @r@ is the return type of the function.
-- @fn@ is the curried function type.
class BuildCurried args r fn | args r -> fn where
  buildCurriedImpl :: (args -> IO r) -> fn

-- | Build a curried function that returns an IO result.
buildCurried :: forall args r fn. BuildCurried args r fn => (args -> IO r) -> fn
buildCurried :: forall args r fn. BuildCurried args r fn => (args -> IO r) -> fn
buildCurried = (args -> IO r) -> fn
forall args r fn. BuildCurried args r fn => (args -> IO r) -> fn
buildCurriedImpl

instance (WrapParam a, fn ~ (a -> r)) => BuildCurried (Param a) r fn where
  buildCurriedImpl :: (Param a -> IO r) -> fn
buildCurriedImpl Param a -> IO r
f a
a = IO r -> r
forall a. IO a -> a
perform (Param a -> IO r
f (a -> Param a
forall a. WrapParam a => a -> Param a
wrap a
a))

instance
  ( BuildCurried rest r fn
  , WrapParam a
  , fn' ~ (a -> fn)
  ) =>
  BuildCurried (Param a :> rest) r fn'
  where
  buildCurriedImpl :: ((Param a :> rest) -> IO r) -> fn'
buildCurriedImpl (Param a :> rest) -> IO r
input a
a =
    forall args r fn. BuildCurried args r fn => (args -> IO r) -> fn
buildCurriedImpl @rest @r @fn ((Param a :> rest) -> IO r
input ((Param a :> rest) -> IO r)
-> (rest -> Param a :> rest) -> rest -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\rest
rest -> a -> Param a
forall a. WrapParam a => a -> Param a
wrap a
a Param a -> rest -> Param a :> rest
forall a b. a -> b -> a :> b
:> rest
rest))

-- | Class for building a curried pure function without relying on IO.
class BuildCurriedPure args r fn | args r -> fn where
  buildCurriedPureImpl :: (args -> r) -> fn

-- | Build a curried function that returns a pure result.
buildCurriedPure :: forall args r fn. BuildCurriedPure args r fn => (args -> r) -> fn
buildCurriedPure :: forall args r fn. BuildCurriedPure args r fn => (args -> r) -> fn
buildCurriedPure = (args -> r) -> fn
forall args r fn. BuildCurriedPure args r fn => (args -> r) -> fn
buildCurriedPureImpl

instance (WrapParam a, fn ~ (a -> r)) => BuildCurriedPure (Param a) r fn where
  buildCurriedPureImpl :: (Param a -> r) -> fn
buildCurriedPureImpl Param a -> r
f a
a = Param a -> r
f (a -> Param a
forall a. WrapParam a => a -> Param a
wrap a
a)

instance
  ( BuildCurriedPure rest r fn
  , WrapParam a
  , fn' ~ (a -> fn)
  ) =>
  BuildCurriedPure (Param a :> rest) r fn'
  where
  buildCurriedPureImpl :: ((Param a :> rest) -> r) -> fn'
buildCurriedPureImpl (Param a :> rest) -> r
input a
a =
    forall args r fn. BuildCurriedPure args r fn => (args -> r) -> fn
buildCurriedPureImpl @rest @r @fn ((Param a :> rest) -> r
input ((Param a :> rest) -> r) -> (rest -> Param a :> rest) -> rest -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\rest
rest -> a -> Param a
forall a. WrapParam a => a -> Param a
wrap a
a Param a -> rest -> Param a :> rest
forall a b. a -> b -> a :> b
:> rest
rest))

-- | Class for building a curried function whose result stays in IO.
class BuildCurriedIO args r fn | args r -> fn where
  buildCurriedIOImpl :: (args -> IO r) -> fn

-- | Build a curried IO function without hiding the IO layer.
buildCurriedIO :: forall args r fn. BuildCurriedIO args r fn => (args -> IO r) -> fn
buildCurriedIO :: forall args r fn. BuildCurriedIO args r fn => (args -> IO r) -> fn
buildCurriedIO = (args -> IO r) -> fn
forall args r fn. BuildCurriedIO args r fn => (args -> IO r) -> fn
buildCurriedIOImpl

instance (WrapParam a, fn ~ (a -> IO r)) => BuildCurriedIO (Param a) r fn where
  buildCurriedIOImpl :: (Param a -> IO r) -> fn
buildCurriedIOImpl Param a -> IO r
f a
a = Param a -> IO r
f (a -> Param a
forall a. WrapParam a => a -> Param a
wrap a
a)

instance
  ( BuildCurriedIO rest r fn
  , WrapParam a
  , fn' ~ (a -> fn)
  ) =>
  BuildCurriedIO (Param a :> rest) r fn'
  where
  buildCurriedIOImpl :: ((Param a :> rest) -> IO r) -> fn'
buildCurriedIOImpl (Param a :> rest) -> IO r
input a
a =
    forall args r fn. BuildCurriedIO args r fn => (args -> IO r) -> fn
buildCurriedIOImpl @rest @r @fn ((Param a :> rest) -> IO r
input ((Param a :> rest) -> IO r)
-> (rest -> Param a :> rest) -> rest -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\rest
rest -> a -> Param a
forall a. WrapParam a => a -> Param a
wrap a
a Param a -> rest -> Param a :> rest
forall a b. a -> b -> a :> b
:> rest
rest))

-- | Class for creating a stub corresponding to the parameter description.
class MockBuilder params fn verifyParams | params -> fn, params -> verifyParams where
  build ::
    MonadIO m =>
    Maybe MockName ->
    params ->
    m (BuiltMock fn verifyParams)

-- | New name for `build` to make intent explicit.
--   `buildMock` constructs a mock function and its verifier.
buildMock ::
  ( MonadIO m
  , MockBuilder params fn verifyParams
  ) =>
  Maybe MockName ->
  params ->
  m (BuiltMock fn verifyParams)
buildMock :: forall (m :: * -> *) params fn verifyParams.
(MonadIO m, MockBuilder params fn verifyParams) =>
Maybe MockName -> params -> m (BuiltMock fn verifyParams)
buildMock = Maybe MockName -> params -> m (BuiltMock fn verifyParams)
forall params fn verifyParams (m :: * -> *).
(MockBuilder params fn verifyParams, MonadIO m) =>
Maybe MockName -> params -> m (BuiltMock fn verifyParams)
forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> params -> m (BuiltMock fn verifyParams)
build

-- | Instance for building a stub for a constant IO action.
instance
  MockBuilder (IO r) (IO r) ()
  where
  build :: forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> IO r -> m (BuiltMock (IO r) ())
build Maybe MockName
_ IO r
action = do
    TVar (InvocationRecord ())
ref <- IO (TVar (InvocationRecord ())) -> m (TVar (InvocationRecord ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (InvocationRecord ())) -> m (TVar (InvocationRecord ())))
-> IO (TVar (InvocationRecord ()))
-> m (TVar (InvocationRecord ()))
forall a b. (a -> b) -> a -> b
$ InvocationRecord () -> IO (TVar (InvocationRecord ()))
forall a. a -> IO (TVar a)
newTVarIO InvocationRecord ()
forall params. InvocationRecord params
invocationRecord
    let
      fn :: IO r
fn = do
        r
result <- IO r
action
        IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (InvocationRecord ()) -> () -> IO ()
forall params. TVar (InvocationRecord params) -> params -> IO ()
appendCalledParams TVar (InvocationRecord ())
ref ()
        r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
result
      recorder :: InvocationRecorder ()
recorder = TVar (InvocationRecord ())
-> FunctionNature -> InvocationRecorder ()
forall params.
TVar (InvocationRecord params)
-> FunctionNature -> InvocationRecorder params
InvocationRecorder TVar (InvocationRecord ())
ref FunctionNature
IOConstant
    BuiltMock (IO r) () -> m (BuiltMock (IO r) ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO r -> InvocationRecorder () -> BuiltMock (IO r) ()
forall fn params.
fn -> InvocationRecorder params -> BuiltMock fn params
BuiltMock IO r
fn InvocationRecorder ()
recorder)

-- | Instance for building a stub for a constant value (with Head marker).
instance
  MockBuilder (Head :> Param r) r ()
  where
  build :: forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> (Head :> Param r) -> m (BuiltMock r ())
build Maybe MockName
_ (Head
Head :> Param r
params) = do
    TVar (InvocationRecord ())
ref <- IO (TVar (InvocationRecord ())) -> m (TVar (InvocationRecord ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (InvocationRecord ())) -> m (TVar (InvocationRecord ())))
-> IO (TVar (InvocationRecord ()))
-> m (TVar (InvocationRecord ()))
forall a b. (a -> b) -> a -> b
$ InvocationRecord () -> IO (TVar (InvocationRecord ()))
forall a. a -> IO (TVar a)
newTVarIO InvocationRecord ()
forall params. InvocationRecord params
invocationRecord
    let v :: r
v = Param r -> r
forall v. Param v -> v
value Param r
params
        fn :: r
fn = IO r -> r
forall a. IO a -> a
perform (IO r -> r) -> IO r -> r
forall a b. (a -> b) -> a -> b
$ do
          IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (InvocationRecord ()) -> () -> IO ()
forall params. TVar (InvocationRecord params) -> params -> IO ()
appendCalledParams TVar (InvocationRecord ())
ref ()
          r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
v
        recorder :: InvocationRecorder ()
recorder = TVar (InvocationRecord ())
-> FunctionNature -> InvocationRecorder ()
forall params.
TVar (InvocationRecord params)
-> FunctionNature -> InvocationRecorder params
InvocationRecorder TVar (InvocationRecord ())
ref FunctionNature
PureConstant
    BuiltMock r () -> m (BuiltMock r ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> InvocationRecorder () -> BuiltMock r ()
forall fn params.
fn -> InvocationRecorder params -> BuiltMock fn params
BuiltMock r
fn InvocationRecorder ()
recorder)

-- | Instance for building a stub for a value (backward compatibility).
instance
  MockBuilder (Param r) r ()
  where
  build :: forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> Param r -> m (BuiltMock r ())
build Maybe MockName
_ Param r
params = do
    TVar (InvocationRecord ())
ref <- IO (TVar (InvocationRecord ())) -> m (TVar (InvocationRecord ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (InvocationRecord ())) -> m (TVar (InvocationRecord ())))
-> IO (TVar (InvocationRecord ()))
-> m (TVar (InvocationRecord ()))
forall a b. (a -> b) -> a -> b
$ InvocationRecord () -> IO (TVar (InvocationRecord ()))
forall a. a -> IO (TVar a)
newTVarIO InvocationRecord ()
forall params. InvocationRecord params
invocationRecord
    let v :: r
v = Param r -> r
forall v. Param v -> v
value Param r
params
        fn :: r
fn = IO r -> r
forall a. IO a -> a
perform (IO r -> r) -> IO r -> r
forall a b. (a -> b) -> a -> b
$ do
          IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (InvocationRecord ()) -> () -> IO ()
forall params. TVar (InvocationRecord params) -> params -> IO ()
appendCalledParams TVar (InvocationRecord ())
ref ()
          r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
v
        recorder :: InvocationRecorder ()
recorder = TVar (InvocationRecord ())
-> FunctionNature -> InvocationRecorder ()
forall params.
TVar (InvocationRecord params)
-> FunctionNature -> InvocationRecorder params
InvocationRecorder TVar (InvocationRecord ())
ref FunctionNature
PureConstant
    BuiltMock r () -> m (BuiltMock r ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> InvocationRecorder () -> BuiltMock r ()
forall fn params.
fn -> InvocationRecorder params -> BuiltMock fn params
BuiltMock r
fn InvocationRecorder ()
recorder)

-- | Instance for building a stub for `Cases (IO a) ()`.
instance MockBuilder (Cases (IO a) ()) (IO a) () where
  build :: forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> Cases (IO a) () -> m (BuiltMock (IO a) ())
build Maybe MockName
_ Cases (IO a) ()
cases = do
    let params :: [IO a]
params = Cases (IO a) () -> [IO a]
forall a b. Cases a b -> [a]
runCase Cases (IO a) ()
cases
    TVar (InvocationRecord ())
ref <- IO (TVar (InvocationRecord ())) -> m (TVar (InvocationRecord ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (InvocationRecord ())) -> m (TVar (InvocationRecord ())))
-> IO (TVar (InvocationRecord ()))
-> m (TVar (InvocationRecord ()))
forall a b. (a -> b) -> a -> b
$ InvocationRecord () -> IO (TVar (InvocationRecord ()))
forall a. a -> IO (TVar a)
newTVarIO InvocationRecord ()
forall params. InvocationRecord params
invocationRecord
    let fn :: IO a
fn = do
          Int
count <- TVar (InvocationRecord ()) -> () -> IO Int
forall params.
Eq params =>
TVar (InvocationRecord params) -> params -> IO Int
readInvocationCount TVar (InvocationRecord ())
ref ()
          let index :: Int
index = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count ([IO a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IO a]
params Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              r :: Maybe (IO a)
r = [IO a] -> Int -> Maybe (IO a)
forall a. [a] -> Int -> Maybe a
safeIndex [IO a]
params Int
index
          TVar (InvocationRecord ()) -> () -> IO ()
forall params. TVar (InvocationRecord params) -> params -> IO ()
appendCalledParams TVar (InvocationRecord ())
ref ()
          TVar (InvocationRecord ()) -> () -> IO ()
forall params.
Eq params =>
TVar (InvocationRecord params) -> params -> IO ()
incrementInvocationCount TVar (InvocationRecord ())
ref ()
          Maybe (IO a) -> IO a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (IO a)
r
        recorder :: InvocationRecorder ()
recorder = TVar (InvocationRecord ())
-> FunctionNature -> InvocationRecorder ()
forall params.
TVar (InvocationRecord params)
-> FunctionNature -> InvocationRecorder params
InvocationRecorder TVar (InvocationRecord ())
ref FunctionNature
IOConstant
    BuiltMock (IO a) () -> m (BuiltMock (IO a) ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO a -> InvocationRecorder () -> BuiltMock (IO a) ()
forall fn params.
fn -> InvocationRecorder params -> BuiltMock fn params
BuiltMock IO a
fn InvocationRecorder ()
recorder)

-- | Overlapping instance for building a stub when parameters are provided as 'Cases'.
instance {-# OVERLAPPABLE #-}
  ( ParamConstraints params args r
  , BuildCurried args r fn
  ) => MockBuilder (Cases params ()) fn args where
  build :: forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> Cases params () -> m (BuiltMock fn args)
build Maybe MockName
name Cases params ()
cases = do
    let paramsList :: [params]
paramsList = Cases params () -> [params]
forall a b. Cases a b -> [a]
runCase Cases params ()
cases
    (TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
forall (m :: * -> *) args r fn.
(MonadIO m, BuildCurried args r fn) =>
(TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
buildWithRecorder (\TVar (InvocationRecord args)
ref args
inputParams -> TVar (InvocationRecord args) -> InvocationStep args r -> IO r
forall args r.
TVar (InvocationRecord args) -> InvocationStep args r -> IO r
executeInvocation TVar (InvocationRecord args)
ref (Maybe MockName -> [params] -> args -> InvocationStep args r
forall params args r.
ParamConstraints params args r =>
Maybe MockName
-> InvocationList params -> args -> InvocationStep args r
casesInvocationStep Maybe MockName
name [params]
paramsList args
inputParams))

-- | Overlapping instance for building a stub defined via chained 'Param'.
instance {-# OVERLAPPABLE #-}
  ( p ~ (Param a :> rest)
  , ParamConstraints p args r
  , BuildCurried args r fn
  ) => MockBuilder (Param a :> rest) fn args where
  build :: forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> (Param a :> rest) -> m (BuiltMock fn args)
build Maybe MockName
name Param a :> rest
params =
    (TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
forall (m :: * -> *) args r fn.
(MonadIO m, BuildCurried args r fn) =>
(TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
buildWithRecorder (\TVar (InvocationRecord args)
ref args
inputParams -> TVar (InvocationRecord args) -> InvocationStep args r -> IO r
forall args r.
TVar (InvocationRecord args) -> InvocationStep args r -> IO r
executeInvocation TVar (InvocationRecord args)
ref (Maybe MockName
-> (Param a :> rest) -> args -> InvocationStep args r
forall params args r.
ParamConstraints params args r =>
Maybe MockName -> params -> args -> InvocationStep args r
singleInvocationStep Maybe MockName
name Param a :> rest
params args
inputParams))

-- | Class for building mocks whose resulting functions stay in IO.
class MockIOBuilder params fn verifyParams | params -> fn, params -> verifyParams where
  buildIO ::
    MonadIO m =>
    Maybe MockName ->
    params ->
    m (BuiltMock fn verifyParams)

instance {-# OVERLAPPABLE #-}
  ( ParamConstraints params args r
  , BuildCurriedIO args r fn
  ) => MockIOBuilder (Cases params ()) fn args where
  buildIO :: forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> Cases params () -> m (BuiltMock fn args)
buildIO Maybe MockName
name Cases params ()
cases = do
    let paramsList :: [params]
paramsList = Cases params () -> [params]
forall a b. Cases a b -> [a]
runCase Cases params ()
cases
    (TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
forall (m :: * -> *) args r fn.
(MonadIO m, BuildCurriedIO args r fn) =>
(TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
buildWithRecorderIO (\TVar (InvocationRecord args)
ref args
inputParams -> TVar (InvocationRecord args) -> InvocationStep args r -> IO r
forall args r.
TVar (InvocationRecord args) -> InvocationStep args r -> IO r
executeInvocation TVar (InvocationRecord args)
ref (Maybe MockName -> [params] -> args -> InvocationStep args r
forall params args r.
ParamConstraints params args r =>
Maybe MockName
-> InvocationList params -> args -> InvocationStep args r
casesInvocationStep Maybe MockName
name [params]
paramsList args
inputParams))

instance {-# OVERLAPPABLE #-}
  ( p ~ (Param a :> rest)
  , ParamConstraints p args r
  , BuildCurriedIO args r fn
  ) => MockIOBuilder (Param a :> rest) fn args where
  buildIO :: forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> (Param a :> rest) -> m (BuiltMock fn args)
buildIO Maybe MockName
name Param a :> rest
params =
    (TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
forall (m :: * -> *) args r fn.
(MonadIO m, BuildCurriedIO args r fn) =>
(TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
buildWithRecorderIO (\TVar (InvocationRecord args)
ref args
inputParams -> TVar (InvocationRecord args) -> InvocationStep args r -> IO r
forall args r.
TVar (InvocationRecord args) -> InvocationStep args r -> IO r
executeInvocation TVar (InvocationRecord args)
ref (Maybe MockName
-> (Param a :> rest) -> args -> InvocationStep args r
forall params args r.
ParamConstraints params args r =>
Maybe MockName -> params -> args -> InvocationStep args r
singleInvocationStep Maybe MockName
name Param a :> rest
params args
inputParams))


buildWithRecorder ::
  ( MonadIO m
  , BuildCurried args r fn
  ) =>
  (TVar (InvocationRecord args) -> args -> IO r) ->
  m (BuiltMock fn args)
buildWithRecorder :: forall (m :: * -> *) args r fn.
(MonadIO m, BuildCurried args r fn) =>
(TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
buildWithRecorder TVar (InvocationRecord args) -> args -> IO r
handler = do
  TVar (InvocationRecord args)
ref <- IO (TVar (InvocationRecord args))
-> m (TVar (InvocationRecord args))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (InvocationRecord args))
 -> m (TVar (InvocationRecord args)))
-> IO (TVar (InvocationRecord args))
-> m (TVar (InvocationRecord args))
forall a b. (a -> b) -> a -> b
$ InvocationRecord args -> IO (TVar (InvocationRecord args))
forall a. a -> IO (TVar a)
newTVarIO InvocationRecord args
forall params. InvocationRecord params
invocationRecord
  let fn :: fn
fn = (args -> IO r) -> fn
forall args r fn. BuildCurried args r fn => (args -> IO r) -> fn
buildCurried (TVar (InvocationRecord args) -> args -> IO r
handler TVar (InvocationRecord args)
ref)
      recorder :: InvocationRecorder args
recorder = TVar (InvocationRecord args)
-> FunctionNature -> InvocationRecorder args
forall params.
TVar (InvocationRecord params)
-> FunctionNature -> InvocationRecorder params
InvocationRecorder TVar (InvocationRecord args)
ref FunctionNature
ParametricFunction
  BuiltMock fn args -> m (BuiltMock fn args)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (fn -> InvocationRecorder args -> BuiltMock fn args
forall fn params.
fn -> InvocationRecorder params -> BuiltMock fn params
BuiltMock fn
fn InvocationRecorder args
recorder)

buildWithRecorderIO ::
  ( MonadIO m
  , BuildCurriedIO args r fn
  ) =>
  (TVar (InvocationRecord args) -> args -> IO r) ->
  m (BuiltMock fn args)
buildWithRecorderIO :: forall (m :: * -> *) args r fn.
(MonadIO m, BuildCurriedIO args r fn) =>
(TVar (InvocationRecord args) -> args -> IO r)
-> m (BuiltMock fn args)
buildWithRecorderIO TVar (InvocationRecord args) -> args -> IO r
handler = do
  TVar (InvocationRecord args)
ref <- IO (TVar (InvocationRecord args))
-> m (TVar (InvocationRecord args))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (InvocationRecord args))
 -> m (TVar (InvocationRecord args)))
-> IO (TVar (InvocationRecord args))
-> m (TVar (InvocationRecord args))
forall a b. (a -> b) -> a -> b
$ InvocationRecord args -> IO (TVar (InvocationRecord args))
forall a. a -> IO (TVar a)
newTVarIO InvocationRecord args
forall params. InvocationRecord params
invocationRecord
  let fn :: fn
fn = (args -> IO r) -> fn
forall args r fn. BuildCurriedIO args r fn => (args -> IO r) -> fn
buildCurriedIO (TVar (InvocationRecord args) -> args -> IO r
handler TVar (InvocationRecord args)
ref)
      recorder :: InvocationRecorder args
recorder = TVar (InvocationRecord args)
-> FunctionNature -> InvocationRecorder args
forall params.
TVar (InvocationRecord params)
-> FunctionNature -> InvocationRecorder params
InvocationRecorder TVar (InvocationRecord args)
ref FunctionNature
ParametricFunction
  BuiltMock fn args -> m (BuiltMock fn args)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (fn -> InvocationRecorder args -> BuiltMock fn args
forall fn params.
fn -> InvocationRecorder params -> BuiltMock fn params
BuiltMock fn
fn InvocationRecorder args
recorder)

invocationRecord :: InvocationRecord params
invocationRecord :: forall params. InvocationRecord params
invocationRecord =
  InvocationRecord
    { invocations :: InvocationList params
invocations = InvocationList params
forall a. Monoid a => a
mempty
    , invocationCounts :: InvocationCounts params
invocationCounts = InvocationCounts params
forall k a. AssociationList k a
empty
    }

appendCalledParams :: TVar (InvocationRecord params) -> params -> IO ()
appendCalledParams :: forall params. TVar (InvocationRecord params) -> params -> IO ()
appendCalledParams TVar (InvocationRecord params)
ref params
inputParams =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
    TVar (InvocationRecord params)
-> (InvocationRecord params -> InvocationRecord params) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (InvocationRecord params)
ref ((InvocationRecord params -> InvocationRecord params) -> STM ())
-> (InvocationRecord params -> InvocationRecord params) -> STM ()
forall a b. (a -> b) -> a -> b
$ \InvocationRecord params
record ->
      InvocationRecord params
record
        { invocations = invocations record ++ [inputParams]
        }

readInvocationCount :: Eq params => TVar (InvocationRecord params) -> params -> IO Int
readInvocationCount :: forall params.
Eq params =>
TVar (InvocationRecord params) -> params -> IO Int
readInvocationCount TVar (InvocationRecord params)
ref params
params = do
  InvocationRecord params
record <- TVar (InvocationRecord params) -> IO (InvocationRecord params)
forall a. TVar a -> IO a
readTVarIO TVar (InvocationRecord params)
ref
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (params -> AssociationList params Int -> Maybe Int
forall k a. Eq k => k -> AssociationList k a -> Maybe a
lookup params
params (InvocationRecord params -> AssociationList params Int
forall params. InvocationRecord params -> InvocationCounts params
invocationCounts InvocationRecord params
record))

incrementInvocationCount :: Eq params => TVar (InvocationRecord params) -> params -> IO ()
incrementInvocationCount :: forall params.
Eq params =>
TVar (InvocationRecord params) -> params -> IO ()
incrementInvocationCount TVar (InvocationRecord params)
ref params
inputParams =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
    TVar (InvocationRecord params)
-> (InvocationRecord params -> InvocationRecord params) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (InvocationRecord params)
ref ((InvocationRecord params -> InvocationRecord params) -> STM ())
-> (InvocationRecord params -> InvocationRecord params) -> STM ()
forall a b. (a -> b) -> a -> b
$ \InvocationRecord params
record ->
      InvocationRecord params
record
        { invocationCounts = incrementCount inputParams (invocationCounts record)
        }

incrementCount :: Eq k => k -> InvocationCounts k -> InvocationCounts k
incrementCount :: forall k. Eq k => k -> InvocationCounts k -> InvocationCounts k
incrementCount k
key InvocationCounts k
list =
  if k -> InvocationCounts k -> Bool
forall k a. Eq k => k -> AssociationList k a -> Bool
member k
key InvocationCounts k
list then (Int -> Int) -> k -> InvocationCounts k -> InvocationCounts k
forall k a.
Eq k =>
(a -> a) -> k -> AssociationList k a -> AssociationList k a
update (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
key InvocationCounts k
list
  else k -> Int -> InvocationCounts k -> InvocationCounts k
forall k a.
Eq k =>
k -> a -> AssociationList k a -> AssociationList k a
insert k
key Int
1 InvocationCounts k
list

runCase :: Cases a b -> [a]
runCase :: forall a b. Cases a b -> [a]
runCase (Cases State [a] b
s) = State [a] b -> [a] -> [a]
forall s a. State s a -> s -> s
execState State [a] b
s []

p :: (Show a, Eq a) => a -> Param a
p :: forall a. (Show a, Eq a) => a -> Param a
p a
v = a -> MockName -> Param a
forall v. (Show v, Eq v) => v -> MockName -> Param v
ExpectValue a
v (a -> MockName
forall a. Show a => a -> MockName
show a
v)

class StubBuilder params fn | params -> fn where
  buildStub :: Maybe MockName -> params -> fn

-- | Instance for building a mock for a constant function.
instance
  StubBuilder (IO r) (IO r)
  where
  buildStub :: Maybe MockName -> IO r -> IO r
buildStub Maybe MockName
_ = IO r -> IO r
forall a. a -> a
id

-- | Instance for building a mock for a function with a single parameter.
instance
  StubBuilder (Param r) r
  where
  buildStub :: Maybe MockName -> Param r -> r
buildStub Maybe MockName
_ = Param r -> r
forall v. Param v -> v
value

-- | Instance for building a mock for a function with multiple parameters.
instance StubBuilder (Cases (IO a) ()) (IO a) where
  buildStub :: Maybe MockName -> Cases (IO a) () -> IO a
buildStub Maybe MockName
_ Cases (IO a) ()
cases = do
    let params :: [IO a]
params = Cases (IO a) () -> [IO a]
forall a b. Cases a b -> [a]
runCase Cases (IO a) ()
cases
    TVar (InvocationRecord ())
s <- IO (TVar (InvocationRecord ())) -> IO (TVar (InvocationRecord ()))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (InvocationRecord ()))
 -> IO (TVar (InvocationRecord ())))
-> IO (TVar (InvocationRecord ()))
-> IO (TVar (InvocationRecord ()))
forall a b. (a -> b) -> a -> b
$ InvocationRecord () -> IO (TVar (InvocationRecord ()))
forall a. a -> IO (TVar a)
newTVarIO InvocationRecord ()
forall params. InvocationRecord params
invocationRecord
    (do
      Int
count <- TVar (InvocationRecord ()) -> () -> IO Int
forall params.
Eq params =>
TVar (InvocationRecord params) -> params -> IO Int
readInvocationCount TVar (InvocationRecord ())
s ()
      let index :: Int
index = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count ([IO a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IO a]
params Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          r :: Maybe (IO a)
r = [IO a] -> Int -> Maybe (IO a)
forall a. [a] -> Int -> Maybe a
safeIndex [IO a]
params Int
index
      TVar (InvocationRecord ()) -> () -> IO ()
forall params. TVar (InvocationRecord params) -> params -> IO ()
appendCalledParams TVar (InvocationRecord ())
s ()
      TVar (InvocationRecord ()) -> () -> IO ()
forall params.
Eq params =>
TVar (InvocationRecord params) -> params -> IO ()
incrementInvocationCount TVar (InvocationRecord ())
s ()
      Maybe (IO a) -> IO a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (IO a)
r)

-- | Overlapping instance for building a mock for a function with multiple parameters.
-- This instance is used when the parameter type is a 'Cases' type.
instance {-# OVERLAPPABLE #-}
  ( ParamConstraints params args r
  , BuildCurried args r fn
  , BuildCurriedPure args r fn
  ) => StubBuilder (Cases params ()) fn where
  buildStub :: Maybe MockName -> Cases params () -> fn
buildStub Maybe MockName
name Cases params ()
cases = do
    let paramsList :: [params]
paramsList = Cases params () -> [params]
forall a b. Cases a b -> [a]
runCase Cases params ()
cases
    (args -> r) -> fn
forall args r fn. BuildCurriedPure args r fn => (args -> r) -> fn
buildCurriedPure (Maybe MockName -> [params] -> args -> r
forall params args r.
ParamConstraints params args r =>
Maybe MockName -> InvocationList params -> args -> r
findReturnValueWithPure Maybe MockName
name [params]
paramsList)

instance {-# OVERLAPPABLE #-}
  ( p ~ (Param a :> rest)
  , ParamConstraints p args r
  , BuildCurried args r fn
  , BuildCurriedPure args r fn
  ) => StubBuilder (Param a :> rest) fn where
  buildStub :: Maybe MockName -> (Param a :> rest) -> fn
buildStub Maybe MockName
name Param a :> rest
params = (args -> r) -> fn
forall args r fn. BuildCurriedPure args r fn => (args -> r) -> fn
buildCurriedPure (Maybe MockName -> (Param a :> rest) -> args -> r
forall params args r.
ParamConstraints params args r =>
Maybe MockName -> params -> args -> r
extractReturnValue Maybe MockName
name Param a :> rest
params)

type ParamConstraints params args r =
  ( ProjectionArgs params
  , ProjectionReturn params
  , ArgsOf params ~ args
  , ReturnOf params ~ Param r
  , Eq args
  , Show args
  )

extractReturnValue :: ParamConstraints params args r => Maybe MockName -> params -> args -> r
extractReturnValue :: forall params args r.
ParamConstraints params args r =>
Maybe MockName -> params -> args -> r
extractReturnValue Maybe MockName
name params
params args
inputParams = do
  Maybe MockName -> args -> args -> ()
forall a. (Eq a, Show a) => Maybe MockName -> a -> a -> ()
validateOnly Maybe MockName
name (params -> ArgsOf params
forall params. ProjectionArgs params => params -> ArgsOf params
projArgs params
params) args
inputParams () -> r -> r
forall a b. a -> b -> b
`seq` params -> r
forall params r.
(ProjectionReturn params, ReturnOf params ~ Param r) =>
params -> r
returnValue params
params

validateOnly :: (Eq a, Show a) => Maybe MockName -> a -> a -> ()
validateOnly :: forall a. (Eq a, Show a) => Maybe MockName -> a -> a -> ()
validateOnly Maybe MockName
name a
expected a
actual = do
  Maybe MockName -> a -> a -> ()
forall a. (Eq a, Show a) => Maybe MockName -> a -> a -> ()
validateParamsPure Maybe MockName
name a
expected a
actual

validateParamsPure :: (Eq a, Show a) => Maybe MockName -> a -> a -> ()
validateParamsPure :: forall a. (Eq a, Show a) => Maybe MockName -> a -> a -> ()
validateParamsPure Maybe MockName
name a
expected a
actual =
  if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual
    then ()
    else MockName -> ()
forall a. MockName -> a
errorWithoutStackTrace (MockName -> ()) -> MockName -> ()
forall a b. (a -> b) -> a -> b
$ Maybe MockName -> a -> a -> MockName
forall a. Show a => Maybe MockName -> a -> a -> MockName
message Maybe MockName
name a
expected a
actual

findReturnValueWithPure ::
  ( ParamConstraints params args r
  ) =>
  Maybe MockName ->
  InvocationList params ->
  args ->
  r
findReturnValueWithPure :: forall params args r.
ParamConstraints params args r =>
Maybe MockName -> InvocationList params -> args -> r
findReturnValueWithPure Maybe MockName
name InvocationList params
paramsList args
inputParams = do
  let
    expectedArgs :: [args]
expectedArgs = params -> args
params -> ArgsOf params
forall params. ProjectionArgs params => params -> ArgsOf params
projArgs (params -> args) -> InvocationList params -> [args]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InvocationList params
paramsList
    r :: Maybe r
r = InvocationList params -> args -> Maybe r
forall params args r.
ParamConstraints params args r =>
InvocationList params -> args -> Maybe r
findReturnValuePure InvocationList params
paramsList args
inputParams
  r -> Maybe r -> r
forall a. a -> Maybe a -> a
fromMaybe (MockName -> r
forall a. MockName -> a
errorWithoutStackTrace (MockName -> r) -> MockName -> r
forall a b. (a -> b) -> a -> b
$ Maybe MockName -> [args] -> args -> MockName
forall a. Show a => Maybe MockName -> [a] -> a -> MockName
messageForMultiMock Maybe MockName
name [args]
expectedArgs args
inputParams) Maybe r
r

findReturnValuePure ::
  ( ParamConstraints params args r
  ) =>
  InvocationList params ->
  args ->
  Maybe r
findReturnValuePure :: forall params args r.
ParamConstraints params args r =>
InvocationList params -> args -> Maybe r
findReturnValuePure InvocationList params
paramsList args
inputParams = do
  let matchedParams :: InvocationList params
matchedParams = (params -> Bool) -> InvocationList params -> InvocationList params
forall a. (a -> Bool) -> [a] -> [a]
filter (\params
params -> params -> ArgsOf params
forall params. ProjectionArgs params => params -> ArgsOf params
projArgs params
params args -> args -> Bool
forall a. Eq a => a -> a -> Bool
== args
inputParams) InvocationList params
paramsList
  case InvocationList params
matchedParams of
    [] -> Maybe r
forall a. Maybe a
Nothing
    InvocationList params
_ -> do
      params -> r
forall params r.
(ProjectionReturn params, ReturnOf params ~ Param r) =>
params -> r
returnValue (params -> r) -> Maybe params -> Maybe r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InvocationList params -> Int -> Maybe params
forall a. [a] -> Int -> Maybe a
safeIndex InvocationList params
matchedParams Int
0

type InvocationStep args r = InvocationRecord args -> (InvocationRecord args, Either Message r)

executeInvocation ::
  TVar (InvocationRecord args) ->
  InvocationStep args r ->
  IO r
executeInvocation :: forall args r.
TVar (InvocationRecord args) -> InvocationStep args r -> IO r
executeInvocation TVar (InvocationRecord args)
ref InvocationStep args r
step = do
  Either MockName r
result <-
    STM (Either MockName r) -> IO (Either MockName r)
forall a. STM a -> IO a
atomically (STM (Either MockName r) -> IO (Either MockName r))
-> STM (Either MockName r) -> IO (Either MockName r)
forall a b. (a -> b) -> a -> b
$ do
      InvocationRecord args
current <- TVar (InvocationRecord args) -> STM (InvocationRecord args)
forall a. TVar a -> STM a
readTVar TVar (InvocationRecord args)
ref
      let (InvocationRecord args
next, Either MockName r
outcome) = InvocationStep args r
step InvocationRecord args
current
      TVar (InvocationRecord args) -> InvocationRecord args -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (InvocationRecord args)
ref InvocationRecord args
next
      Either MockName r -> STM (Either MockName r)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either MockName r
outcome
  (MockName -> IO r) -> (r -> IO r) -> Either MockName r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MockName -> IO r
forall a. MockName -> a
errorWithoutStackTrace r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either MockName r
result

singleInvocationStep ::
  ParamConstraints params args r =>
  Maybe MockName ->
  params ->
  args ->
  InvocationStep args r
singleInvocationStep :: forall params args r.
ParamConstraints params args r =>
Maybe MockName -> params -> args -> InvocationStep args r
singleInvocationStep Maybe MockName
name params
params args
inputParams record :: InvocationRecord args
record@InvocationRecord {InvocationList args
invocations :: forall params. InvocationRecord params -> InvocationList params
invocations :: InvocationList args
invocations, InvocationCounts args
invocationCounts :: forall params. InvocationRecord params -> InvocationCounts params
invocationCounts :: InvocationCounts args
invocationCounts} = do
  let expected :: ArgsOf params
expected = params -> ArgsOf params
forall params. ProjectionArgs params => params -> ArgsOf params
projArgs params
params
  if args
ArgsOf params
expected args -> args -> Bool
forall a. Eq a => a -> a -> Bool
== args
inputParams
    then
      (InvocationRecord {
        invocations :: InvocationList args
invocations = InvocationList args
invocations InvocationList args -> InvocationList args -> InvocationList args
forall a. [a] -> [a] -> [a]
++ [args
inputParams]
      , invocationCounts :: InvocationCounts args
invocationCounts = InvocationCounts args
invocationCounts
      }, r -> Either MockName r
forall a b. b -> Either a b
Right (params -> r
forall params r.
(ProjectionReturn params, ReturnOf params ~ Param r) =>
params -> r
returnValue params
params))
    else (InvocationRecord args
record, MockName -> Either MockName r
forall a b. a -> Either a b
Left (MockName -> Either MockName r) -> MockName -> Either MockName r
forall a b. (a -> b) -> a -> b
$ Maybe MockName -> args -> args -> MockName
forall a. Show a => Maybe MockName -> a -> a -> MockName
message Maybe MockName
name args
ArgsOf params
expected args
inputParams)

casesInvocationStep ::
  ParamConstraints params args r =>
  Maybe MockName ->
  InvocationList params ->
  args ->
  InvocationStep args r
casesInvocationStep :: forall params args r.
ParamConstraints params args r =>
Maybe MockName
-> InvocationList params -> args -> InvocationStep args r
casesInvocationStep Maybe MockName
name InvocationList params
paramsList args
inputParams InvocationRecord {InvocationList args
invocations :: forall params. InvocationRecord params -> InvocationList params
invocations :: InvocationList args
invocations, InvocationCounts args
invocationCounts :: forall params. InvocationRecord params -> InvocationCounts params
invocationCounts :: InvocationCounts args
invocationCounts} = do
  let newInvocations :: InvocationList args
newInvocations = InvocationList args
invocations InvocationList args -> InvocationList args -> InvocationList args
forall a. [a] -> [a] -> [a]
++ [args
inputParams]
      matchedParams :: InvocationList params
matchedParams = (params -> Bool) -> InvocationList params -> InvocationList params
forall a. (a -> Bool) -> [a] -> [a]
filter (\params
params -> params -> ArgsOf params
forall params. ProjectionArgs params => params -> ArgsOf params
projArgs params
params args -> args -> Bool
forall a. Eq a => a -> a -> Bool
== args
inputParams) InvocationList params
paramsList
      expectedArgs :: InvocationList args
expectedArgs = params -> args
params -> ArgsOf params
forall params. ProjectionArgs params => params -> ArgsOf params
projArgs (params -> args) -> InvocationList params -> InvocationList args
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InvocationList params
paramsList
    in case InvocationList params
matchedParams of
        [] ->
          ( InvocationRecord {invocations :: InvocationList args
invocations = InvocationList args
newInvocations, InvocationCounts args
invocationCounts :: InvocationCounts args
invocationCounts :: InvocationCounts args
invocationCounts},
            MockName -> Either MockName r
forall a b. a -> Either a b
Left (Maybe MockName -> InvocationList args -> args -> MockName
forall a. Show a => Maybe MockName -> [a] -> a -> MockName
messageForMultiMock Maybe MockName
name InvocationList args
expectedArgs args
inputParams)
          )
        InvocationList params
_ ->
          let calledCount :: Int
calledCount = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (args -> InvocationCounts args -> Maybe Int
forall k a. Eq k => k -> AssociationList k a -> Maybe a
lookup args
inputParams InvocationCounts args
invocationCounts)
              index :: Int
index = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
calledCount (InvocationList params -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InvocationList params
matchedParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              nextCounter :: InvocationCounts args
nextCounter = args -> InvocationCounts args -> InvocationCounts args
forall k. Eq k => k -> InvocationCounts k -> InvocationCounts k
incrementCount args
inputParams InvocationCounts args
invocationCounts
              nextRecord :: InvocationRecord args
nextRecord =
                InvocationRecord
                  { invocations :: InvocationList args
invocations = InvocationList args
newInvocations,
                    invocationCounts :: InvocationCounts args
invocationCounts = InvocationCounts args
nextCounter
                  }
            in case InvocationList params -> Int -> Maybe params
forall a. [a] -> Int -> Maybe a
safeIndex InvocationList params
matchedParams Int
index of
                Maybe params
Nothing ->
                  ( InvocationRecord args
nextRecord,
                    MockName -> Either MockName r
forall a b. a -> Either a b
Left (Maybe MockName -> InvocationList args -> args -> MockName
forall a. Show a => Maybe MockName -> [a] -> a -> MockName
messageForMultiMock Maybe MockName
name InvocationList args
expectedArgs args
inputParams)
                  )
                Just params
selected ->
                  (InvocationRecord args
nextRecord, r -> Either MockName r
forall a b. b -> Either a b
Right (params -> r
forall params r.
(ProjectionReturn params, ReturnOf params ~ Param r) =>
params -> r
returnValue params
selected))