more convenient way to use a fixed seed for a test group

[ghorn]

I would like to use our extensive hedgehog test suite on my continuous integration server, but fortunately and unfortunately it occasionally finds new corner cases and fails commits which have nothing to do with the hedgehog tests so I had to disable them.

The solution seems to be to always run with the same seed on CI to prevent regressions but not find new issues, and then some mega nightly build with a random seed to look for new failures.

The problem is the only seeded test function I could find is recheck which serves a different purpose. Is there a reason that Hedgehog.Internal.Runner.checkGroupWith can't take a seed? I could jigger recheck to do this but I would be missing out on all the advantages of using checkGroup.

[ghorn]

If someone could provide a few pointers, I'd be happy to do this work.

[thumphries]

Hey! Sorry for the slow.

We should be able to support this workflow with a couple of changes. If you float a Maybe Seed up into the signature for checkGroupWith, that is probably a good start. We can bikeshed the API change once it's working.

Currently each property gets a new seed in checkNamed, which calls checkRegion, which takes a Seed. I'm not too sure what the behaviour should be with a fixed seed, but you might want to split it before each property.

It's a little outside the way most people use Hedgehog, usually the continuous search for bugs in CI is a feature. But I see where you're coming from and we should have a better story. Anecdotally I have heard of teams discouraged from doing property-based testing in monorepo situations, which is pretty terrible!

[thumphries]

An alternative design: read HEDGEHOG_SEED from ENV and use that if defined. Unsure if wise

[ghorn]

Thanks for the pointers. I strongly prefer the API change over the environment variable. Let me give it a try.

[moodmosaic]

What's stopping you from setting the HEDGEHOG_SEED from the build agent? We do pretty much similar stuff in Config.

[moodmosaic]

Here's a patch for setting a fixed seed through the HEDGEHOG_SEED environment variable, which has to be in the form of 15417483394291888538 15013407834460730181.

diff --git a/hedgehog/src/Hedgehog/Internal/Config.hs b/hedgehog/src/Hedgehog/Internal/Config.hs
index c679959..efd3320 100644
--- a/hedgehog/src/Hedgehog/Internal/Config.hs
+++ b/hedgehog/src/Hedgehog/Internal/Config.hs
@@ -8,6 +8,9 @@ module Hedgehog.Internal.Config (
     UseColor(..)
   , resolveColor
 
+  , Seed(..)
+  , resolveSeed
+
   , Verbosity(..)
   , resolveVerbosity
 
@@ -16,14 +19,20 @@ module Hedgehog.Internal.Config (
 
   , detectMark
   , detectColor
+  , detectSeed
   , detectVerbosity
   , detectWorkers
   ) where
 
 import           Control.Monad.IO.Class (MonadIO(..))
 
+import qualified Data.Text as Text
+
 import qualified GHC.Conc as Conc
 
+import           Hedgehog.Internal.Seed (Seed(..))
+import qualified Hedgehog.Internal.Seed as Seed
+
 import           Language.Haskell.TH.Lift (deriveLift)
 
 import           System.Console.ANSI (hSupportsANSI)
@@ -106,6 +115,20 @@ detectColor =
           else
             pure DisableColor
 
+detectSeed :: MonadIO m => m Seed
+detectSeed =
+  liftIO $ do
+    menv <- lookupEnv "HEDGEHOG_SEED"
+    case menv of
+      Nothing ->
+        Seed.random
+      Just env ->
+        let
+          [value, gamma] =
+            read . Text.unpack <$> Text.splitOn (Text.pack " ") (Text.pack env)
+        in
+          pure $ Seed value gamma
+
 detectVerbosity :: MonadIO m => m Verbosity
 detectVerbosity =
   liftIO $ do
@@ -141,6 +164,13 @@ resolveColor = \case
   Just x ->
     pure x
 
+resolveSeed :: MonadIO m => Maybe Seed -> m Seed
+resolveSeed = \case
+  Nothing ->
+    detectSeed
+  Just x ->
+    pure x
+
 resolveVerbosity :: MonadIO m => Maybe Verbosity -> m Verbosity
 resolveVerbosity = \case
   Nothing ->
diff --git a/hedgehog/src/Hedgehog/Internal/Runner.hs b/hedgehog/src/Hedgehog/Internal/Runner.hs
index 6c71f42..806145d 100644
--- a/hedgehog/src/Hedgehog/Internal/Runner.hs
+++ b/hedgehog/src/Hedgehog/Internal/Runner.hs
@@ -62,6 +62,9 @@ data RunnerConfig =
       --   the environment.
     , runnerColor :: !(Maybe UseColor)
 
+      -- |
+    , runnerSeed :: !(Maybe Seed)
+
       -- | How verbose to be in the runner output. 'Nothing' means detect from
       --   the environment.
     , runnerVerbosity :: !(Maybe Verbosity)
@@ -236,10 +239,11 @@ checkNamed ::
   => Region
   -> Maybe UseColor
   -> Maybe PropertyName
+  -> Maybe Seed
   -> Property
   -> m (Report Result)
-checkNamed region mcolor name prop = do
-  seed <- liftIO Seed.random
+checkNamed region mcolor name mseed prop = do
+  seed <- resolveSeed mseed
   checkRegion region mcolor name 0 seed prop
 
 -- | Check a property.
@@ -247,7 +251,7 @@ checkNamed region mcolor name prop = do
 check :: MonadIO m => Property -> m Bool
 check prop =
   liftIO . displayRegion $ \region ->
-    (== OK) . reportStatus <$> checkNamed region Nothing Nothing prop
+    (== OK) . reportStatus <$> checkNamed region Nothing Nothing Nothing prop
 
 -- | Check a property using a specific size and seed.
 --
@@ -275,8 +279,10 @@ checkGroup config (Group group props) =
 #endif
     putStrLn $ "━━━ " ++ unGroupName group ++ " ━━━"
 
+    seed <- resolveSeed (runnerSeed config)
     verbosity <- resolveVerbosity (runnerVerbosity config)
-    summary <- checkGroupWith n verbosity (runnerColor config) props
+    summary <- checkGroupWith n verbosity (runnerColor config) seed props
 
     pure $
       summaryFailed summary == 0 &&
@@ -291,9 +297,10 @@ checkGroupWith ::
      WorkerCount
   -> Verbosity
   -> Maybe UseColor
+  -> Seed
   -> [(PropertyName, Property)]
   -> IO Summary
-checkGroupWith n verbosity mcolor props =
+checkGroupWith n verbosity mcolor seed props =
   displayRegion $ \sregion -> do
     svar <- atomically . TVar.newTVar $ mempty { summaryWaiting = PropertyCount (length props) }
 
@@ -331,7 +338,7 @@ checkGroupWith n verbosity mcolor props =
     summary <-
       fmap (mconcat . fmap (fromResult . reportStatus)) $
         runTasks n props start finish finalize $ \(name, prop, region) -> do
-          result <- checkNamed region mcolor (Just name) prop
+          result <- checkNamed region mcolor (Just name) (Just seed) prop
           updateSummary sregion svar mcolor
             (<> fromResult (reportStatus result))
           pure result
@@ -364,6 +371,8 @@ checkSequential =
           Just 1
       , runnerColor =
           Nothing
+      , runnerSeed =
+          Nothing
       , runnerVerbosity =
           Nothing
       }
