Extract non-discarding implies QuickCheck utility

Author: amesgen

ouroboros-consensus-diffusion/changelog.d/20240425_110304_alexander.esgen_customize_prefer_candidate.md

@@ -74,6 +74,7 @@ import           Test.Util.HardFork.Future (Future)
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Orphans.IOLike ()
 import           Test.Util.Orphans.NoThunks ()
+import           Test.Util.QuickCheck
 import           Test.Util.Range
 import           Test.Util.Shrink (andId, dropId)
 import           Test.Util.Slots (NumSlots (..))
@@ -674,10 +675,6 @@ prop_general_internal syncity pga testOutput =
                 | ((s1, _, max1), (s2, min2, _)) <- orderedPairs extrema
                 ]
       where
-        -- QuickCheck's @==>@ 'discard's the test if @p1@ fails; that's not
-        -- what we want
-        implies p1 p2 = not p1 .||. p2
-
         -- all pairs @(x, y)@ where @x@ precedes @y@ in the given list
         orderedPairs :: [a] -> [(a, a)]
         orderedPairs = \case

ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/General.hs

@@ -28,6 +28,7 @@ module Test.Util.QuickCheck (
     -- * Convenience
   , collects
   , forAllGenRunShrinkCheck
+  , implies
   ) where
 
 import           Control.Monad.Except
@@ -218,3 +219,10 @@ shrinkNP g f np = npToSListI np $ cshrinkNP (Proxy @Top) g f np
 
 collects :: Show a => [a] -> Property -> Property
 collects = repeatedly collect
+
+-- | QuickCheck's '==>' 'discard's the test if @p1@ fails; this is sometimes not
+-- what we want, for example if we have other properties that do not depend on
+-- @p1@ being true.
+implies :: Testable prop => Bool -> prop -> Property
+implies p1 p2 = not p1 .||. p2
+infixr 0 `implies`