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

module Test.HMock.Internal.MockT where

import Control.Concurrent (MVar)
import Control.Monad (forM_, unless)
import Control.Monad.Base (MonadBase)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Cont (MonadCont)
import Control.Monad.Except (MonadError)
import Control.Monad.RWS (MonadRWS)
import Control.Monad.Reader
  ( MonadReader (ask, local, reader),
    ReaderT,
    mapReaderT,
    runReaderT,
  )
import Control.Monad.State (MonadState)
import Control.Monad.Trans (MonadIO, MonadTrans, lift)
import Control.Monad.Writer (MonadWriter)
import Data.Default (Default (def))
import Data.Either (partitionEithers)
import Data.Function (on)
import Data.List (intercalate, sortBy)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (TypeRep, Typeable, cast, typeRep)
import GHC.Stack
import Test.HMock.Internal.ExpectSet
import Test.HMock.Internal.Expectable
import Test.HMock.Internal.Mockable
import Test.HMock.Internal.Util (Located (..), locate, withLoc)
import UnliftIO (MonadUnliftIO, newMVar, putMVar, readMVar, takeMVar)

#if !MIN_VERSION_base(4, 13, 0)
import Control.Monad.Fail (MonadFail)
#endif

data MockState m = MockState
  { MockState m -> ExpectSet (Step m)
mockExpectSet :: ExpectSet (Step m),
    MockState m -> [Step m]
mockDefaults :: [Step m],
    MockState m -> Set TypeRep
mockClasses :: Set TypeRep
  }

initMockState :: MockState m
initMockState :: MockState m
initMockState =
  MockState :: forall (m :: * -> *).
ExpectSet (Step m) -> [Step m] -> Set TypeRep -> MockState m
MockState
    { mockExpectSet :: ExpectSet (Step m)
mockExpectSet = ExpectSet (Step m)
forall step. ExpectSet step
ExpectNothing,
      mockDefaults :: [Step m]
mockDefaults = [],
      mockClasses :: Set TypeRep
mockClasses = Set TypeRep
forall a. Set a
Set.empty
    }

