22
22
module Test.QuickCheck.StateModel (
23
23
StateModel (.. ),
24
24
RunModel (.. ),
25
- defaultRunModel ,
26
25
Any (.. ),
27
26
Step (.. ),
28
27
LookUp ,
@@ -134,36 +133,30 @@ type instance Realized IO a = a
134
133
type instance Realized (StateT s m ) a = Realized m a
135
134
type instance Realized (ReaderT r m ) a = Realized m a
136
135
137
- -- TODO: Maybe now it's time to turn this into it's own type class
138
- data RunModel state m = RunModel { -- | Perform an `Action` in some `state` in the `Monad` `m`. This
139
- -- is the function that's used to exercise the actual stateful
140
- -- implementation, usually through various side-effects as permitted
141
- -- by `m`. It produces a value of type `a`, eg. some observable
142
- -- output from the `Action` that should later be kept in the
143
- -- environment through a `Var a` also passed to the `nextState`
144
- -- function.
145
- --
146
- -- The `Lookup` parameter provides an /environment/ to lookup `Var
147
- -- a` instances from previous steps.
148
- perform :: forall a . ActionResult a => state -> Action state a -> LookUp m -> m (Realized m a )
149
- , -- | Postcondition on the `a` value produced at some step.
150
- -- The result is `assert`ed and will make the property fail should it be `False`. This is useful
151
- -- to check the implementation produces expected values.
152
- postcondition :: forall a . state -> Action state a -> LookUp m -> Realized m a -> Bool
153
- , -- | Allows the user to attach information to the `Property` at each step of the process.
154
- -- This function is given the full transition that's been executed, including the start and ending
155
- -- `state`, the `Action`, the current environment to `Lookup` and the value produced by `perform`
156
- -- while executing this step.
157
- monitoring :: forall a . (state , state ) -> Action state a -> LookUp m -> Realized m a -> Property -> Property
158
- }
159
-
160
- defaultRunModel :: Monad m
161
- => (forall a . ActionResult a => state -> Action state a -> LookUp m -> m (Realized m a ))
162
- -> RunModel state m
163
- defaultRunModel perform = RunModel { perform = perform
164
- , postcondition = \ _ _ _ _ -> True
165
- , monitoring = \ _ _ _ _ prop -> prop
166
- }
136
+ class Monad m => RunModel state m where
137
+ -- | Perform an `Action` in some `state` in the `Monad` `m`. This
138
+ -- is the function that's used to exercise the actual stateful
139
+ -- implementation, usually through various side-effects as permitted
140
+ -- by `m`. It produces a value of type `a`, eg. some observable
141
+ -- output from the `Action` that should later be kept in the
142
+ -- environment through a `Var a` also passed to the `nextState`
143
+ -- function.
144
+ --
145
+ -- The `Lookup` parameter provides an /environment/ to lookup `Var
146
+ -- a` instances from previous steps.
147
+ perform :: forall a . ActionResult a => state -> Action state a -> LookUp m -> m (Realized m a )
148
+ -- | Postcondition on the `a` value produced at some step.
149
+ -- The result is `assert`ed and will make the property fail should it be `False`. This is useful
150
+ -- to check the implementation produces expected values.
151
+ postcondition :: forall a . state -> Action state a -> LookUp m -> Realized m a -> m Bool
152
+ postcondition _ _ _ _ = pure True
153
+ -- | Allows the user to attach information to the `Property` at each step of the process.
154
+ -- This function is given the full transition that's been executed, including the start and ending
155
+ -- `state`, the `Action`, the current environment to `Lookup` and the value produced by `perform`
156
+ -- while executing this step.
157
+ monitoring :: forall a . (state , state ) -> Action state a -> LookUp m -> Realized m a -> Property -> Property
158
+ monitoring _ _ _ _ prop = prop
159
+
167
160
168
161
type LookUp m = forall a . Typeable a = > Var a -> Realized m a
169
162
@@ -321,20 +314,18 @@ stateAfter (Actions actions) = loop initialState actions
321
314
322
315
runActions ::
323
316
forall state m .
324
- (StateModel state , Monad m ) =>
325
- RunModel state m ->
317
+ (StateModel state , RunModel state m ) =>
326
318
Actions state ->
327
319
PropertyM m (state , Env m )
328
320
runActions = runActionsInState @ _ @ m initialState
329
321
330
322
runActionsInState ::
331
323
forall state m .
332
- (StateModel state , Monad m ) =>
324
+ (StateModel state , RunModel state m ) =>
333
325
state ->
334
- RunModel state m ->
335
326
Actions state ->
336
327
PropertyM m (state , Env m )
337
- runActionsInState state RunModel { .. } (Actions_ rejected (Smart _ actions)) = loop state [] actions
328
+ runActionsInState st (Actions_ rejected (Smart _ actions)) = loop st [] actions
338
329
where
339
330
loop _s env [] = do
340
331
unless (null rejected) $
@@ -348,6 +339,7 @@ runActionsInState state RunModel{..} (Actions_ rejected (Smart _ actions)) = loo
348
339
let var = Var n
349
340
s' = nextState s act var
350
341
env' = (var :== ret) : env
351
- monitor (monitoring (s, s') act (lookUpVar env') ret)
352
- assert $ postcondition s act (lookUpVar env) ret
342
+ monitor (monitoring @ state @ m (s, s') act (lookUpVar env') ret)
343
+ b <- run $ postcondition s act (lookUpVar env) ret
344
+ assert b
353
345
loop s' env' as
0 commit comments