{-# 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 (..))
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
(:->) ::
Matcher 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
_ (Matcher cls name m r
m :-> Maybe (Action cls name m r -> MockT m r)
_))) =
Located String -> String
withLoc (Maybe (Action cls name m Any) -> Matcher cls name m r -> String
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) a b.
MockableBase cls =>
Maybe (Action cls name m a) -> Matcher cls name m b -> String
showMatcher Maybe (Action cls name m Any)
forall a. Maybe a
Nothing Matcher 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 (Matcher 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 (Matcher cls name m r
m Matcher 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.
Matcher 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 (Matcher 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
. (Matcher cls name m r
m Matcher 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.
Matcher 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
_ (Matcher 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 (Matcher 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 (Matcher cls name m r
m Matcher 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.
Matcher 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 (Matcher cls name m r
m Matcher cls name m r
-> [Action cls name m r -> MockT m r] -> Rule cls name m r
forall (cls :: (* -> *) -> Constraint) (name :: Symbol)
(m :: * -> *) r.
Matcher 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 (Matcher 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 (Matcher cls name m r
m Matcher 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.
Matcher 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))