@@ -398,6 +407,8 @@ checkParallel =
           Nothing
       , runnerColor =
           Nothing
+      , runnerSeed =
+          Nothing
       , runnerVerbosity =
           Nothing
       }
diff --git a/hedgehog/src/Hedgehog/Internal/Seed.hs b/hedgehog/src/Hedgehog/Internal/Seed.hs
index b224331..5618879 100644
--- a/hedgehog/src/Hedgehog/Internal/Seed.hs
+++ b/hedgehog/src/Hedgehog/Internal/Seed.hs
@@ -1,5 +1,6 @@
 {-# OPTIONS_HADDOCK not-home #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
 -- |
 -- This is a port of "Fast Splittable Pseudorandom Number Generators" by Steele
 -- et. al. [1].
@@ -61,6 +62,8 @@ import           Data.IORef (IORef)
 import qualified Data.IORef as IORef
 import           Data.Word (Word32, Word64)
 
+import           Language.Haskell.TH.Lift (deriveLift)
+
 import           System.IO.Unsafe (unsafePerformIO)
 import           System.Random (RandomGen)
 import qualified System.Random as Random
@@ -233,3 +236,8 @@ instance RandomGen Seed where
 -- These functions are exported in case you need them in a pinch, but are not
 -- part of the public API and may change at any time, even as part of a minor
 -- update.
+
+------------------------------------------------------------------------
+-- FIXME Replace with DeriveLift when we drop 7.10 support.
+
+$(deriveLift ''Seed)

See if it works for you, and if it does, let's discuss about taking that in instead of #234. And perhaps there are other, easier ways of doing this. /cc @jystic @thumphries

[moodmosaic]

@peddie, @thumphries, here's some sample usage:

import           Control.Monad.IO.Class (MonadIO(..))

import           Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

import           Hedgehog.Internal.Runner

checkSequentialWith :: MonadIO m => RunnerConfig -> Group -> m Bool
checkSequentialWith config =
  checkGroup config

tests :: IO Bool
tests =
  checkSequentialWith
    RunnerConfig {
        runnerWorkers =
          Nothing
      , runnerColor =
          Nothing
      , runnerVerbosity =
          Nothing
      , runnerSeed =
          Just $ Seed 123 456
      }
    $$(discover)

That, or just set the HEDGEHOG_SEED environment variable.

---

This pretty much follows the same pattern used for the rest of the stuff in RunnerConfig. See updated diff above.

[peddie]

Even though it's Internal, with the ability to set the seed directly via the RunnerConfig, I'd be happy with this diff.

[ghorn]

That works for me.

[simfleischman]

Are there any objections to applying this patch in a PR to the master branch?

[moodmosaic]

None that I know of 👍

[simfleischman]

Great, #424 is ready to go from my perspective. I'm happy to change as needed.

[jacobstanley]

Merged #446 (which is an update of #424)

[jacobstanley]

Available in hedgehog-1.1.1