{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
module Test.HMock.Internal.Step where
import Data.Kind (Constraint, Type)
import Data.Maybe (listToMaybe)
import GHC.Stack (CallStack, callStack)
import GHC.TypeLits (Symbol)
import Test.HMock.ExpectContext (ExpectContext (..), MockableMethod)
import Test.HMock.Internal.ExpectSet (ExpectSet (..))
import Test.HMock.Internal.Rule
( Rule (..),
WholeMethodMatcher (..),
showWholeMatcher,
)
import {-# SOURCE #-} Test.HMock.Internal.State (MockT)
import Test.HMock.Internal.Util (Located (..), locate, withLoc)
import Test.HMock.Mockable (MockableBase (..))
import Test.HMock.Multiplicity
( Multiplicity,
anyMultiplicity,
feasible,
meetsMultiplicity,
)
import Test.HMock.Rule (Expectable (toRule))
data
SingleRule
(cls :: (Type -> Type) -> Constraint)
(name :: Symbol)
(m :: Type -> Type)
(r :: Type)
where
(:->) ::
WholeMethodMatcher cls name m r ->
Maybe (Action cls name m r -> MockT m r) ->
SingleRule cls name m r
data Step m where
Step ::
MockableMethod cls name m r =>
Located (SingleRule cls name m r) ->
Step m
instance Show (Step m) where
show :: Step m -> String
show (Step l :: Located (SingleRule cls name m r)
l@(Loc Maybe String
_ (WholeMethodMatcher cls name m r
m :-> Maybe (Action cls name m r -> MockT m r)
_))) =
Located String -> String
withLoc (Maybe (Action cls name m Any)
-> 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 Maybe (Action cls name m Any)
forall a. Maybe a
Nothing 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)
l)
expandRule ::
MockableMethod cls name m r =>
CallStack ->
Rule cls name m r ->
ExpectSet (Step m)
expandRule :: CallStack -> Rule cls name m r -> ExpectSet (Step m)
expandRule CallStack
callstack (WholeMethodMatcher cls name m r
m :=> []) =
Step m -> ExpectSet (Step m)
forall step. step -> ExpectSet step
ExpectStep (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
callstack (WholeMethodMatcher cls name m r
m WholeMethodMatcher 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.
WholeMethodMatcher cls name m r
-> Maybe (Action cls name m r -> MockT m r)
-> SingleRule cls name m r
:-> Maybe (Action cls name m r -> MockT m r)
forall a. Maybe a
Nothing)))
expandRule CallStack
callstack (WholeMethodMatcher cls name m r
m :=> [Action cls name m r -> MockT m r]
rs) =
(ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m))
-> [ExpectSet (Step m)] -> ExpectSet (Step m)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1
ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence
(((Action cls name m r -> MockT m r) -> ExpectSet (Step m))
-> [Action cls name m r -> MockT m r] -> [ExpectSet (Step m)]
forall a b. (a -> b) -> [a] -> [b]
map (Step m -> ExpectSet (Step m)
forall step. step -> ExpectSet step
ExpectStep (Step m -> ExpectSet (Step m))
-> ((Action cls name m r -> MockT m r) -> Step m)
-> (Action cls name m r -> MockT m r)
-> ExpectSet (Step m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Located (SingleRule cls name m r) -> Step m)
-> ((Action cls name m r -> MockT m r)
-> Located (SingleRule cls name m r))
-> (Action cls name m r -> MockT m r)
-> Step m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack
-> SingleRule cls name m r -> Located (SingleRule cls name m r)
forall a. CallStack -> a -> Located a
locate CallStack
callstack (SingleRule cls name m r -> Located (SingleRule cls name m r))
-> ((Action cls name m r -> MockT m r) -> SingleRule cls name m r)
-> (Action cls name m r -> MockT m r)
-> Located (SingleRule cls name m r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WholeMethodMatcher cls name m r
m WholeMethodMatcher 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.
WholeMethodMatcher cls name m r
-> Maybe (Action cls name m r -> MockT m r)
-> SingleRule 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))
-> (Action cls name m r -> MockT m r)
-> SingleRule cls name m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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]
rs)
expandRepeatRule ::
MockableMethod cls name m r =>
Multiplicity ->
CallStack ->
Rule cls name m r ->
ExpectSet (Step m)
expandRepeatRule :: Multiplicity
-> CallStack -> Rule cls name m r -> ExpectSet (Step m)
expandRepeatRule Multiplicity
mult CallStack
_ (WholeMethodMatcher cls name m r
_ :=> [Action cls name m r -> MockT m r]
rs)
| Bool -> Bool
not (Multiplicity -> Bool
feasible (Multiplicity
mult Multiplicity -> Multiplicity -> Multiplicity
forall a. Num a => a -> a -> a
- Int -> Multiplicity
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Action cls name m r -> MockT m r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Action cls name m r -> MockT m r]
rs))) =
String -> ExpectSet (Step m)
forall a. HasCallStack => String -> a
error (String -> ExpectSet (Step m)) -> String -> ExpectSet (Step m)
forall a b. (a -> b) -> a -> b
$
Int -> String
forall a. Show a => a -> String
show ([Action cls name m r -> MockT m r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Action cls name m r -> MockT m r]
rs)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" responses is too many for multiplicity "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Multiplicity -> String
forall a. Show a => a -> String
show Multiplicity
mult
expandRepeatRule Multiplicity
mult CallStack
callstack (WholeMethodMatcher cls name m r
m :=> (Action cls name m r -> MockT m r
r1 : Action cls name m r -> MockT m r
r2 : [Action cls name m r -> MockT m r]
rs))
| Multiplicity -> Int -> Bool
meetsMultiplicity Multiplicity
mult Int
0 = ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet (Step m)
forall step. ExpectSet step
ExpectNothing ExpectSet (Step m)
body
| Bool
otherwise = ExpectSet (Step m)
body
where
body :: ExpectSet (Step m)
body =
ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence
(Step m -> ExpectSet (Step m)
forall step. step -> ExpectSet step
ExpectStep (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
callstack (WholeMethodMatcher cls name m r
m WholeMethodMatcher 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.
WholeMethodMatcher 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
r1))))
(Multiplicity
-> CallStack -> Rule cls name m r -> ExpectSet (Step m)
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
MockableMethod cls name m r =>
Multiplicity
-> CallStack -> Rule cls name m r -> ExpectSet (Step m)
expandRepeatRule (Multiplicity
mult Multiplicity -> Multiplicity -> Multiplicity
forall a. Num a => a -> a -> a
- Multiplicity
1) CallStack
callstack (WholeMethodMatcher cls name m r
m WholeMethodMatcher cls name m r
-> [Action cls name m r -> MockT m r] -> Rule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
WholeMethodMatcher cls name m r
-> [Action cls name m r -> MockT m r] -> Rule cls name m r
:=> (Action cls name m r -> MockT m r
r2 (Action cls name m r -> MockT m r)
-> [Action cls name m r -> MockT m r]
-> [Action cls name m r -> MockT m r]
forall a. a -> [a] -> [a]
: [Action cls name m r -> MockT m r]
rs)))
expandRepeatRule Multiplicity
mult CallStack
callstack (WholeMethodMatcher cls name m r
m :=> [Action cls name m r -> MockT m r]
rs) =
Multiplicity -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive
Multiplicity
mult
(Step m -> ExpectSet (Step m)
forall step. step -> ExpectSet step
ExpectStep (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
callstack (WholeMethodMatcher cls name m r
m WholeMethodMatcher 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.
WholeMethodMatcher 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
listToMaybe [Action cls name m r -> MockT m r]
rs))))
newtype Expected m a = Expected {Expected m a -> ExpectSet (Step m)
unwrapExpected :: ExpectSet (Step m)}
instance ExpectContext Expected where
expect :: expectable -> Expected m ()
expect expectable
e = ExpectSet (Step m) -> Expected m ()
forall (m :: * -> *) a. ExpectSet (Step m) -> Expected m a
Expected (CallStack -> Rule cls name m r -> ExpectSet (Step m)
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
MockableMethod cls name m r =>
CallStack -> Rule cls name m r -> ExpectSet (Step m)
expandRule CallStack
HasCallStack => CallStack
callStack (expectable -> Rule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r ex.
Expectable cls name m r ex =>
ex -> Rule cls name m r
toRule expectable
e))
expectN :: Multiplicity -> expectable -> Expected m ()
expectN Multiplicity
mult expectable
e = ExpectSet (Step m) -> Expected m ()
forall (m :: * -> *) a. ExpectSet (Step m) -> Expected m a
Expected (Multiplicity
-> CallStack -> Rule cls name m r -> ExpectSet (Step m)
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
MockableMethod cls name m r =>
Multiplicity
-> CallStack -> Rule cls name m r -> ExpectSet (Step m)
expandRepeatRule Multiplicity
mult CallStack
HasCallStack => CallStack
callStack (expectable -> Rule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r ex.
Expectable cls name m r ex =>
ex -> Rule cls name m r
toRule expectable
e))
expectAny :: expectable -> Expected m ()
expectAny expectable
e =
ExpectSet (Step m) -> Expected m ()
forall (m :: * -> *) a. ExpectSet (Step m) -> Expected m a
Expected (Multiplicity
-> CallStack -> Rule cls name m r -> ExpectSet (Step m)
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
MockableMethod cls name m r =>
Multiplicity
-> CallStack -> Rule cls name m r -> ExpectSet (Step m)
expandRepeatRule Multiplicity
anyMultiplicity CallStack
HasCallStack => CallStack
callStack (expectable -> Rule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r ex.
Expectable cls name m r ex =>
ex -> Rule cls name m r
toRule expectable
e))
inSequence :: (forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()])
-> Expected m ()
inSequence forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()]
es = ExpectSet (Step m) -> Expected m ()
forall (m :: * -> *) a. ExpectSet (Step m) -> Expected m a
Expected ((ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m))
-> [ExpectSet (Step m)] -> ExpectSet (Step m)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ((Expected m () -> ExpectSet (Step m))
-> [Expected m ()] -> [ExpectSet (Step m)]
forall a b. (a -> b) -> [a] -> [b]
map Expected m () -> ExpectSet (Step m)
forall (m :: * -> *) a. Expected m a -> ExpectSet (Step m)
unwrapExpected [Expected m ()]
forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()]
es))
inAnyOrder :: (forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()])
-> Expected m ()
inAnyOrder forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()]
es = ExpectSet (Step m) -> Expected m ()
forall (m :: * -> *) a. ExpectSet (Step m) -> Expected m a
Expected ((ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m))
-> [ExpectSet (Step m)] -> ExpectSet (Step m)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ((Expected m () -> ExpectSet (Step m))
-> [Expected m ()] -> [ExpectSet (Step m)]
forall a b. (a -> b) -> [a] -> [b]
map Expected m () -> ExpectSet (Step m)
forall (m :: * -> *) a. Expected m a -> ExpectSet (Step m)
unwrapExpected [Expected m ()]
forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()]
es))
anyOf :: (forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()])
-> Expected m ()
anyOf forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()]
es = ExpectSet (Step m) -> Expected m ()
forall (m :: * -> *) a. ExpectSet (Step m) -> Expected m a
Expected ((ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m))
-> [ExpectSet (Step m)] -> ExpectSet (Step m)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ExpectSet (Step m) -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ((Expected m () -> ExpectSet (Step m))
-> [Expected m ()] -> [ExpectSet (Step m)]
forall a b. (a -> b) -> [a] -> [b]
map Expected m () -> ExpectSet (Step m)
forall (m :: * -> *) a. Expected m a -> ExpectSet (Step m)
unwrapExpected [Expected m ()]
forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
[ctx' m ()]
es))
times :: Multiplicity
-> (forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
ctx' m ())
-> Expected m ()
times Multiplicity
mult forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
ctx' m ()
e = ExpectSet (Step m) -> Expected m ()
forall (m :: * -> *) a. ExpectSet (Step m) -> Expected m a
Expected (Multiplicity -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti Multiplicity
mult (Expected m () -> ExpectSet (Step m)
forall (m :: * -> *) a. Expected m a -> ExpectSet (Step m)
unwrapExpected Expected m ()
forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
ctx' m ()
e))
consecutiveTimes :: Multiplicity
-> (forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
ctx' m ())
-> Expected m ()
consecutiveTimes Multiplicity
mult forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
ctx' m ()
e =
ExpectSet (Step m) -> Expected m ()
forall (m :: * -> *) a. ExpectSet (Step m) -> Expected m a
Expected (Multiplicity -> ExpectSet (Step m) -> ExpectSet (Step m)
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive Multiplicity
mult (Expected m () -> ExpectSet (Step m)
forall (m :: * -> *) a. Expected m a -> ExpectSet (Step m)
unwrapExpected Expected m ()
forall (ctx' :: (* -> *) -> * -> *).
ExpectContext ctx' =>
ctx' m ()
e))