-- | Monad transformer for running mocks.
newtype MockT m a where
  MockT :: {MockT m a -> ReaderT (MVar (MockState m)) m a
unMockT :: ReaderT (MVar (MockState m)) m a} -> MockT m a
  deriving
    ( a -> MockT m b -> MockT m a
(a -> b) -> MockT m a -> MockT m b
(forall a b. (a -> b) -> MockT m a -> MockT m b)
-> (forall a b. a -> MockT m b -> MockT m a) -> Functor (MockT m)
forall a b. a -> MockT m b -> MockT m a
forall a b. (a -> b) -> MockT m a -> MockT m b
forall (m :: * -> *) a b. Functor m => a -> MockT m b -> MockT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockT m a -> MockT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MockT m b -> MockT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> MockT m b -> MockT m a
fmap :: (a -> b) -> MockT m a -> MockT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockT m a -> MockT m b
Functor,
      Functor (MockT m)
a -> MockT m a
Functor (MockT m)
-> (forall a. a -> MockT m a)
-> (forall a b. MockT m (a -> b) -> MockT m a -> MockT m b)
-> (forall a b c.
    (a -> b -> c) -> MockT m a -> MockT m b -> MockT m c)
-> (forall a b. MockT m a -> MockT m b -> MockT m b)
-> (forall a b. MockT m a -> MockT m b -> MockT m a)
-> Applicative (MockT m)
MockT m a -> MockT m b -> MockT m b
MockT m a -> MockT m b -> MockT m a
MockT m (a -> b) -> MockT m a -> MockT m b
(a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
forall a. a -> MockT m a
forall a b. MockT m a -> MockT m b -> MockT m a
forall a b. MockT m a -> MockT m b -> MockT m b
forall a b. MockT m (a -> b) -> MockT m a -> MockT m b
forall a b c. (a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (MockT m)
forall (m :: * -> *) a. Applicative m => a -> MockT m a
forall (m :: * -> *) a b.
Applicative m =>
MockT m a -> MockT m b -> MockT m a
forall (m :: * -> *) a b.
Applicative m =>
MockT m a -> MockT m b -> MockT m b
forall (m :: * -> *) a b.
Applicative m =>
MockT m (a -> b) -> MockT m a -> MockT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
<* :: MockT m a -> MockT m b -> MockT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
MockT m a -> MockT m b -> MockT m a
*> :: MockT m a -> MockT m b -> MockT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
MockT m a -> MockT m b -> MockT m b
liftA2 :: (a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
<*> :: MockT m (a -> b) -> MockT m a -> MockT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
MockT m (a -> b) -> MockT m a -> MockT m b
pure :: a -> MockT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MockT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (MockT m)
Applicative,
      Applicative (MockT m)
a -> MockT m a
Applicative (MockT m)
-> (forall a b. MockT m a -> (a -> MockT m b) -> MockT m b)
-> (forall a b. MockT m a -> MockT m b -> MockT m b)
-> (forall a. a -> MockT m a)
-> Monad (MockT m)
MockT m a -> (a -> MockT m b) -> MockT m b
MockT m a -> MockT m b -> MockT m b
forall a. a -> MockT m a
forall a b. MockT m a -> MockT m b -> MockT m b
forall a b. MockT m a -> (a -> MockT m b) -> MockT m b
forall (m :: * -> *). Monad m => Applicative (MockT m)
forall (m :: * -> *) a. Monad m => a -> MockT m a
forall (m :: * -> *) a b.
Monad m =>
MockT m a -> MockT m b -> MockT m b
forall (m :: * -> *) a b.
Monad m =>
MockT m a -> (a -> MockT m b) -> MockT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> MockT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MockT m a
>> :: MockT m a -> MockT m b -> MockT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MockT m a -> MockT m b -> MockT m b
>>= :: MockT m a -> (a -> MockT m b) -> MockT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MockT m a -> (a -> MockT m b) -> MockT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (MockT m)
Monad,
      Monad (MockT m)
Monad (MockT m)
-> (forall a. String -> MockT m a) -> MonadFail (MockT m)
String -> MockT m a
forall a. String -> MockT m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (MockT m)
forall (m :: * -> *) a. MonadFail m => String -> MockT m a
fail :: String -> MockT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> MockT m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (MockT m)
MonadFail,
      Monad (MockT m)
Monad (MockT m)
-> (forall a. IO a -> MockT m a) -> MonadIO (MockT m)
IO a -> MockT m a
forall a. IO a -> MockT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (MockT m)
forall (m :: * -> *) a. MonadIO m => IO a -> MockT m a
liftIO :: IO a -> MockT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MockT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (MockT m)
MonadIO,
      MonadState s,
      MonadWriter w,
      MonadRWS r w s,
      MonadError e,
      Monad (MockT m)
Monad (MockT m)
-> (forall a b. ((a -> MockT m b) -> MockT m a) -> MockT m a)
-> MonadCont (MockT m)
((a -> MockT m b) -> MockT m a) -> MockT m a
forall a b. ((a -> MockT m b) -> MockT m a) -> MockT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall (m :: * -> *). MonadCont m => Monad (MockT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> MockT m b) -> MockT m a) -> MockT m a
callCC :: ((a -> MockT m b) -> MockT m a) -> MockT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> MockT m b) -> MockT m a) -> MockT m a
$cp1MonadCont :: forall (m :: * -> *). MonadCont m => Monad (MockT m)
MonadCont,
      MonadBase b,
      MonadThrow (MockT m)
MonadThrow (MockT m)
-> (forall e a.
    Exception e =>
    MockT m a -> (e -> MockT m a) -> MockT m a)
-> MonadCatch (MockT m)
MockT m a -> (e -> MockT m a) -> MockT m a
forall e a.
Exception e =>
MockT m a -> (e -> MockT m a) -> MockT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (MockT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
MockT m a -> (e -> MockT m a) -> MockT m a
catch :: MockT m a -> (e -> MockT m a) -> MockT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
MockT m a -> (e -> MockT m a) -> MockT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (MockT m)
MonadCatch,
      MonadCatch (MockT m)
MonadCatch (MockT m)
-> (forall b.
    ((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b)
-> (forall b.
    ((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b)
-> (forall a b c.
    MockT m a
    -> (a -> ExitCase b -> MockT m c)
    -> (a -> MockT m b)
    -> MockT m (b, c))
-> MonadMask (MockT m)
MockT m a
-> (a -> ExitCase b -> MockT m c)
-> (a -> MockT m b)
-> MockT m (b, c)
((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b
((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b
forall b.
((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b
forall a b c.
MockT m a
-> (a -> ExitCase b -> MockT m c)
-> (a -> MockT m b)
-> MockT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (MockT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b
forall (m :: * -> *) a b c.
MonadMask m =>
MockT m a
-> (a -> ExitCase b -> MockT m c)
-> (a -> MockT m b)
-> MockT m (b, c)
generalBracket :: MockT m a
-> (a -> ExitCase b -> MockT m c)
-> (a -> MockT m b)
-> MockT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
MockT m a
-> (a -> ExitCase b -> MockT m c)
-> (a -> MockT m b)
-> MockT m (b, c)
uninterruptibleMask :: ((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b
mask :: ((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. MockT m a -> MockT m a) -> MockT m b) -> MockT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (MockT m)
MonadMask,
      Monad (MockT m)
e -> MockT m a
Monad (MockT m)
-> (forall e a. Exception e => e -> MockT m a)
-> MonadThrow (MockT m)
forall e a. Exception e => e -> MockT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (MockT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> MockT m a
throwM :: e -> MockT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> MockT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (MockT m)
MonadThrow,
      MonadIO (MockT m)
MonadIO (MockT m)
-> (forall b. ((forall a. MockT m a -> IO a) -> IO b) -> MockT m b)
-> MonadUnliftIO (MockT m)
((forall a. MockT m a -> IO a) -> IO b) -> MockT m b
forall b. ((forall a. MockT m a -> IO a) -> IO b) -> MockT m b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
forall (m :: * -> *). MonadUnliftIO m => MonadIO (MockT m)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. MockT m a -> IO a) -> IO b) -> MockT m b
withRunInIO :: ((forall a. MockT m a -> IO a) -> IO b) -> MockT m b
$cwithRunInIO :: forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. MockT m a -> IO a) -> IO b) -> MockT m b
$cp1MonadUnliftIO :: forall (m :: * -> *). MonadUnliftIO m => MonadIO (MockT m)
MonadUnliftIO
    )

instance MonadTrans MockT where
  lift :: m a -> MockT m a
lift = ReaderT (MVar (MockState m)) m a -> MockT m a
forall (m :: * -> *) a.
ReaderT (MVar (MockState m)) m a -> MockT m a
MockT (ReaderT (MVar (MockState m)) m a -> MockT m a)
-> (m a -> ReaderT (MVar (MockState m)) m a) -> m a -> MockT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (MVar (MockState m)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

mapMockT :: (m a -> m b) -> MockT m a -> MockT m b
mapMockT :: (m a -> m b) -> MockT m a -> MockT m b
mapMockT m a -> m b
f = ReaderT (MVar (MockState m)) m b -> MockT m b
forall (m :: * -> *) a.
ReaderT (MVar (MockState m)) m a -> MockT m a
MockT (ReaderT (MVar (MockState m)) m b -> MockT m b)
-> (MockT m a -> ReaderT (MVar (MockState m)) m b)
-> MockT m a
-> MockT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> m b)
-> ReaderT (MVar (MockState m)) m a
-> ReaderT (MVar (MockState m)) m b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m b
f (ReaderT (MVar (MockState m)) m a
 -> ReaderT (MVar (MockState m)) m b)
-> (MockT m a -> ReaderT (MVar (MockState m)) m a)
-> MockT m a
-> ReaderT (MVar (MockState m)) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockT m a -> ReaderT (MVar (MockState m)) m a
forall (m :: * -> *) a.
MockT m a -> ReaderT (MVar (MockState m)) m a
unMockT

initClassIfNeeded ::
  forall cls m proxy.
  (Mockable cls, Typeable m, MonadIO m) =>
  proxy cls ->
  MockT m ()
initClassIfNeeded :: proxy cls -> MockT m ()
initClassIfNeeded proxy cls
proxy =
  do
    MVar (MockState m)
stateVar <- ReaderT (MVar (MockState m)) m (MVar (MockState m))
-> MockT m (MVar (MockState m))
forall (m :: * -> *) a.
ReaderT (MVar (MockState m)) m a -> MockT m a
MockT ReaderT (MVar (MockState m)) m (MVar (MockState m))
forall r (m :: * -> *). MonadReader r m => m r
ask
    MockState m
mockState <- MVar (MockState m) -> MockT m (MockState m)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar (MockState m)
stateVar
    let newMockClasses :: Set TypeRep
newMockClasses = TypeRep -> Set TypeRep -> Set TypeRep
forall a. Ord a => a -> Set a -> Set a
Set.insert TypeRep
t (MockState m -> Set TypeRep
forall (m :: * -> *). MockState m -> Set TypeRep
mockClasses MockState m
mockState)
    MVar (MockState m) -> MockState m -> MockT m ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar (MockState m)
stateVar (MockState m
mockState {mockClasses :: Set TypeRep
mockClasses = Set TypeRep
newMockClasses})
    Bool -> MockT m () -> MockT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TypeRep
t TypeRep -> Set TypeRep -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` MockState m -> Set TypeRep
forall (m :: * -> *). MockState m -> Set TypeRep
mockClasses MockState m
mockState) (MockT m () -> MockT m ()) -> MockT m () -> MockT m ()
forall a b. (a -> b) -> a -> b
$ do
      Proxy cls -> MockT m ()
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
       (proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, MonadIO m, Typeable m) =>
proxy cls -> MockT m ()
setupMockable (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls)
  where
    t :: TypeRep
t = proxy cls -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep proxy cls
proxy

initClassesAsNeeded :: MonadIO m => ExpectSet (Step m) -> MockT m ()
initClassesAsNeeded :: ExpectSet (Step m) -> MockT m ()
initClassesAsNeeded ExpectSet (Step m)
es = [Step m] -> (Step m -> MockT m ()) -> MockT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ExpectSet (Step m) -> [Step m]
forall step. ExpectSet step -> [step]
getSteps ExpectSet (Step m)
es) ((Step m -> MockT m ()) -> MockT m ())
-> (Step m -> MockT m ()) -> MockT m ()
forall a b. (a -> b) -> a -> b
$
  \(Step (Located (SingleRule cls name m r)
_ :: Located (SingleRule cls name m r))) ->
    Proxy cls -> MockT m ()
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
       (proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, Typeable m, MonadIO m) =>
proxy cls -> MockT m ()
initClassIfNeeded (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls)

instance MonadReader r m => MonadReader r (MockT m) where
  ask :: MockT m r
ask = m r -> MockT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> MockT m a -> MockT m a
local = (m a -> m a) -> MockT m a -> MockT m a
forall (m :: * -> *) a b. (m a -> m b) -> MockT m a -> MockT m b
mapMockT ((m a -> m a) -> MockT m a -> MockT m a)
-> ((r -> r) -> m a -> m a) -> (r -> r) -> MockT m a -> MockT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
  reader :: (r -> a) -> MockT m a
reader = m a -> MockT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MockT m a) -> ((r -> a) -> m a) -> (r -> a) -> MockT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

instance ExpectContext MockT where
  fromExpectSet :: ExpectSet (Step m) -> MockT m ()
fromExpectSet ExpectSet (Step m)
e = do
    ExpectSet (Step m) -> MockT m ()
forall (m :: * -> *). MonadIO m => ExpectSet (Step m) -> MockT m ()
initClassesAsNeeded ExpectSet (Step m)
e
    MVar (MockState m)
stateVar <- ReaderT (MVar (MockState m)) m (MVar (MockState m))
-> MockT m (MVar (MockState m))
forall (m :: * -> *) a.
ReaderT (MVar (MockState m)) m a -> MockT m a
MockT ReaderT (MVar (MockState m)) m (MVar (MockState m))
forall r (m :: * -> *). MonadReader r m => m r
ask
    MockState m
mockState <- MVar (MockState m) -> MockT m (MockState m)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar (MockState m)
stateVar
    let newExpectSet :: ExpectSet (Step m)
newExpectSet = ExpectSet (Step m)
e ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
`ExpectInterleave` MockState m -> ExpectSet (Step m)
forall (m :: * -> *). MockState m -> ExpectSet (Step m)
mockExpectSet MockState m
mockState
    MVar (MockState m) -> MockState m -> MockT m ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar (MockState m)
stateVar (MockState m
mockState {mockExpectSet :: ExpectSet (Step m)
mockExpectSet = ExpectSet (Step m)
newExpectSet})

-- | 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
--    'expect' '$' ...
--
--    'liftIO' '$' 'forkIO' '$' inMockT firstThread
--    'liftIO' '$' '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
  MVar (MockState m)
stateVar <- MockState m -> m (MVar (MockState m))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar MockState m
forall (m :: * -> *). MockState m
initMockState
  let inMockT :: forall a. MockT m a -> m a
      inMockT :: MockT m a -> m a
inMockT MockT m a
m = ReaderT (MVar (MockState m)) m a -> MVar (MockState m) -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (MockT m a -> ReaderT (MVar (MockState m)) m a
forall (m :: * -> *) a.
MockT m a -> ReaderT (MVar (MockState m)) m a
unMockT MockT m a
m) MVar (MockState m)
stateVar
  (ReaderT (MVar (MockState m)) m b -> MVar (MockState m) -> m b)
-> MVar (MockState m) -> ReaderT (MVar (MockState m)) m b -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (MVar (MockState m)) m b -> MVar (MockState m) -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT MVar (MockState m)
stateVar (ReaderT (MVar (MockState m)) m b -> m b)
-> ReaderT (MVar (MockState m)) m b -> m b
forall a b. (a -> b) -> a -> b
$
    MockT m b -> ReaderT (MVar (MockState m)) m b
forall (m :: * -> *) a.
MockT m a -> ReaderT (MVar (MockState m)) m a
unMockT (MockT m b -> ReaderT (MVar (MockState m)) m b)
-> MockT m b -> ReaderT (MVar (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

-- | 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 =
  ExpectSet (Step m) -> String
forall step. Show step => ExpectSet step -> String
formatExpectSet (ExpectSet (Step m) -> String)
-> MockT m (ExpectSet (Step m)) -> MockT m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderT (MVar (MockState m)) m (MVar (MockState m))
-> MockT m (MVar (MockState m))
forall (m :: * -> *) a.
ReaderT (MVar (MockState m)) m a -> MockT m a
MockT ReaderT (MVar (MockState m)) m (MVar (MockState m))
forall r (m :: * -> *). MonadReader r m => m r
ask MockT m (MVar (MockState m))
-> (MVar (MockState m) -> MockT m (ExpectSet (Step m)))
-> MockT m (ExpectSet (Step m))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MockState m -> ExpectSet (Step m))
-> MockT m (MockState m) -> MockT m (ExpectSet (Step m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MockState m -> ExpectSet (Step m)
forall (m :: * -> *). MockState m -> ExpectSet (Step m)
mockExpectSet (MockT m (MockState m) -> MockT m (ExpectSet (Step m)))
-> (MVar (MockState m) -> MockT m (MockState m))
-> MVar (MockState m)
-> MockT m (ExpectSet (Step m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (MockState m) -> MockT m (MockState m)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar)

-- | Verifies that all mock expectations are satisfied.  You normally don't need
-- to do this, because it happens automatically at the end of your test in
-- 'runMockT'.  However, it's occasionally useful to check expectations in the
-- middle of a test, such as before going on to the next stage.
--
-- 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 = do
  ExpectSet (Step m)
expectSet <- ReaderT (MVar (MockState m)) m (MVar (MockState m))
-> MockT m (MVar (MockState m))
forall (m :: * -> *) a.
ReaderT (MVar (MockState m)) m a -> MockT m a
MockT ReaderT (MVar (MockState m)) m (MVar (MockState m))
forall r (m :: * -> *). MonadReader r m => m r
ask MockT m (MVar (MockState m))
-> (MVar (MockState m) -> MockT m (ExpectSet (Step m)))
-> MockT m (ExpectSet (Step m))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MockState m -> ExpectSet (Step m))
-> MockT m (MockState m) -> MockT m (ExpectSet (Step m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MockState m -> ExpectSet (Step m)
forall (m :: * -> *). MockState m -> ExpectSet (Step m)
mockExpectSet (MockT m (MockState m) -> MockT m (ExpectSet (Step m)))
-> (MVar (MockState m) -> MockT m (MockState m))
-> MVar (MockState m)
-> MockT m (ExpectSet (Step m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (MockState m) -> MockT m (MockState m)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar
  Bool -> MockT m () -> MockT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExpectSet (Step m) -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet (Step m)
expectSet) (MockT m () -> MockT m ()) -> MockT m () -> MockT m ()
forall a b. (a -> b) -> a -> b
$ do
    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 ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ExpectSet (Step m)
missing -> String -> MockT m ()
forall a. HasCallStack => String -> a
error (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

-- | Changes the default response for matching actions.
--
-- Without 'byDefault', actions with no explicit response will return the
-- 'Default' value for the type, or 'undefined' if the return type isn't an
-- instance of 'Default'.  'byDefault' replaces that with a new default
-- response, also overriding any previous defaults. The rule passed in must have
-- exactly one response.
byDefault ::
  forall cls name m r.
  (MonadIO m, MockableMethod cls name m r) =>
  Rule cls name m r ->
  MockT m ()
byDefault :: Rule cls name m r -> MockT m ()
byDefault (Matcher cls name m r
m :=> [Action cls name m r -> MockT m r
r]) = do
  Proxy cls -> MockT m ()
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
       (proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, Typeable m, MonadIO m) =>
proxy cls -> MockT m ()
initClassIfNeeded (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls)
  MVar (MockState m)
stateVar <- ReaderT (MVar (MockState m)) m (MVar (MockState m))
-> MockT m (MVar (MockState m))
forall (m :: * -> *) a.
ReaderT (MVar (MockState m)) m a -> MockT m a
MockT ReaderT (MVar (MockState m)) m (MVar (MockState m))
forall r (m :: * -> *). MonadReader r m => m r
ask
  MockState m
mockState <- MVar (MockState m) -> MockT m (MockState m)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar (MockState m)
stateVar
  let newDefaults :: [Step m]
newDefaults =
        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 (Matcher cls name m r
m Matcher 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.
Matcher 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]
: MockState m -> [Step m]
forall (m :: * -> *). MockState m -> [Step m]
mockDefaults MockState m
mockState
  MVar (MockState m) -> MockState m -> MockT m ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar (MockState m)
stateVar (MockState m
mockState {mockDefaults :: [Step m]
mockDefaults = [Step m]
newDefaults})
byDefault Rule cls name m r
_ = String -> MockT m ()
forall a. HasCallStack => String -> a
error String
"Defaults must have exactly one response."

mockMethodImpl ::
  forall cls name m r.
  ( HasCallStack,
    MonadIO m,
    MockableMethod cls name m r
  ) =>
  r ->
  Action cls name m r ->
  MockT m r
mockMethodImpl :: r -> Action cls name m r -> MockT m r
mockMethodImpl r
surrogate Action cls name m r
action =
  do
    Proxy cls -> MockT m ()
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
       (proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, Typeable m, MonadIO m) =>
proxy cls -> MockT m ()
initClassIfNeeded (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls)
    MVar (MockState m)
stateVar <- ReaderT (MVar (MockState m)) m (MVar (MockState m))
-> MockT m (MVar (MockState m))
forall (m :: * -> *) a.
ReaderT (MVar (MockState m)) m a -> MockT m a
MockT ReaderT (MVar (MockState m)) m (MVar (MockState m))
forall r (m :: * -> *). MonadReader r m => m r
ask
    MockState m
mockState <- MVar (MockState m) -> MockT m (MockState m)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar (MockState m)
stateVar
    let (ExpectSet (Step m)
newExpectSet, MockT m r
response) =
          ExpectSet (Step m) -> [Step m] -> (ExpectSet (Step m), MockT m r)
decideAction (MockState m -> ExpectSet (Step m)
forall (m :: * -> *). MockState m -> ExpectSet (Step m)
mockExpectSet MockState m
mockState) (MockState m -> [Step m]
forall (m :: * -> *). MockState m -> [Step m]
mockDefaults MockState m
mockState)
    MVar (MockState m) -> MockState m -> MockT m ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar (MockState m)
stateVar MockState m
mockState {mockExpectSet :: ExpectSet (Step m)
mockExpectSet = ExpectSet (Step m)
newExpectSet}
    MockT m r
response
  where
    decideAction :: ExpectSet (Step m) -> [Step m] -> (ExpectSet (Step m), MockT m r)
decideAction ExpectSet (Step m)
expectSet [Step m]
defaults =
      let ([Maybe (Int, String)]
partial, [(ExpectSet (Step m), Maybe (MockT m r))]
full) = [Either
   (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))]
-> ([Maybe (Int, String)],
    [(ExpectSet (Step m), Maybe (MockT m r))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((Step m, ExpectSet (Step m))
-> Either
     (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))
tryMatch ((Step m, ExpectSet (Step m))
 -> Either
      (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r)))
-> [(Step m, ExpectSet (Step m))]
-> [Either
      (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpectSet (Step m) -> [(Step m, ExpectSet (Step m))]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet (Step m)
expectSet)
          orderedPartial :: [String]
orderedPartial = (Int, String) -> String
forall a b. (a, b) -> b
snd ((Int, String) -> String) -> [(Int, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, String) -> (Int, String) -> Ordering)
-> [(Int, String)] -> [(Int, String)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, String) -> Int)
-> (Int, String)
-> (Int, String)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, String) -> Int
forall a b. (a, b) -> a
fst) ([Maybe (Int, String)] -> [(Int, String)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, String)]
partial)
       in case ([(ExpectSet (Step m), Maybe (MockT m r))]
full, [Step m] -> Maybe (MockT m r)
findDefault [Step m]
defaults, r
surrogate, [String]
orderedPartial) of
            ((ExpectSet (Step m)
e, Just MockT m r
response) : [(ExpectSet (Step m), Maybe (MockT m r))]
_, Maybe (MockT m r)
_, r
_, [String]
_) -> (ExpectSet (Step m)
e, MockT m r
response)
            ((ExpectSet (Step m)
e, Maybe (MockT m r)
Nothing) : [(ExpectSet (Step m), Maybe (MockT m r))]
_, Maybe (MockT m r)
d, r
s, [String]
_) -> (ExpectSet (Step m)
e, MockT m r -> Maybe (MockT m r) -> MockT m r
forall a. a -> Maybe a -> a
fromMaybe (r -> MockT m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
s) Maybe (MockT m r)
d)
            ([], Maybe (MockT m r)
_, r
_, []) -> String -> (ExpectSet (Step m), MockT m r)
forall a. HasCallStack => String -> a
error (String -> (ExpectSet (Step m), MockT m r))
-> String -> (ExpectSet (Step m), MockT m r)
forall a b. (a -> b) -> a -> b
$ Action cls name m r -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) a.
(HasCallStack, Mockable cls) =>
Action cls name m a -> String
noMatchError Action cls name m r
action
            ([], Maybe (MockT m r)
_, r
_, [String]
_) -> String -> (ExpectSet (Step m), MockT m r)
forall a. HasCallStack => String -> a
error (String -> (ExpectSet (Step m), MockT m r))
-> String -> (ExpectSet (Step m), MockT m r)
forall a b. (a -> b) -> a -> b
$ Action cls name m r -> [String] -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) a.
(HasCallStack, Mockable cls) =>
Action cls name m a -> [String] -> String
partialMatchError Action cls name m r
action [String]
orderedPartial
    tryMatch ::
      (Step m, ExpectSet (Step m)) ->
      Either (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))
    tryMatch :: (Step m, ExpectSet (Step m))
-> Either
     (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))
tryMatch (Step Located (SingleRule cls name m r)
expected, ExpectSet (Step m)
e)
      | Just lrule :: Located (SingleRule cls name m r)
lrule@(Loc Maybe String
_ (Matcher cls name m r
m :-> Maybe (Action cls name m r -> MockT m r)
impl)) <- Located (SingleRule cls name m r)
-> Maybe (Located (SingleRule cls name m r))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located (SingleRule cls name m r)
expected =
        case Matcher cls name m r -> Action cls name m r -> MatchResult
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) a.
MockableBase cls =>
Matcher cls name m a -> Action cls name m a -> MatchResult
matchAction Matcher cls name m r
m Action cls name m r
action of
          NoMatch Int
n ->
            Maybe (Int, String)
-> Either
     (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))
forall a b. a -> Either a b
Left ((Int, String) -> Maybe (Int, String)
forall a. a -> Maybe a
Just (Int
n, Located String -> String
withLoc (Maybe (Action cls name m r) -> Matcher cls name m r -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) a b.
MockableBase cls =>
Maybe (Action cls name m a) -> Matcher cls name m b -> String
showMatcher (Action cls name m r -> Maybe (Action cls name m r)
forall a. a -> Maybe a
Just Action cls name m r
action) Matcher cls name m r
m String -> Located (SingleRule cls name m r) -> Located String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Located (SingleRule cls name m r)
lrule)))
          MatchResult
Match ->
            (ExpectSet (Step m), Maybe (MockT m r))
-> Either
     (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))
forall a b. b -> Either a b
Right (ExpectSet (Step m)
e, ((Action cls name m r -> MockT m r)
-> Action cls name m r -> MockT m r
forall a b. (a -> b) -> a -> b
$ Action cls name m r
action) ((Action cls name m r -> MockT m r) -> MockT m r)
-> Maybe (Action cls name m r -> MockT m r) -> Maybe (MockT m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Action cls name m r -> MockT m r)
impl)
      | Bool
otherwise = Maybe (Int, String)
-> Either
     (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))
forall a b. a -> Either a b
Left Maybe (Int, String)
forall a. Maybe a
Nothing

    findDefault :: [Step m] -> Maybe (MockT m r)
    findDefault :: [Step m] -> Maybe (MockT m r)
findDefault [] = Maybe (MockT m r)
forall a. Maybe a
Nothing
    findDefault (Step Located (SingleRule cls name m r)
expected : [Step m]
_)
      | Just (Loc Maybe String
_ (Matcher cls name m r
m :-> Just Action cls name m r -> MockT m r
r)) <- Located (SingleRule cls name m r)
-> Maybe (Located (SingleRule cls name m r))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located (SingleRule cls name m r)
expected,
        MatchResult
Match <- Matcher cls name m r -> Action cls name m r -> MatchResult
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) a.
MockableBase cls =>
Matcher cls name m a -> Action cls name m a -> MatchResult
matchAction Matcher cls name m r
m Action cls name m r
action =
        MockT m r -> Maybe (MockT m r)
forall a. a -> Maybe a
Just (Action cls name m r -> MockT m r
r Action cls name m r
action)
    findDefault (Step m
_ : [Step m]
steps) = [Step m] -> Maybe (MockT m r)
findDefault [Step m]
steps

-- | Implements a method in a 'Mockable' monad by delegating to the mock
-- framework.  If the method is called unexpectedly, an exception will be
-- thrown.  However, an expected invocation without a specified response will
-- return the default value.
mockMethod ::
  forall cls name m r.
  ( HasCallStack,
    MonadIO m,
    MockableMethod cls name m r,
    Default r
  ) =>
  Action cls name m r ->
  MockT m r
mockMethod :: Action cls name m r -> MockT m r
mockMethod Action cls name m r
action =
  (HasCallStack => MockT m r) -> MockT m r
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => MockT m r) -> MockT m r)
-> (HasCallStack => MockT m r) -> MockT m r
forall a b. (a -> b) -> a -> b
$ r -> Action cls name m r -> MockT m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) r.
(HasCallStack, MonadIO m, MockableMethod cls name m r) =>
r -> Action cls name m r -> MockT m r
mockMethodImpl r
forall a. Default a => a
def Action cls name m r
action

-- | Implements a method in a 'Mockable' monad by delegating to the mock
-- framework.  If the method is called unexpectedly, an exception will be
-- thrown.  However, an expected invocation without a specified response will
-- return undefined.  This can be used in place of 'mockMethod' when the return
-- type has no default.
mockDefaultlessMethod ::
  forall cls name m r.
  ( HasCallStack,
    MonadIO m,
    MockableMethod cls name m r
  ) =>
  Action cls name m r ->
  MockT m r
mockDefaultlessMethod :: Action cls name m r -> MockT m r
mockDefaultlessMethod Action cls name m r
action =
  (HasCallStack => MockT m r) -> MockT m r
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => MockT m r) -> MockT m r)
-> (HasCallStack => MockT m r) -> MockT m r
forall a b. (a -> b) -> a -> b
$ r -> Action cls name m r -> MockT m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) r.
(HasCallStack, MonadIO m, MockableMethod cls name m r) =>
r -> Action cls name m r -> MockT m r
mockMethodImpl r
forall a. HasCallStack => a
undefined Action cls name m r
action

-- An error for an action that matches no expectations at all.
noMatchError ::
  (HasCallStack, Mockable cls) =>
  -- | The action that was received.
  Action cls name m a ->
  String
noMatchError :: Action cls name m a -> String
noMatchError Action cls name m a
a =
  String
"Unexpected action: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Action cls name m a -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m a
a

-- An error for an action that doesn't match the argument predicates for any
-- of the method's expectations.
partialMatchError ::
  (HasCallStack, Mockable cls) =>
  -- | The action that was received.
  Action cls name m a ->
  -- | Descriptions of the matchers that most closely matched, closest first.
  [String] ->
  String
partialMatchError :: Action cls name m a -> [String] -> String
partialMatchError Action cls name m a
a [String]
partials =
  String
"Wrong arguments: "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Action cls name m a -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
       (m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m a
a
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nClosest matches:\n - "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n - " (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
5 [String]
partials)