More utility functions

Author: MaximilianAlgehed

quickcheck-dynamic/src/Test/QuickCheck/DynamicLogic.hs

@@ -27,6 +27,9 @@ module Test.QuickCheck.DynamicLogic (
   forAllDL,
   forAllMappedDL,
   forAllUniqueDL,
+  forAllDLS,
+  forAllMappedDLS,
+  forAllUniqueDLS,
   DL.DynLogicModel (..),
   module Test.QuickCheck.DynamicLogic.Quantify,
 ) where
@@ -133,24 +136,21 @@ forAllNonVariableQ q = DL $ \s k -> DL.forAllQ (hasNoVariablesQ q) $ \(HasNoVari
 runDL :: Annotated s -> DL s () -> DL.DynFormula s
 runDL s dl = (unDL dl s $ \_ _ -> DL.passTest)
 
--- TODO: We probably want versions of these three functions that take an `s` so that you can write DL
--- properties that are only true in a specific starting state rather than a random starting state.
-
 forAllUniqueDL
   :: (DL.DynLogicModel s, Testable a)
   => DL s ()
   -> (Actions s -> a)
   -> Property
 forAllUniqueDL d p =
-  forAllBlind initialState $ \st -> DL.forAllUniqueScripts st (runDL (Metadata mempty st) d) p
+  forAllBlind initialState $ \st -> forAllUniqueDLS st d p
 
 forAllDL
   :: (DL.DynLogicModel s, Testable a)
   => DL s ()
   -> (Actions s -> a)
   -> Property
 forAllDL d p =
-  forAllBlind initialState $ \st -> DL.forAllScripts st (runDL (Metadata mempty st) d) p
+  forAllBlind initialState $ \st -> forAllDLS st d p
 
 forAllMappedDL
   :: (DL.DynLogicModel s, Testable a)
@@ -161,5 +161,34 @@ forAllMappedDL
   -> (srep -> a)
   -> Property
 forAllMappedDL to from fromScript d prop =
-  forAll initialState $ \st ->
-    DL.forAllMappedScripts st to from (runDL (Metadata mempty st) d) (prop . fromScript)
+  forAll initialState $ \st -> forAllMappedDLS st to from fromScript d prop
+
+forAllUniqueDLS
+  :: (DL.DynLogicModel s, Testable a)
+  => s
+  -> DL s ()
+  -> (Actions s -> a)
+  -> Property
+forAllUniqueDLS st d p =
+  DL.forAllUniqueScripts st (runDL (Metadata mempty st) d) p
+
+forAllDLS
+  :: (DL.DynLogicModel s, Testable a)
+  => s
+  -> DL s ()
+  -> (Actions s -> a)
+  -> Property
+forAllDLS st d p =
+  DL.forAllScripts st (runDL (Metadata mempty st) d) p
+
+forAllMappedDLS
+  :: (DL.DynLogicModel s, Testable a)
+  => s
+  -> (rep -> DL.DynLogicTest s)
+  -> (DL.DynLogicTest s -> rep)
+  -> (Actions s -> srep)
+  -> DL s ()
+  -> (srep -> a)
+  -> Property
+forAllMappedDLS st to from fromScript d prop =
+  DL.forAllMappedScripts st to from (runDL (Metadata mempty st) d) (prop . fromScript)