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

Improve error handling in constrained genFromSpec #4822

Merged
merged 1 commit into from
Jan 10, 2025
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
10 changes: 2 additions & 8 deletions libs/constrained-generators/src/Constrained/Base.hs
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,6 @@ module Constrained.Base where

import Control.Applicative
import Control.Arrow (first)
import Control.Exception (SomeException, catch)
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Writer (Writer, runWriter, tell)
Expand All @@ -76,7 +75,6 @@ import GHC.Real
import GHC.Stack
import GHC.TypeLits
import Prettyprinter
import System.IO.Unsafe
import System.Random
import System.Random.Stateful
import Test.QuickCheck hiding (Args, Fun, forAll)
Expand Down Expand Up @@ -1285,12 +1283,8 @@ envFromPred env p = case p of
-- | A version of `genFromSpecT` that simply errors if the generator fails
genFromSpec :: forall fn a. (HasCallStack, HasSpec fn a) => Specification fn a -> Gen a
genFromSpec spec = do
res <- strictGen $ explain1 "Calling genFromSpec" $ do
r <- genFromSpecT spec
unsafePerformIO $
r `seq`
pure (pure r) `catch` \(e :: SomeException) -> pure (fatalError (pure $ show e))
errorGE $ fmap pure res
res <- catchGen $ genFromSpecT @fn @a @GE spec
either (error . show . NE.toList) pure res

-- | A version of `genFromSpecT` that takes a seed and a size and gives you a result
genFromSpecWithSeed ::
Expand Down
Loading