{-# LANGUAGE ScopedTypeVariables #-}
module Test.HMock.MockMethod
( mockMethod,
mockDefaultlessMethod,
)
where
import Control.Concurrent.STM (TVar, readTVar, writeTVar)
import Control.Monad (forM, forM_, join, unless, void)
import Control.Monad.Extra (concatMapM)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ask)
import Data.Bifunctor (bimap)
import Data.Default (Default (def))
import Data.Either (partitionEithers)
import Data.Function (on)
import Data.Functor (($>))
import Data.List (intercalate, sortBy)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Typeable (cast)
import GHC.Stack (HasCallStack, withFrozenCallStack)
import Test.HMock.ExpectContext (MockableMethod)
import Test.HMock.Internal.ExpectSet (ExpectSet, liveSteps)
import Test.HMock.Internal.Rule (WholeMethodMatcher (..), showWholeMatcher)
import Test.HMock.Internal.State
( MockContext (..),
MockSetup (..),
MockState (..),
MockT,
Severity (..),
allStates,
initClassIfNeeded,
isInteresting,
mockSetupSTM,
reportFault,
)
import Test.HMock.Internal.Step (SingleRule ((:->)), Step (Step))
import Test.HMock.Internal.Util (Located (Loc), withLoc)
import Test.HMock.MockT (describeExpectations)
import Test.HMock.Mockable
( MatchResult (..),
Mockable (..),
MockableBase (..),
)
matchWholeAction ::
MockableBase cls =>
WholeMethodMatcher cls name m a ->
Action cls name m a ->
MatchResult
matchWholeAction :: forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
WholeMethodMatcher cls name m a
-> Action cls name m a -> MatchResult
matchWholeAction (JustMatcher Matcher cls name m a
m) Action cls name m a
a = 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 a
m Action cls name m a
a
matchWholeAction (Matcher cls name m a
m `SuchThat` Action cls name m a -> Bool
p) Action cls name m a
a = case 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 a
m Action cls name m a
a of
NoMatch [(Int, String)]
n -> [(Int, String)] -> MatchResult
NoMatch [(Int, String)]
n
MatchResult
Match
| Action cls name m a -> Bool
p Action cls name m a
a -> MatchResult
Match
| Bool
otherwise -> [(Int, String)] -> MatchResult
NoMatch []
mockMethodImpl ::
forall cls name m r.
(HasCallStack, MonadIO m, MockableMethod cls name m r) =>
r ->
Action cls name m r ->
MockT m r
mockMethodImpl :: 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
surrogate Action cls name m r
action = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup forall a b. (a -> b) -> a -> b
$ do
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, Typeable m, MonadIO m) =>
proxy cls -> MockSetup m ()
initClassIfNeeded (forall {k} (t :: k). Proxy t
Proxy :: Proxy cls)
[MockState m]
states <- forall (m :: * -> *). MockState m -> [MockState m]
allStates forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup forall r (m :: * -> *). MonadReader r m => m r
ask
([Maybe ([(Int, String)], String)]
partial, [(String, MockSetup m (), Maybe (MockT m r))]
full) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [MockState m]
states forall a b. (a -> b) -> a -> b
$ \MockState m
state -> do
ExpectSet (Step m)
expectSet <- forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar (forall (m :: * -> *). MockState m -> TVar (ExpectSet (Step m))
mockExpectSet MockState m
state)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a b. [Either a b] -> ([a], [b])
partitionEithers
(TVar (ExpectSet (Step m))
-> (Step m, ExpectSet (Step m))
-> Either
(Maybe ([(Int, String)], String))
(String, MockSetup m (), Maybe (MockT m r))
tryMatch (forall (m :: * -> *). MockState m -> TVar (ExpectSet (Step m))
mockExpectSet MockState m
state) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet (Step m)
expectSet)
let orderedPartial :: [([(Int, String)], String)]
orderedPartial = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)) (forall a. [Maybe a] -> [a]
catMaybes [Maybe ([(Int, String)], String)]
partial)
[Step m]
defaults <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> STM a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MockState m -> TVar [Step m]
mockDefaults) [MockState m]
states
[Step m]
unexpected <-
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM
(forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> STM a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MockState m -> TVar [Step m]
mockAllowUnexpected)
[MockState m]
states
MockT m ()
sideEffect <-
[Step m] -> MockT m ()
getSideEffect
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> STM a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MockState m -> TVar [Step m]
mockSideEffects) [MockState m]
states
Severity
ambigSev <- forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MockState m -> TVar Severity
mockAmbiguitySeverity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [MockState m]
states
Severity
unintSev <-
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MockState m -> TVar Severity
mockUninterestingSeverity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [MockState m]
states
Severity
unexpSev <- forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MockState m -> TVar Severity
mockUnexpectedSeverity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [MockState m]
states
case ( [(String, MockSetup m (), Maybe (MockT m r))]
full,
[([(Int, String)], String)]
orderedPartial,
[Step m] -> Maybe (Maybe (MockT m r))
allowedUnexpected [Step m]
unexpected,
[Step m] -> MockT m r
findDefault [Step m]
defaults
) of
(opts :: [(String, MockSetup m (), Maybe (MockT m r))]
opts@((String
_, MockSetup m ()
choose, Maybe (MockT m r)
response) : [(String, MockSetup m (), Maybe (MockT m r))]
rest), [([(Int, String)], String)]
_, Maybe (Maybe (MockT m r))
_, MockT m r
d) -> do
MockSetup m ()
choose
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, MockSetup m (), Maybe (MockT m r))]
rest) forall a b. (a -> b) -> a -> b
$
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity -> Action cls name m r -> [String] -> MockT m ()
ambiguityError Severity
ambigSev Action cls name m r
action ((\(String
s, MockSetup m ()
_, Maybe (MockT m r)
_) -> String
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, MockSetup m (), Maybe (MockT m r))]
opts)
MockT m ()
sideEffect
forall a. a -> Maybe a -> a
fromMaybe MockT m r
d Maybe (MockT m r)
response
([], [([(Int, String)], String)]
_, Just Maybe (MockT m r)
response, MockT m r
d) -> forall (m :: * -> *) a. Monad m => a -> m a
return (MockT m ()
sideEffect forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a -> a
fromMaybe MockT m r
d Maybe (MockT m r)
response)
([], [], Maybe (Maybe (MockT m r))
_, MockT m r
d) -> do
Bool
interesting <- forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) (proxy1 :: ((* -> *) -> Constraint) -> *)
(proxy2 :: Symbol -> *).
(Typeable cls, KnownSymbol name) =>
proxy1 cls -> proxy2 name -> MockSetup m Bool
isInteresting (forall {k} (t :: k). Proxy t
Proxy :: Proxy cls) (forall {k} (t :: k). Proxy t
Proxy :: Proxy name)
case (Bool
interesting, Severity
unintSev) of
(Bool
True, Severity
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity -> Action cls name m r -> MockT m ()
noMatchError Severity
unexpSev Action cls name m r
action forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockT m r
d)
(Bool
False, Severity
Error) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity -> Action cls name m r -> MockT m ()
noMatchError Severity
unexpSev Action cls name m r
action forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockT m r
d)
(Bool, Severity)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity -> Action cls name m r -> MockT m ()
uninterestingError Severity
unintSev Action cls name m r
action forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockT m r
d)
([], [([(Int, String)], String)]
_, Maybe (Maybe (MockT m r))
_, MockT m r
d) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity
-> Action cls name m r -> [([(Int, String)], String)] -> MockT m ()
partialMatchError Severity
unexpSev Action cls name m r
action [([(Int, String)], String)]
orderedPartial forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockT m r
d)
where
tryMatch ::
TVar (ExpectSet (Step m)) ->
(Step m, ExpectSet (Step m)) ->
Either
(Maybe ([(Int, String)], String))
(String, MockSetup m (), Maybe (MockT m r))
tryMatch :: TVar (ExpectSet (Step m))
-> (Step m, ExpectSet (Step m))
-> Either
(Maybe ([(Int, String)], String))
(String, MockSetup m (), Maybe (MockT m r))
tryMatch TVar (ExpectSet (Step m))
tvar (Step Located (SingleRule cls name m r)
expected, ExpectSet (Step m)
e)
| Just lrule :: Located (SingleRule cls name m r)
lrule@(Loc Maybe String
_ (WholeMethodMatcher cls name m r
m :-> Maybe (Action cls name m r -> MockT m r)
impl)) <- forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located (SingleRule cls name m r)
expected =
case forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
WholeMethodMatcher cls name m a
-> Action cls name m a -> MatchResult
matchWholeAction WholeMethodMatcher cls name m r
m Action cls name m r
action of
NoMatch [(Int, String)]
n ->
forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just ([(Int, String)]
n, Located String -> String
withLoc (forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a b.
MockableBase cls =>
Maybe (Action cls name m a)
-> WholeMethodMatcher cls name m b -> String
showWholeMatcher (forall a. a -> Maybe a
Just Action cls name m r
action) WholeMethodMatcher cls name m r
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Located (SingleRule cls name m r)
lrule)))
MatchResult
Match ->
forall a b. b -> Either a b
Right
( Located String -> String
withLoc (Located (SingleRule cls name m r)
lrule forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a b.
MockableBase cls =>
Maybe (Action cls name m a)
-> WholeMethodMatcher cls name m b -> String
showWholeMatcher (forall a. a -> Maybe a
Just Action cls name m r
action) WholeMethodMatcher cls name m r
m),
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> a -> STM ()
writeTVar TVar (ExpectSet (Step m))
tvar ExpectSet (Step m)
e,
(forall a b. (a -> b) -> a -> b
$ Action cls name m r
action) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Action cls name m r -> MockT m r)
impl
)
| Bool
otherwise = forall a b. a -> Either a b
Left forall a. Maybe a
Nothing
allowedUnexpected :: [Step m] -> Maybe (Maybe (MockT m r))
allowedUnexpected :: [Step m] -> Maybe (Maybe (MockT m r))
allowedUnexpected [] = forall a. Maybe a
Nothing
allowedUnexpected (Step Located (SingleRule cls name m r)
unexpected : [Step m]
steps)
| Just (Loc Maybe String
_ (WholeMethodMatcher cls name m r
m :-> Maybe (Action cls name m r -> MockT m r)
impl)) <- forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located (SingleRule cls name m r)
unexpected,
MatchResult
Match <- forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
WholeMethodMatcher cls name m a
-> Action cls name m a -> MatchResult
matchWholeAction WholeMethodMatcher cls name m r
m Action cls name m r
action =
forall a. a -> Maybe a
Just ((forall a b. (a -> b) -> a -> b
$ Action cls name m r
action) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Action cls name m r -> MockT m r)
impl)
| Bool
otherwise = [Step m] -> Maybe (Maybe (MockT m r))
allowedUnexpected [Step m]
steps
findDefault :: [Step m] -> MockT m r
findDefault :: [Step m] -> MockT m r
findDefault [] = forall (m :: * -> *) a. Monad m => a -> m a
return r
surrogate
findDefault (Step Located (SingleRule cls name m r)
expected : [Step m]
steps)
| Just (Loc Maybe String
_ (WholeMethodMatcher cls name m r
m :-> Maybe (Action cls name m r -> MockT m r)
impl)) <- forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located (SingleRule cls name m r)
expected,
MatchResult
Match <- forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
WholeMethodMatcher cls name m a
-> Action cls name m a -> MatchResult
matchWholeAction WholeMethodMatcher cls name m r
m Action cls name m r
action =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Step m] -> MockT m r
findDefault [Step m]
steps) (forall a b. (a -> b) -> a -> b
$ Action cls name m r
action) Maybe (Action cls name m r -> MockT m r)
impl
| Bool
otherwise = [Step m] -> MockT m r
findDefault [Step m]
steps
getSideEffect :: [Step m] -> MockT m ()
getSideEffect :: [Step m] -> MockT m ()
getSideEffect [Step m]
effects =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Step m]
effects forall a b. (a -> b) -> a -> b
$ \(Step Located (SingleRule cls name m r)
expected) -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located (SingleRule cls name m r)
expected of
Just (Loc Maybe String
_ (WholeMethodMatcher cls name m r
m :-> Just Action cls name m r -> MockT m r
impl))
| MatchResult
Match <- forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
WholeMethodMatcher cls name m a
-> Action cls name m a -> MatchResult
matchWholeAction WholeMethodMatcher cls name m r
m Action cls name m r
action -> forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action cls name m r -> MockT m r
impl Action cls name m r
action)
Maybe (Located (SingleRule cls name m r))
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
mockMethod ::
( HasCallStack,
MonadIO m,
MockableMethod cls name m r,
Default r
) =>
Action cls name m r ->
MockT m r
mockMethod :: forall (m :: * -> *) (cls :: (* -> *) -> Constraint)
(name :: Symbol) 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
action =
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ 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 forall a. Default a => a
def Action cls name m r
action
mockDefaultlessMethod ::
( HasCallStack,
MonadIO m,
MockableMethod cls name m r
) =>
Action cls name m r ->
MockT m r
mockDefaultlessMethod :: forall (m :: * -> *) (cls :: (* -> *) -> Constraint)
(name :: Symbol) r.
(HasCallStack, MonadIO m, MockableMethod cls name m r) =>
Action cls name m r -> MockT m r
mockDefaultlessMethod Action cls name m r
action =
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ 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 forall a. HasCallStack => a
undefined Action cls name m r
action
uninterestingError ::
(HasCallStack, Mockable cls, MonadIO m) =>
Severity ->
Action cls name m r ->
MockT m ()
uninterestingError :: forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity -> Action cls name m r -> MockT m ()
uninterestingError Severity
severity Action cls name m r
a =
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
severity forall a b. (a -> b) -> a -> b
$ String
"Uninteresting action: " forall a. [a] -> [a] -> [a]
++ forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m r
a
noMatchError ::
(HasCallStack, Mockable cls, MonadIO m) =>
Severity ->
Action cls name m r ->
MockT m ()
noMatchError :: forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity -> Action cls name m r -> MockT m ()
noMatchError Severity
severity Action cls name m r
a = do
String
fullExpectations <- forall (m :: * -> *). MonadIO m => MockT m String
describeExpectations
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
severity forall a b. (a -> b) -> a -> b
$
String
"Unexpected action: " forall a. [a] -> [a] -> [a]
++ forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m r
a
forall a. [a] -> [a] -> [a]
++ String
"\n\nFull expectations:\n"
forall a. [a] -> [a] -> [a]
++ String
fullExpectations
partialMatchError ::
(HasCallStack, Mockable cls, MonadIO m) =>
Severity ->
Action cls name m r ->
[([(Int, String)], String)] ->
MockT m ()
partialMatchError :: forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity
-> Action cls name m r -> [([(Int, String)], String)] -> MockT m ()
partialMatchError Severity
severity Action cls name m r
a [([(Int, String)], String)]
partials = do
String
fullExpectations <- forall (m :: * -> *). MonadIO m => MockT m String
describeExpectations
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
severity forall a b. (a -> b) -> a -> b
$
String
"Wrong arguments: "
forall a. [a] -> [a] -> [a]
++ forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m r
a
forall a. [a] -> [a] -> [a]
++ String
"\n\nClosest matches:\n - "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n - " (forall a b. (a -> b) -> [a] -> [b]
map ([(Int, String)], String) -> String
formatPartial forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
5 [([(Int, String)], String)]
partials)
forall a. [a] -> [a] -> [a]
++ String
"\n\nFull expectations:\n"
forall a. [a] -> [a] -> [a]
++ String
fullExpectations
where
formatPartial :: ([(Int, String)], String) -> String
formatPartial :: ([(Int, String)], String) -> String
formatPartial ([(Int, String)]
mismatches, String
matcher)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, String)]
mismatches = String
matcher forall a. [a] -> [a] -> [a]
++ String
"\n * Failed whole-method matcher"
| Bool
otherwise =
String
matcher forall a. [a] -> [a] -> [a]
++ String
"\n * "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate
String
"\n * "
( forall a b. (a -> b) -> [a] -> [b]
map
( \(Int
i, String
mm) ->
String
"Arg #" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
mm
)
[(Int, String)]
mismatches
)
ambiguityError ::
(HasCallStack, Mockable cls, MonadIO m) =>
Severity ->
Action cls name m r ->
[String] ->
MockT m ()
ambiguityError :: forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(name :: Symbol) r.
(HasCallStack, Mockable cls, MonadIO m) =>
Severity -> Action cls name m r -> [String] -> MockT m ()
ambiguityError Severity
severity Action cls name m r
a [String]
choices = do
String
fullExpectations <- forall (m :: * -> *). MonadIO m => MockT m String
describeExpectations
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
severity forall a b. (a -> b) -> a -> b
$
String
"Ambiguous action matched multiple expectations: "
forall a. [a] -> [a] -> [a]
++ forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m r
a
forall a. [a] -> [a] -> [a]
++ String
"\n\nMatches:\n - "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n - " [String]
choices
forall a. [a] -> [a] -> [a]
++ String
"\n\nFull expectations:\n"
forall a. [a] -> [a] -> [a]
++ String
fullExpectations