Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add callstacks to generators that can error. #538

Merged
merged 4 commits into from
Aug 31, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 2 additions & 4 deletions .github/workflows/ci.yaml
Original file line number Diff line number Diff line change
@@ -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'
7 changes: 7 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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]:
2 changes: 1 addition & 1 deletion hedgehog-quickcheck/hedgehog-quickcheck.cabal
Original file line number Diff line number Diff line change
@@ -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

5 changes: 2 additions & 3 deletions hedgehog/hedgehog.cabal
Original file line number Diff line number Diff line change
@@ -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
71 changes: 37 additions & 34 deletions hedgehog/src/Hedgehog/Internal/Gen.hs
Original file line number Diff line number Diff line change
@@ -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.
Loading