From 9c85082114fc01c0cd82f4b2ad1e41d690405ff3 Mon Sep 17 00:00:00 2001 From: Phil Hazelden Date: Fri, 23 Aug 2024 15:39:54 +0100 Subject: [PATCH 1/4] Add callstacks to generators that can error. Previously, `val <- Gen.element []` would give an error like Hedgehog.Gen.element: used with empty Foldable CallStack (from HasCallStack): error, called at src/Hedgehog/Internal/Gen.hs:1197:5 in hedgehog-1.4-FEcjASqhnyiHkb8BJanjYM:Hedgehog.Internal.Gen Which isn't very helpful. Now the callstack entry points to my own code, instead. --- hedgehog/src/Hedgehog/Internal/Gen.hs | 71 ++++++++++++++------------- 1 file changed, 37 insertions(+), 34 deletions(-) diff --git a/hedgehog/src/Hedgehog/Internal/Gen.hs b/hedgehog/src/Hedgehog/Internal/Gen.hs index cdafef29..0168c037 100644 --- a/hedgehog/src/Hedgehog/Internal/Gen.hs +++ b/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. From 01f9fb3bf7ae83e75ea8e9241432c03847e0f4a7 Mon Sep 17 00:00:00 2001 From: Phil Hazelden Date: Tue, 27 Aug 2024 09:21:54 +0100 Subject: [PATCH 2/4] Drop support for GHC 8.0.2. 9c850821 doesn't compile on it, and 8.2.1 was released in 2017. --- .github/workflows/ci.yaml | 6 ++---- hedgehog/hedgehog.cabal | 3 +-- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index d5c433e1..b3f1374d 100644 --- a/.github/workflows/ci.yaml +++ b/.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' diff --git a/hedgehog/hedgehog.cabal b/hedgehog/hedgehog.cabal index 8fbad887..8604bdfb 100644 --- a/hedgehog/hedgehog.cabal +++ b/hedgehog/hedgehog.cabal @@ -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 From 8ec24b0cd561d6d6e5a405a1e418531ba6be0769 Mon Sep 17 00:00:00 2001 From: Phil Hazelden Date: Tue, 27 Aug 2024 09:26:31 +0100 Subject: [PATCH 3/4] Update changelog. --- CHANGELOG.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 590b65f4..be8eba10 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## Version 1.6 (unreleased) + +* 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]: From ec5f8347c690241c152cbb488a91937ceb91b65b Mon Sep 17 00:00:00 2001 From: Phil Hazelden Date: Tue, 27 Aug 2024 09:26:37 +0100 Subject: [PATCH 4/4] Bump to 1.6. --- CHANGELOG.md | 2 +- hedgehog-quickcheck/hedgehog-quickcheck.cabal | 2 +- hedgehog/hedgehog.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index be8eba10..18902097 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,4 @@ -## Version 1.6 (unreleased) +## 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]) diff --git a/hedgehog-quickcheck/hedgehog-quickcheck.cabal b/hedgehog-quickcheck/hedgehog-quickcheck.cabal index 2c357050..6b6818fc 100644 --- a/hedgehog-quickcheck/hedgehog-quickcheck.cabal +++ b/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 diff --git a/hedgehog/hedgehog.cabal b/hedgehog/hedgehog.cabal index 8604bdfb..942bc1cd 100644 --- a/hedgehog/hedgehog.cabal +++ b/hedgehog/hedgehog.cabal @@ -1,4 +1,4 @@ -version: 1.5 +version: 1.6 name: hedgehog