{-# 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 :: 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 = Matcher cls name m a -> Action cls name m a -> 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 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 Matcher cls name m a -> Action cls name m a -> 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 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 :: r -> Action cls name m r -> MockT m r
mockMethodImpl r
surrogate Action cls name m r
action = MockT m (MockT m r) -> MockT m r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (MockT m (MockT m r) -> MockT m r)
-> MockT m (MockT m r) -> MockT m r
forall a b. (a -> b) -> a -> b
$
MockSetup m (MockT m r) -> MockT m (MockT m r)
forall (ctx :: (* -> *) -> * -> *) (m :: * -> *) a.
(MockContext ctx, MonadIO m) =>
MockSetup m a -> ctx m a
fromMockSetup (MockSetup m (MockT m r) -> MockT m (MockT m r))
-> MockSetup m (MockT m r) -> MockT m (MockT m r)
forall a b. (a -> b) -> a -> b
$ do
Proxy cls -> MockSetup m ()
forall (cls :: (* -> *) -> Constraint) (m :: * -> *)
(proxy :: ((* -> *) -> Constraint) -> *).
(Mockable cls, Typeable m, MonadIO m) =>
proxy cls -> MockSetup m ()
initClassIfNeeded (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls)
[MockState m]
states <- MockState m -> [MockState m]
forall (m :: * -> *). MockState m -> [MockState m]
allStates (MockState m -> [MockState m])
-> MockSetup m (MockState m) -> MockSetup m [MockState m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (MockState m) STM (MockState m)
-> MockSetup m (MockState m)
forall (m :: * -> *) a.
ReaderT (MockState m) STM a -> MockSetup m a
MockSetup ReaderT (MockState m) STM (MockState m)
forall r (m :: * -> *). MonadReader r m => m r
ask
([Maybe ([(Int, String)], String)]
partial, [(String, MockSetup m (), Maybe (MockT m r))]
full) <- ([([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
-> ([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))]))
-> MockSetup
m
[([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([[Maybe ([(Int, String)], String)]]
-> [Maybe ([(Int, String)], String)])
-> ([[(String, MockSetup m (), Maybe (MockT m r))]]
-> [(String, MockSetup m (), Maybe (MockT m r))])
-> ([[Maybe ([(Int, String)], String)]],
[[(String, MockSetup m (), Maybe (MockT m r))]])
-> ([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [[Maybe ([(Int, String)], String)]]
-> [Maybe ([(Int, String)], String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, MockSetup m (), Maybe (MockT m r))]]
-> [(String, MockSetup m (), Maybe (MockT m r))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([[Maybe ([(Int, String)], String)]],
[[(String, MockSetup m (), Maybe (MockT m r))]])
-> ([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))]))
-> ([([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
-> ([[Maybe ([(Int, String)], String)]],
[[(String, MockSetup m (), Maybe (MockT m r))]]))
-> [([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
-> ([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
-> ([[Maybe ([(Int, String)], String)]],
[[(String, MockSetup m (), Maybe (MockT m r))]])
forall a b. [(a, b)] -> ([a], [b])
unzip) (MockSetup
m
[([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))]))
-> MockSetup
m
[([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
forall a b. (a -> b) -> a -> b
$
[MockState m]
-> (MockState m
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))]))
-> MockSetup
m
[([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [MockState m]
states ((MockState m
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))]))
-> MockSetup
m
[([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])])
-> (MockState m
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))]))
-> MockSetup
m
[([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])]
forall a b. (a -> b) -> a -> b
$ \MockState m
state -> do
ExpectSet (Step m)
expectSet <- STM (ExpectSet (Step m)) -> MockSetup m (ExpectSet (Step m))
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM (ExpectSet (Step m)) -> MockSetup m (ExpectSet (Step m)))
-> STM (ExpectSet (Step m)) -> MockSetup m (ExpectSet (Step m))
forall a b. (a -> b) -> a -> b
$ TVar (ExpectSet (Step m)) -> STM (ExpectSet (Step m))
forall a. TVar a -> STM a
readTVar (MockState m -> TVar (ExpectSet (Step m))
forall (m :: * -> *). MockState m -> TVar (ExpectSet (Step m))
mockExpectSet MockState m
state)
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
forall (m :: * -> *) a. Monad m => a -> m a
return (([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))]))
-> ([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
-> MockSetup
m
([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
forall a b. (a -> b) -> a -> b
$
[Either
(Maybe ([(Int, String)], String))
(String, MockSetup m (), Maybe (MockT m r))]
-> ([Maybe ([(Int, String)], String)],
[(String, MockSetup m (), Maybe (MockT m r))])
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 (MockState m -> TVar (ExpectSet (Step m))
forall (m :: * -> *). MockState m -> TVar (ExpectSet (Step m))
mockExpectSet MockState m
state) ((Step m, ExpectSet (Step m))
-> Either
(Maybe ([(Int, String)], String))
(String, MockSetup m (), Maybe (MockT m r)))
-> [(Step m, ExpectSet (Step m))]
-> [Either
(Maybe ([(Int, String)], String))
(String, MockSetup 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)
let orderedPartial :: [([(Int, String)], String)]
orderedPartial = (([(Int, String)], String)
-> ([(Int, String)], String) -> Ordering)
-> [([(Int, String)], String)] -> [([(Int, String)], 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)], String) -> Int)
-> ([(Int, String)], String)
-> ([(Int, String)], String)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([(Int, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Int, String)] -> Int)
-> (([(Int, String)], String) -> [(Int, String)])
-> ([(Int, String)], String)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, String)], String) -> [(Int, String)]
forall a b. (a, b) -> a
fst)) ([Maybe ([(Int, String)], String)] -> [([(Int, String)], String)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ([(Int, String)], String)]
partial)
[Step m]
defaults <- (MockState m -> MockSetup m [Step m])
-> [MockState m] -> MockSetup m [Step m]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (STM [Step m] -> MockSetup m [Step m]
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM [Step m] -> MockSetup m [Step m])
-> (MockState m -> STM [Step m])
-> MockState m
-> MockSetup m [Step m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar [Step m] -> STM [Step m]
forall a. TVar a -> STM a
readTVar (TVar [Step m] -> STM [Step m])
-> (MockState m -> TVar [Step m]) -> MockState m -> STM [Step m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockState m -> TVar [Step m]
forall (m :: * -> *). MockState m -> TVar [Step m]
mockDefaults) [MockState m]
states
[Step m]
unexpected <-
(MockState m -> MockSetup m [Step m])
-> [MockState m] -> MockSetup m [Step m]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM
(STM [Step m] -> MockSetup m [Step m]
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM [Step m] -> MockSetup m [Step m])
-> (MockState m -> STM [Step m])
-> MockState m
-> MockSetup m [Step m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar [Step m] -> STM [Step m]
forall a. TVar a -> STM a
readTVar (TVar [Step m] -> STM [Step m])
-> (MockState m -> TVar [Step m]) -> MockState m -> STM [Step m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockState m -> TVar [Step m]
forall (m :: * -> *). MockState m -> TVar [Step m]
mockAllowUnexpected)
[MockState m]
states
MockT m ()
sideEffect <-
[Step m] -> MockT m ()
getSideEffect
([Step m] -> MockT m ())
-> MockSetup m [Step m] -> MockSetup m (MockT m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MockState m -> MockSetup m [Step m])
-> [MockState m] -> MockSetup m [Step m]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (STM [Step m] -> MockSetup m [Step m]
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM [Step m] -> MockSetup m [Step m])
-> (MockState m -> STM [Step m])
-> MockState m
-> MockSetup m [Step m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar [Step m] -> STM [Step m]
forall a. TVar a -> STM a
readTVar (TVar [Step m] -> STM [Step m])
-> (MockState m -> TVar [Step m]) -> MockState m -> STM [Step m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockState m -> TVar [Step m]
forall (m :: * -> *). MockState m -> TVar [Step m]
mockSideEffects) [MockState m]
states
Severity
ambigSev <- STM Severity -> MockSetup m Severity
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM Severity -> MockSetup m Severity)
-> STM Severity -> MockSetup m Severity
forall a b. (a -> b) -> a -> b
$ TVar Severity -> STM Severity
forall a. TVar a -> STM a
readTVar (TVar Severity -> STM Severity)
-> ([MockState m] -> TVar Severity)
-> [MockState m]
-> STM Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockState m -> TVar Severity
forall (m :: * -> *). MockState m -> TVar Severity
mockAmbiguitySeverity (MockState m -> TVar Severity)
-> ([MockState m] -> MockState m) -> [MockState m] -> TVar Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MockState m] -> MockState m
forall a. [a] -> a
head ([MockState m] -> STM Severity) -> [MockState m] -> STM Severity
forall a b. (a -> b) -> a -> b
$ [MockState m]
states
Severity
unintSev <-
STM Severity -> MockSetup m Severity
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM Severity -> MockSetup m Severity)
-> STM Severity -> MockSetup m Severity
forall a b. (a -> b) -> a -> b
$ TVar Severity -> STM Severity
forall a. TVar a -> STM a
readTVar (TVar Severity -> STM Severity)
-> ([MockState m] -> TVar Severity)
-> [MockState m]
-> STM Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockState m -> TVar Severity
forall (m :: * -> *). MockState m -> TVar Severity
mockUninterestingSeverity (MockState m -> TVar Severity)
-> ([MockState m] -> MockState m) -> [MockState m] -> TVar Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MockState m] -> MockState m
forall a. [a] -> a
head ([MockState m] -> STM Severity) -> [MockState m] -> STM Severity
forall a b. (a -> b) -> a -> b
$ [MockState m]
states
Severity
unexpSev <- STM Severity -> MockSetup m Severity
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM Severity -> MockSetup m Severity)
-> STM Severity -> MockSetup m Severity
forall a b. (a -> b) -> a -> b
$ TVar Severity -> STM Severity
forall a. TVar a -> STM a
readTVar (TVar Severity -> STM Severity)
-> ([MockState m] -> TVar Severity)
-> [MockState m]
-> STM Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockState m -> TVar Severity
forall (m :: * -> *). MockState m -> TVar Severity
mockUnexpectedSeverity (MockState m -> TVar Severity)
-> ([MockState m] -> MockState m) -> [MockState m] -> TVar Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MockState m] -> MockState m
forall a. [a] -> a
head ([MockState m] -> STM Severity) -> [MockState m] -> STM Severity
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
MockT m r -> MockSetup m (MockT m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (MockT m r -> MockSetup m (MockT m r))
-> MockT m r -> MockSetup m (MockT m r)
forall a b. (a -> b) -> a -> b
$ do
Bool -> MockT m () -> MockT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(String, MockSetup m (), Maybe (MockT m r))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, MockSetup m (), Maybe (MockT m r))]
rest) (MockT m () -> MockT m ()) -> MockT m () -> MockT m ()
forall a b. (a -> b) -> a -> b
$
Severity -> Action cls name m r -> [String] -> MockT m ()
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) ((String, MockSetup m (), Maybe (MockT m r)) -> String)
-> [(String, MockSetup m (), Maybe (MockT m r))] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, MockSetup m (), Maybe (MockT m r))]
opts)
MockT m ()
sideEffect
MockT m r -> Maybe (MockT m r) -> MockT m r
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) -> MockT m r -> MockSetup m (MockT m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (MockT m ()
sideEffect MockT m () -> MockT m r -> MockT m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockT m r -> Maybe (MockT m r) -> MockT m r
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 <- Proxy cls -> Proxy name -> MockSetup m Bool
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) (proxy1 :: ((* -> *) -> Constraint) -> *)
(proxy2 :: Symbol -> *).
(Typeable cls, KnownSymbol name) =>
proxy1 cls -> proxy2 name -> MockSetup m Bool
isInteresting (Proxy cls
forall k (t :: k). Proxy t
Proxy :: Proxy cls) (Proxy name
forall k (t :: k). Proxy t
Proxy :: Proxy name)
case (Bool
interesting, Severity
unintSev) of
(Bool
True, Severity
_) -> MockT m r -> MockSetup m (MockT m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Action cls name m r -> MockT m ()
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 MockT m () -> MockT m r -> MockT m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockT m r
d)
(Bool
False, Severity
Error) -> MockT m r -> MockSetup m (MockT m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Action cls name m r -> MockT m ()
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 MockT m () -> MockT m r -> MockT m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockT m r
d)
(Bool, Severity)
_ -> MockT m r -> MockSetup m (MockT m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Action cls name m r -> MockT m ()
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 MockT m () -> MockT m r -> MockT m r
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) ->
MockT m r -> MockSetup m (MockT m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity
-> Action cls name m r -> [([(Int, String)], String)] -> MockT m ()
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 MockT m () -> MockT m r -> MockT m r
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)) <- 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 WholeMethodMatcher cls name m r
-> Action cls name m r -> MatchResult
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 ->
Maybe ([(Int, String)], String)
-> Either
(Maybe ([(Int, String)], String))
(String, MockSetup m (), Maybe (MockT m r))
forall a b. a -> Either a b
Left (([(Int, String)], String) -> Maybe ([(Int, String)], String)
forall a. a -> Maybe a
Just ([(Int, String)]
n, Located String -> String
withLoc (Maybe (Action cls name m r)
-> WholeMethodMatcher cls name m r -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a b.
MockableBase cls =>
Maybe (Action cls name m a)
-> WholeMethodMatcher cls name m b -> String
showWholeMatcher (Action cls name m r -> Maybe (Action cls name m r)
forall a. a -> Maybe a
Just Action cls name m r
action) WholeMethodMatcher 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 ->
(String, MockSetup m (), Maybe (MockT m r))
-> Either
(Maybe ([(Int, String)], String))
(String, MockSetup m (), Maybe (MockT m r))
forall a b. b -> Either a b
Right
( Located String -> String
withLoc (Located (SingleRule cls name m r)
lrule Located (SingleRule cls name m r) -> String -> Located String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (Action cls name m r)
-> WholeMethodMatcher cls name m r -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a b.
MockableBase cls =>
Maybe (Action cls name m a)
-> WholeMethodMatcher cls name m b -> String
showWholeMatcher (Action cls name m r -> Maybe (Action cls name m r)
forall a. a -> Maybe a
Just Action cls name m r
action) WholeMethodMatcher cls name m r
m),
STM () -> MockSetup m ()
forall a (m :: * -> *). STM a -> MockSetup m a
mockSetupSTM (STM () -> MockSetup m ()) -> STM () -> MockSetup m ()
forall a b. (a -> b) -> a -> b
$ TVar (ExpectSet (Step m)) -> ExpectSet (Step m) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (ExpectSet (Step m))
tvar 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)], String)
-> Either
(Maybe ([(Int, String)], String))
(String, MockSetup m (), Maybe (MockT m r))
forall a b. a -> Either a b
Left Maybe ([(Int, String)], String)
forall a. Maybe a
Nothing
allowedUnexpected :: [Step m] -> Maybe (Maybe (MockT m r))
allowedUnexpected :: [Step m] -> Maybe (Maybe (MockT m r))
allowedUnexpected [] = Maybe (Maybe (MockT m r))
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)) <- 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)
unexpected,
MatchResult
Match <- WholeMethodMatcher cls name m r
-> Action cls name m r -> MatchResult
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 =
Maybe (MockT m r) -> Maybe (Maybe (MockT m r))
forall a. a -> Maybe a
Just (((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 = [Step m] -> Maybe (Maybe (MockT m r))
allowedUnexpected [Step m]
steps
findDefault :: [Step m] -> MockT m r
findDefault :: [Step m] -> MockT m r
findDefault [] = r -> MockT m r
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)) <- 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 <- WholeMethodMatcher cls name m r
-> Action cls name m r -> MatchResult
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 =
MockT m r
-> ((Action cls name m r -> MockT m r) -> MockT m r)
-> Maybe (Action cls name m r -> MockT m r)
-> MockT m r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Step m] -> MockT m r
findDefault [Step m]
steps) ((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) 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 =
[Step m] -> (Step m -> MockT m ()) -> MockT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Step m]
effects ((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)
expected) -> case 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 of
Just (Loc Maybe String
_ (WholeMethodMatcher cls name m r
m :-> Just Action cls name m r -> MockT m r
impl))
| MatchResult
Match <- WholeMethodMatcher cls name m r
-> Action cls name m r -> MatchResult
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 -> MockT m r -> MockT m ()
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))
_ -> () -> MockT m ()
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 :: 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
mockDefaultlessMethod ::
( 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
uninterestingError ::
(HasCallStack, Mockable cls, MonadIO m) =>
Severity ->
Action cls name m r ->
MockT m ()
uninterestingError :: Severity -> Action cls name m r -> MockT m ()
uninterestingError Severity
severity Action cls name m r
a =
Severity -> String -> MockT m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
severity (String -> MockT m ()) -> String -> MockT m ()
forall a b. (a -> b) -> a -> b
$ String
"Uninteresting action: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Action cls name m r -> String
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 :: Severity -> Action cls name m r -> MockT m ()
noMatchError Severity
severity Action cls name m r
a = do
String
fullExpectations <- MockT m String
forall (m :: * -> *). MonadIO m => MockT m String
describeExpectations
Severity -> String -> MockT m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
severity (String -> MockT m ()) -> String -> MockT m ()
forall a b. (a -> b) -> a -> b
$
String
"Unexpected action: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Action cls name m r -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m r
a
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nFull expectations:\n"
String -> String -> String
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 :: 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 <- MockT m String
forall (m :: * -> *). MonadIO m => MockT m String
describeExpectations
Severity -> String -> MockT m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
severity (String -> MockT m ()) -> String -> MockT m ()
forall a b. (a -> b) -> a -> b
$
String
"Wrong arguments: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Action cls name m r -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m r
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) -> String)
-> [([(Int, String)], String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, String)], String) -> String
formatPartial ([([(Int, String)], String)] -> [String])
-> [([(Int, String)], String)] -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> [([(Int, String)], String)] -> [([(Int, String)], String)]
forall a. Int -> [a] -> [a]
take Int
5 [([(Int, String)], String)]
partials)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nFull expectations:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fullExpectations
where
formatPartial :: ([(Int, String)], String) -> String
formatPartial :: ([(Int, String)], String) -> String
formatPartial ([(Int, String)]
mismatches, String
matcher)
| [(Int, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, String)]
mismatches = String
matcher String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n * Failed whole-method matcher"
| Bool
otherwise =
String
matcher String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n * "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
String
"\n * "
( ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
( \(Int
i, String
mm) ->
String
"Arg #" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> 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 :: Severity -> Action cls name m r -> [String] -> MockT m ()
ambiguityError Severity
severity Action cls name m r
a [String]
choices = do
String
fullExpectations <- MockT m String
forall (m :: * -> *). MonadIO m => MockT m String
describeExpectations
Severity -> String -> MockT m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Severity -> String -> MockT m ()
reportFault Severity
severity (String -> MockT m ()) -> String -> MockT m ()
forall a b. (a -> b) -> a -> b
$
String
"Ambiguous action matched multiple expectations: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Action cls name m r -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a.
MockableBase cls =>
Action cls name m a -> String
showAction Action cls name m r
a
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nMatches:\n - "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n - " [String]
choices
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nFull expectations:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fullExpectations