Safe Haskell | None |
---|---|
Language | Haskell2010 |
Test.HMock.MockT
Description
This module defines monads for working with mocks. HMock tests run in the
MockT
monad transformer. A more limited monad, MockSetup
, is used for
setting up defaults for each class. Both are instances of the MockContext
monad, which defines a shared API.
Synopsis
- data MockT m a
- runMockT :: forall m a. MonadIO m => MockT m a -> m a
- withMockT :: forall m b. MonadIO m => ((forall a. MockT m a -> m a) -> MockT m b) -> m b
- nestMockT :: forall m a. MonadIO m => MockT m a -> MockT m a
- withNestedMockT :: forall m b. MonadIO m => ((forall a. MockT m a -> m a) -> MockT m b) -> MockT m b
- data Severity
- setAmbiguityCheck :: MonadIO m => Severity -> MockT m ()
- setUninterestingActionCheck :: MonadIO m => Severity -> MockT m ()
- setUnexpectedActionCheck :: MonadIO m => Severity -> MockT m ()
- setUnmetExpectationCheck :: MonadIO m => Severity -> MockT m ()
- describeExpectations :: MonadIO m => MockT m String
- verifyExpectations :: MonadIO m => MockT m ()
- data MockSetup m a
- class MockContext ctx
- allowUnexpected :: forall cls name m r rule ctx. (MonadIO m, MockableMethod cls name m r, Expectable cls name m r rule, MockContext ctx) => rule -> ctx m ()
- byDefault :: forall cls name m r ctx. (MonadIO m, MockableMethod cls name m r, MockContext ctx) => Rule cls name m r -> ctx m ()
- whenever :: forall cls name m r ctx. (MonadIO m, MockableMethod cls name m r, MockContext ctx) => Rule cls name m r -> ctx m ()
Documentation
Monad transformer for running mocks.
Instances
runMockT :: forall m a. MonadIO m => MockT m a -> m a Source #
Runs a test in the MockT
monad, handling all of the mocks.
withMockT :: forall m b. MonadIO m => ((forall a. MockT m a -> m a) -> MockT m b) -> m b Source #
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 -> doexpect
$
...liftIO
$
forkIO
$
inMockT firstThreadliftIO
$
forkIO
$
inMockT secondThread
This is a low-level primitive. Consider using the unliftio
package for
higher level implementations of multithreading and other primitives.
withNestedMockT :: forall m b. MonadIO m => ((forall a. MockT m a -> m a) -> MockT m b) -> MockT m b Source #
Starts a nested block within MockT
. The nested block has its own set of
expectations, which must be fulfilled before the end of the block. It can
unlift other MockT pieces to the base monad while still acting on the same
set of expectations. This can be useful for testing concurrency or similar
mechanisms.
Beware: use of nestMockT
might signify that you are doing too much in a
single test. Consider splitting large tests into a separate test for each
case.
The severity for a possible problem.
setUninterestingActionCheck :: MonadIO m => Severity -> MockT m () Source #
Sets the severity for uninteresting actions. An uninteresting action is
one for which no expectations or other configuration have been added that
mention the method at all. If this is not set to Error
, then uninteresting
methods are treated just like unexpected methods.
Before you weaken this check, consider that the labeling of methods as "uninteresting" is non-compositional. A change in one part of your test can result in a formerly uninteresting action being considered interesting in a different part of the test.
This defaults to Error
.
setUnexpectedActionCheck :: MonadIO m => Severity -> MockT m () Source #
Sets the severity for unexpected actions. An unexpected action is one that
doesn't match any expectations *and* isn't explicitly allowed by
allowUnexpected
. If this is not set to Error
, the action returns its
default response.
This defaults to Error
.
setUnmetExpectationCheck :: MonadIO m => Severity -> MockT m () Source #
Sets the severity for unmet expectations. An unmet expectation happens
when an expectation is added, but either the test (or nesting level) ends or
verifyExpectations
is used before a matching action takes place.
This defaults to Error
.
describeExpectations :: MonadIO m => MockT m String Source #
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.
verifyExpectations :: MonadIO m => MockT m () Source #
Verifies that all mock expectations are satisfied. If there is a nested block in effect, only the expectations of that nested block are verified You normally don't need to do this, because it happens automatically at the end of your test or nested block. However, it's occasionally useful to check expectations early.
Beware: use of verifyExpectations
might signify that you are doing too much
in a single test. Consider splitting large tests into a separate test for
each case.
Monad for setting up a mockable class. Note that even though the type looks that way, this is *not* a monad transformer. It's a very restricted environment that can only be used to set up defaults for a class.
Instances
ExpectContext MockSetup Source # | This instance allows you to add expectations from |
Defined in Test.HMock.Internal.State Methods expect :: forall (m :: Type -> Type) (cls :: (Type -> Type) -> Constraint) (name :: Symbol) r expectable. (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) => expectable -> MockSetup m () Source # expectN :: forall (m :: Type -> Type) (cls :: (Type -> Type) -> Constraint) (name :: Symbol) r expectable. (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) => Multiplicity -> expectable -> MockSetup m () Source # expectAny :: forall (m :: Type -> Type) (cls :: (Type -> Type) -> Constraint) (name :: Symbol) r expectable. (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) => expectable -> MockSetup m () Source # inSequence :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> MockSetup m () Source # inAnyOrder :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> MockSetup m () Source # anyOf :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> MockSetup m () Source # times :: forall (m :: Type -> Type). MonadIO m => Multiplicity -> (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => ctx' m ()) -> MockSetup m () Source # consecutiveTimes :: forall (m :: Type -> Type). MonadIO m => Multiplicity -> (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => ctx' m ()) -> MockSetup m () Source # | |
MockContext MockSetup Source # | |
Defined in Test.HMock.Internal.State | |
Monad (MockSetup m) Source # | |
Functor (MockSetup m) Source # | |
Applicative (MockSetup m) Source # | |
Defined in Test.HMock.Internal.State |
class MockContext ctx Source #
Minimal complete definition
Instances
MockContext MockSetup Source # | |
Defined in Test.HMock.Internal.State | |
MockContext MockT Source # | |
Defined in Test.HMock.Internal.State |
allowUnexpected :: forall cls name m r rule ctx. (MonadIO m, MockableMethod cls name m r, Expectable cls name m r rule, MockContext ctx) => rule -> ctx m () Source #
Adds a handler for unexpected actions. Matching calls will not fail, but
will use a default response instead. The rule passed in must have zero or
one responses: if there is a response,
is equivalent to allowUnexpected
(m
|=>
r)
.allowUnexpected
m >>
byDefault
(m |=>
r)
The difference between expectAny
and
allowUnexpected
is subtle, but comes down to ambiguity:
allowUnexpected
is not an expectation, so it cannot be ambiguous. It only has an effect if no true expectation matches, regardless of when the expectations were added.expectAny
adds an expectation, so if another expectation is in effect at the same time, a call to the method is ambiguous. If ambiguity checking is enabled, the method will throw an error; otherwise, the more recently added of the two expectations is used.
byDefault :: forall cls name m r ctx. (MonadIO m, MockableMethod cls name m r, MockContext ctx) => Rule cls name m r -> ctx m () Source #
Sets a default action for *expected* matching calls. The new default only applies to calls for which an expectation exists, but it lacks an explicit response. The rule passed in must have exactly one response.
whenever :: forall cls name m r ctx. (MonadIO m, MockableMethod cls name m r, MockContext ctx) => Rule cls name m r -> ctx m () Source #
Adds a side-effect, which happens whenever a matching call occurs, in addition to the usual response. The return value is entirely ignored.
Be warned: using side effects makes it easy to break abstraction boundaries. Be aware that there may be other uses of a method besides the one which you intend to intercept here. If possible, add the desired behavior to the response for the matching expectation instead.