From fb036f50e0e5f08630f1a8738ca7a0610175a34d Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Fri, 15 Dec 2023 13:10:34 +0100 Subject: [PATCH] A monitoring callback called when a positive action fails --- quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs b/quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs index 037af60..fd2f370 100644 --- a/quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs +++ b/quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs @@ -49,7 +49,6 @@ import Data.List import Data.Monoid (Endo (..)) import Data.Set qualified as Set import GHC.Generics -import GHC.Stack import Test.QuickCheck as QC import Test.QuickCheck.DynamicLogic.SmartShrinking import Test.QuickCheck.Monadic @@ -211,6 +210,10 @@ class (forall a e. Show (Action state e a), Monad m) => RunModel state m where monitoring :: (state, state) -> Action state e a -> LookUp m -> Either (Realized m e) (Realized m a) -> Property -> Property monitoring _ _ _ _ prop = prop + -- | Allows the user to attach additional information to the `Property` if a positive action fails. + monitoringFailure :: state -> Action state e a -> LookUp m -> Realized m e -> Property -> Property + monitoringFailure _ _ _ _ prop = prop + computePostcondition :: forall m state e a . RunModel state m @@ -500,6 +503,10 @@ runActions (Actions_ rejected (Smart _ actions)) = loop initialAnnotatedState [] | otherwise = env monitor $ tabulate "Action polarity" [show $ polarity act] monitor $ monitoring @state @m (underlyingState s, underlyingState s') (polarAction act) (lookUpVar env') ret + when (polarity act == PosPolarity) $ do + case ret of + Left e -> monitor $ monitoringFailure @state @m (underlyingState s) (polarAction act) (lookUpVar env') e + _ -> pure () (b, (Endo mon, Endo onFail)) <- run . runWriterT