Add callstacks to generators that can error.

.github/workflows/ci.yaml

@@ -14,11 +14,9 @@ jobs:
       matrix:
         os:    [macos-latest, ubuntu-latest, windows-latest]
         cabal: ["3.10.1.0"]
-        ghc:   ["8.0.2", "8.2.2", "8.4.4", "8.6.5", "8.8.4", "8.10.7", "9.2.7", "9.4.4", "9.8.2", "9.10.1"]
+        ghc:   ["8.2.2", "8.4.4", "8.6.5", "8.8.4", "8.10.7", "9.2.7", "9.4.4", "9.8.2", "9.10.1"]
         exclude:
           # https://github.com/haskell/text/pull/404
-          - os: windows-latest
-            ghc: "8.0.2"
           - os: windows-latest
             ghc: "8.2.2"
 
@@ -53,4 +51,4 @@ jobs:
       - name: Build haddock
         run: |
           cabal haddock all
-        if: matrix.ghc != '8.0.2' && matrix.ghc != '8.2.2' && matrix.ghc != '8.4.4'
+        if: matrix.ghc != '8.2.2' && matrix.ghc != '8.4.4'

CHANGELOG.md

@@ -1,3 +1,8 @@
+## Version 1.6 (2024-08-27)
+
+* Add callstacks to generators that can error ([#538][538], [@ChickenProp][ChickenProp])
+* Drop support for GHC 8.0.2 ([#538][538], [@ChickenProp][ChickenProp])
+
 ## Version 1.5 (2024-07-25)
 
 * Bump containers and filepath dependencies ([#533][533], [@erikd][erikd])
@@ -316,6 +321,8 @@
 [Vekhir]:
   https://github.com/Vekhir
 
+[538]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/538
 [533]:
   https://github.com/hedgehogqa/haskell-hedgehog/pull/533
 [531]:

hedgehog-quickcheck/hedgehog-quickcheck.cabal

@@ -50,7 +50,7 @@ source-repository head
 library
   build-depends:
       base                            >= 3          && < 5
-    , hedgehog                        >= 0.5        && < 1.6
+    , hedgehog                        >= 0.5        && < 1.7
     , QuickCheck                      >= 2.7        && < 2.16
     , transformers                    >= 0.4        && < 0.7
 

hedgehog/hedgehog.cabal

@@ -1,4 +1,4 @@
-version: 1.5
+version: 1.6
 
 name:
   hedgehog
@@ -33,8 +33,7 @@ cabal-version:
 build-type:
   Simple
 tested-with:
-    GHC == 8.0.2
-  , GHC == 8.2.2
+    GHC == 8.2.2
   , GHC == 8.4.4
   , GHC == 8.6.5
   , GHC == 8.8.3

hedgehog/src/Hedgehog/Internal/Gen.hs

@@ -231,6 +231,7 @@ import           Hedgehog.Internal.Prelude hiding (either, maybe, seq)
 import           Hedgehog.Internal.Seed (Seed)
 import qualified Hedgehog.Internal.Seed as Seed
 import qualified Hedgehog.Internal.Shrink as Shrink
+import           Hedgehog.Internal.Source (HasCallStack, withFrozenCallStack)
 import           Hedgehog.Internal.Tree (Tree, TreeT(..), NodeT(..))
 import qualified Hedgehog.Internal.Tree as Tree
 import           Hedgehog.Range (Size, Range)
@@ -749,18 +750,19 @@ resize size gen =
 
 -- | Adjust the size parameter by transforming it with the given function.
 --
-scale :: MonadGen m => (Size -> Size) -> m a -> m a
+scale :: (HasCallStack, MonadGen m) => (Size -> Size) -> m a -> m a
 scale f =
-  withGenT $ \gen ->
-    GenT $ \size0 seed ->
-      let
-        size =
-          f size0
-      in
-        if size < 0 then
-          error "Hedgehog.Gen.scale: negative size"
-        else
-          runGenT size seed gen
+  withFrozenCallStack $
+    withGenT $ \gen ->
+      GenT $ \size0 seed ->
+        let
+          size =
+            f size0
+        in
+          if size < 0 then
+            error "Hedgehog.Gen.scale: negative size"
+          else
+            runGenT size seed gen
 
 -- | Make a generator smaller by scaling its size parameter.
 --
@@ -1191,8 +1193,8 @@ constant =
 --
 --   /The input list must be non-empty./
 --
-element :: (Foldable f, MonadGen m) => f a -> m a
-element fa = case toList fa of
+element :: (HasCallStack, Foldable f, MonadGen m) => f a -> m a
+element fa = withFrozenCallStack $ case toList fa of
   [] ->
     error "Hedgehog.Gen.element: used with empty Foldable"
   xs -> do
@@ -1205,8 +1207,8 @@ element fa = case toList fa of
 --
 --   /The input list must be non-empty./
 --
-element_ :: MonadGen m => [a] -> m a
-element_ = \case
+element_ :: (HasCallStack, MonadGen m) => [a] -> m a
+element_ = withFrozenCallStack . \case
   [] ->
     error "Hedgehog.Gen.element: used with empty list"
   xs -> do
@@ -1219,8 +1221,8 @@ element_ = \case
 --
 --   /The input list must be non-empty./
 --
-choice :: MonadGen m => [m a] -> m a
-choice = \case
+choice :: (HasCallStack, MonadGen m) => [m a] -> m a
+choice = withFrozenCallStack . \case
   [] ->
     error "Hedgehog.Gen.choice: used with empty list"
   xs -> do
@@ -1234,8 +1236,8 @@ choice = \case
 --
 --   /The input list must be non-empty./
 --
-frequency :: MonadGen m => [(Int, m a)] -> m a
-frequency = \case
+frequency :: (HasCallStack, MonadGen m) => [(Int, m a)] -> m a
+frequency = withFrozenCallStack . \case
   [] ->
     error "Hedgehog.Gen.frequency: used with empty list"
   xs0 -> do
@@ -1815,22 +1817,23 @@ shuffleSeq xs =
 --     i <- Gen.int
 --     i /== 0
 -- @
-sample :: MonadIO m => Gen a -> m a
+sample :: (HasCallStack, MonadIO m) => Gen a -> m a
 sample gen =
-  liftIO $
-    let
-      loop n =
-        if n <= 0 then
-          error "Hedgehog.Gen.sample: too many discards, could not generate a sample"
-        else do
-          seed <- Seed.random
-          case evalGen 30 seed gen of
-            Nothing ->
-              loop (n - 1)
-            Just x ->
-              pure $ Tree.treeValue x
-    in
-      loop (100 :: Int)
+  withFrozenCallStack $
+    liftIO $
+      let
+        loop n =
+          if n <= 0 then
+            error "Hedgehog.Gen.sample: too many discards, could not generate a sample"
+          else do
+            seed <- Seed.random
+            case evalGen 30 seed gen of
+              Nothing ->
+                loop (n - 1)
+              Just x ->
+                pure $ Tree.treeValue x
+      in
+        loop (100 :: Int)
 
 -- | Run a generator with a random seed and print the outcome, and the first
 --   level of shrinks.