Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Test.HMock.ExpectContext
Description
This module defines the ExpectContext
class, whose members provide the
combinators for building the execution plan for your mocks. Notably, there
is a MockT
instance for ExpectContext
, so you can use
these combinators to add expectations inside your tests that run in
MockT
, as well as nesting them in other combinators.
Synopsis
- type MockableMethod (cls :: (Type -> Type) -> Constraint) (name :: Symbol) (m :: Type -> Type) (r :: Type) = (Mockable cls, Typeable m, KnownSymbol name, Typeable r)
- class ExpectContext (ctx :: (Type -> Type) -> Type -> Type) where
- expect :: (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) => expectable -> ctx m ()
- expectN :: (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) => Multiplicity -> expectable -> ctx m ()
- expectAny :: (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) => expectable -> ctx m ()
- inSequence :: MonadIO m => (forall ctx'. ExpectContext ctx' => [ctx' m ()]) -> ctx m ()
- inAnyOrder :: MonadIO m => (forall ctx'. ExpectContext ctx' => [ctx' m ()]) -> ctx m ()
- anyOf :: MonadIO m => (forall ctx'. ExpectContext ctx' => [ctx' m ()]) -> ctx m ()
- times :: MonadIO m => Multiplicity -> (forall ctx'. ExpectContext ctx' => ctx' m ()) -> ctx m ()
- consecutiveTimes :: MonadIO m => Multiplicity -> (forall ctx'. ExpectContext ctx' => ctx' m ()) -> ctx m ()
Documentation
type MockableMethod (cls :: (Type -> Type) -> Constraint) (name :: Symbol) (m :: Type -> Type) (r :: Type) = (Mockable cls, Typeable m, KnownSymbol name, Typeable r) Source #
All constraints needed to mock a method with the given class, name, base monad, and return type.
class ExpectContext (ctx :: (Type -> Type) -> Type -> Type) where Source #
Type class for contexts in which one can build expectations. Notably, this
includes MockT
, which expects actions to be performed
during a test.
The methods of this class represent the user-facing API for build your execution plan for mocks.
Methods
expect :: (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) => expectable -> ctx m () Source #
Creates an expectation that an action is performed once per given response (or exactly once if there is no response).
runMockT
$
doexpect
$
ReadFile "foo.txt"|->
"lorem ipsum"|->
"oops, the file changed out from under me!" callCodeUnderTest
In this example, readFile
must be called exactly twice by the tested
code, and will return "lorem ipsum" the first time, but something different
the second time.
Arguments
:: (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) | |
=> Multiplicity | The number of times the action should be performed. |
-> expectable | The action and its response. |
-> ctx m () |
Creates an expectation that an action is performed some number of times.
runMockT
$
doexpect
$
MakeListexpectN
(atLeast
2)$
CheckList "Cindy Lou Who"|->
Nice callCodeUnderTest
expectAny :: (HasCallStack, MonadIO m, MockableMethod cls name m r, Expectable cls name m r expectable) => expectable -> ctx m () Source #
Specifies a response if a matching action is performed, but doesn't
expect anything. This is equivalent to
, but shorter.expectN
anyMultiplicity
In this example, the later use of expectAny
overrides earlier uses, but
only for calls that match its conditions.
runMockT
$
doexpectAny
$
ReadFile_ anything|->
"tlhIngan maH!"expectAny
$
ReadFile "config.txt"|->
"lang: klingon" callCodeUnderTest
inSequence :: MonadIO m => (forall ctx'. ExpectContext ctx' => [ctx' m ()]) -> ctx m () Source #
Creates a sequential expectation. Other actions can still happen during the sequence, but these specific expectations must be met in this order.
inSequence
[expect
$
MoveForward,expect
$
TurnRight,expect
$
MoveForward ]
Beware of using inSequence
too often. It is appropriate when the
property you are testing is that the order of effects is correct. If
that's not the purpose of the test, consider adding several independent
expectations, instead. This avoids over-asserting, and keeps your tests
less brittle.
inAnyOrder :: MonadIO m => (forall ctx'. ExpectContext ctx' => [ctx' m ()]) -> ctx m () Source #
Combines multiple expectations, which can occur in any order. Most of the time, you can achieve the same thing by expecting each separately, but this can be combined in compound expectations to describe more complex ordering constraints.
If ambiguity checking is disabled, the choice is left-biased, so earlier options are preferred over ambiguous later options.
inSequence
[inAnyOrder
[expect
$
AdjustMirrors,expect
$
FastenSeatBelt ],expect
$
StartCar ]
anyOf :: MonadIO m => (forall ctx'. ExpectContext ctx' => [ctx' m ()]) -> ctx m () Source #
Combines multiple expectations, requiring exactly one of them to occur. If ambiguity checking is disabled, the choice is left-biased, so earlier options are preferred over ambiguous later options.
anyOf
[expect
$ ApplyForJob,expect
$ ApplyForUniversity ]
times :: MonadIO m => Multiplicity -> (forall ctx'. ExpectContext ctx' => ctx' m ()) -> ctx m () Source #
Creates a parent expectation that the child expectation will happen a
certain number of times. Unlike expectN
, the child expectation can be
arbitrarily complex and span multiple actions. Also unlike expectN
, each
new execution will restart response sequences for rules with more than one
response.
Different occurrences of the child can be interleaved. If ambiguity checking is disabled, progressing on an existing occurrence is preferred over starting a new occurrence when it's ambiguous.
consecutiveTimes :: MonadIO m => Multiplicity -> (forall ctx'. ExpectContext ctx' => ctx' m ()) -> ctx m () Source #
Creates a parent expectation that the child expectation will happen a
certain number of times. Unlike expectN
, the child expectation can be
arbitrarily complex and span multiple actions. Also unlike expectN
, each
new execution will restart response sequences for rules with more than one
response.
Different occurrences of the child must happen consecutively, with one finishing before the next begins.
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 # | |
ExpectContext MockT Source # | |
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 -> MockT 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 -> MockT 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 -> MockT m () Source # inSequence :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> MockT m () Source # inAnyOrder :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> MockT m () Source # anyOf :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> MockT m () Source # times :: forall (m :: Type -> Type). MonadIO m => Multiplicity -> (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => ctx' m ()) -> MockT m () Source # consecutiveTimes :: forall (m :: Type -> Type). MonadIO m => Multiplicity -> (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => ctx' m ()) -> MockT m () Source # | |
ExpectContext Expected Source # | |
Defined in Test.HMock.Internal.Step 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 -> Expected 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 -> Expected 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 -> Expected m () Source # inSequence :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> Expected m () Source # inAnyOrder :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> Expected m () Source # anyOf :: forall (m :: Type -> Type). MonadIO m => (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => [ctx' m ()]) -> Expected m () Source # times :: forall (m :: Type -> Type). MonadIO m => Multiplicity -> (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => ctx' m ()) -> Expected m () Source # consecutiveTimes :: forall (m :: Type -> Type). MonadIO m => Multiplicity -> (forall (ctx' :: (Type -> Type) -> Type -> Type). ExpectContext ctx' => ctx' m ()) -> Expected m () Source # |