diff --git a/registry-hedgehog.cabal b/registry-hedgehog.cabal --- a/registry-hedgehog.cabal +++ b/registry-hedgehog.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack -- --- hash: 65c1280eeb35adad6cc554972b941d6413be6f40dd7875f98069e60a99462ac8 +-- hash: 80cae4739a1678674cf425712cca0e20389f2795aa8f41542aa2bc529212cc2e name: registry-hedgehog -version: 0.8.0.0 +version: 0.8.1.0 synopsis: utilities to work with Hedgehog generators and `registry` description: This library provides some functions to extract generators from a "Registry" and make stateful modifications of that Registry to precisely control the generation of data category: Control @@ -54,11 +54,11 @@ , protolude ==0.3.* , registry >=0.4 && <1 , tasty ==1.* - , tasty-discover >=2 && <5 + , tasty-discover >=2 && <6 , tasty-hedgehog >=1.0 && <2.0 , tasty-th >=0.1 && <1 , template-haskell >=2.13 && <3.0 - , text ==1.* + , text >=1 && <3 , transformers >=0.5 && <2 , universum ==1.* , unordered-containers >=0.1 && <1 @@ -104,11 +104,11 @@ , registry >=0.4 && <1 , registry-hedgehog , tasty ==1.* - , tasty-discover >=2 && <5 + , tasty-discover >=2 && <6 , tasty-hedgehog >=1.0 && <2.0 , tasty-th >=0.1 && <1 , template-haskell >=2.13 && <3.0 - , text ==1.* + , text >=1 && <3 , transformers >=0.5 && <2 , universum ==1.* , unordered-containers >=0.1 && <1 diff --git a/src/Test/Tasty/HedgehogTest.hs b/src/Test/Tasty/HedgehogTest.hs --- a/src/Test/Tasty/HedgehogTest.hs +++ b/src/Test/Tasty/HedgehogTest.hs @@ -79,6 +79,7 @@ (fromMaybe (propertyShrinkLimit pConfig) mShrinks) (fromMaybe (propertyShrinkRetries pConfig) mRetries) (NoConfidenceTermination $ fromMaybe (propertyTestLimit pConfig) mTests) + Nothing randSeed <- Seed.random -- if we just run one test we choose a high size (knowing that the max size is 99) -- if the test fails we can turn it to a prop and let the shrinking process find a @@ -98,7 +99,7 @@ PropertyConfig -> Report Hedgehog.Progress -> Tasty.Progress -reportToProgress config (Report testsDone _ _ status) = +reportToProgress config (Report testsDone _ _ _ status) = let TestLimit testLimit = propertyTestLimit config ShrinkLimit shrinkLimit = propertyShrinkLimit config ratio x y = 1.0 * fromIntegral x / fromIntegral y @@ -118,14 +119,14 @@ reportOutput (HedgehogShowReplay showReplay) useColor name report = do s <- renderResult useColor (Just (PropertyName name)) report pure $ case reportStatus report of - Failed fr -> - let size = failureSize fr - seed = failureSeed fr + Failed _ -> + let seed = reportSeed report + skip = SkipToTest (reportTests report) replayStr = if showReplay then " --hedgehog-replay \"" - ++ show size + ++ show (skipCompress skip) ++ " " ++ show seed ++ "\"" diff --git a/src/Test/Tasty/Hedgehogx.hs b/src/Test/Tasty/Hedgehogx.hs --- a/src/Test/Tasty/Hedgehogx.hs +++ b/src/Test/Tasty/Hedgehogx.hs @@ -42,7 +42,7 @@ import Hedgehog hiding (test) import Hedgehog.Gen as Hedgehog hiding (discard, print) import Hedgehog.Internal.Config (UseColor (EnableColor)) -import Hedgehog.Internal.Property (Coverage (..), Diff (..), DiscardCount (..), ShrinkCount (..), TestCount (..)) +import Hedgehog.Internal.Property (Coverage (..), Diff (..), DiscardCount (..), ShrinkCount (..), ShrinkPath (..), TestCount (..)) import Hedgehog.Internal.Report import Hedgehog.Internal.Show (mkValue, valueDiff) import Protolude hiding (SrcLoc, empty, toList, (.&.)) @@ -103,8 +103,8 @@ printDifference :: (MonadIO m, Show a, Show b, HasCallStack) => a -> b -> m () printDifference actual expected = withFrozenCallStack $ do - let failureReport = mkFailure (Size 0) (Seed 0 0) (ShrinkCount 0) Nothing Nothing "" (failureDifference actual expected) [] - report <- renderResult EnableColor Nothing (Report (TestCount 0) (DiscardCount 0) (Coverage mempty) (Failed failureReport)) + let failureReport = mkFailure (ShrinkCount 0) (ShrinkPath []) Nothing Nothing "" (failureDifference actual expected) [] + report <- renderResult EnableColor Nothing (Report (TestCount 0) (DiscardCount 0) (Coverage mempty) (Seed 0 0) (Failed failureReport)) putText (T.unlines . drop 3 . T.lines . toS $ report) failureDifference :: (Show a, Show b, HasCallStack) => a -> b -> Maybe Diff diff --git a/test/Test/Data/Registry/Generators.hs b/test/Test/Data/Registry/Generators.hs --- a/test/Test/Data/Registry/Generators.hs +++ b/test/Test/Data/Registry/Generators.hs @@ -41,6 +41,6 @@ -- See the gory details of why this is necessary: https://gitlab.haskell.org/ghc/ghc/issues/9813 $(return []) --- | We create a forall function using all the generators -forall :: forall a. _ => PropertyT IO a -forall = withFrozenCallStack $ forAll (genWith @a registry) +-- | We create a forSome function using all the generators +forSome :: forall a. _ => PropertyT IO a +forSome = withFrozenCallStack $ forAll (genWith @a registry) diff --git a/test/Test/Data/Registry/HedgehogSpec.hs b/test/Test/Data/Registry/HedgehogSpec.hs --- a/test/Test/Data/Registry/HedgehogSpec.hs +++ b/test/Test/Data/Registry/HedgehogSpec.hs @@ -63,7 +63,7 @@ test_company_1 = prop "a company can be used for testing" $ do -- note that we are using forall and not forAll - company <- forall @Company + company <- forSome @Company (not . null) (departments company) === True -- Let's create some registry modifiers to constrain the generation @@ -74,7 +74,7 @@ setSmallCompany = setOneEmployee . setOneDepartment test_small_company = prop "a small company has just one department and one employee" $ do - company <- forallWith @Company setSmallCompany + company <- forSomeWith @Company setSmallCompany length (departments company) === 1 let Just d = head $ departments company length (employees d) === 1 @@ -90,15 +90,15 @@ setDepartmentName = specializeGen @Department genDepartmentName test_with_better_department_name = prop "a department must have a short capitalized name" $ do - company <- forallWith @Company (setSmallCompany . setDepartmentName) + company <- forSomeWith @Company (setSmallCompany . setDepartmentName) -- uncomment to print the department names and inspect them -- print company let Just d = head $ departments company (T.length (_departmentName $ departmentName d) <= 5) === True -- | Generate a value with a modified list of generators -forallWith :: forall a b c. (HasCallStack, Show a, Typeable a) => (Registry _ _ -> Registry b c) -> PropertyT IO a -forallWith f = withFrozenCallStack $ forAll $ genWith @a (f registry) +forSomeWith :: forall a b c. (HasCallStack, Show a, Typeable a) => (Registry _ _ -> Registry b c) -> PropertyT IO a +forSomeWith f = withFrozenCallStack $ forAll $ genWith @a (f registry) -- * Fresh identifiers using a state monad diff --git a/test/Test/Tutorial/Exercise2.hs b/test/Test/Tutorial/Exercise2.hs --- a/test/Test/Tutorial/Exercise2.hs +++ b/test/Test/Tutorial/Exercise2.hs @@ -7,7 +7,7 @@ import Data.Registry import Data.Registry.Hedgehog -import Hedgehog hiding (test, (===)) +import Hedgehog hiding (test, (===), forAll) import Hedgehog.Gen import Hedgehog.Range import Protolude @@ -39,9 +39,9 @@ makeCompanyGen :: Gen Company makeCompanyGen = make @(Gen Company) registry -forall :: forall a. (Typeable a, Show a) => PropertyT IO a -forall = withFrozenCallStack $ forAll $ genWith @a registry +forSome :: forall a. (Typeable a, Show a) => PropertyT IO a +forSome = withFrozenCallStack $ forAll $ genWith @a registry test_company = test "make a company" $ do - _ <- forall @Company + _ <- forSome @Company success diff --git a/test/Test/Tutorial/Exercise4.hs b/test/Test/Tutorial/Exercise4.hs --- a/test/Test/Tutorial/Exercise4.hs +++ b/test/Test/Tutorial/Exercise4.hs @@ -21,9 +21,9 @@ genDepartmentName :: Gen Text genDepartmentName = T.take 5 . T.toUpper <$> genText -forall :: forall a. (Typeable a, Show a) => PropertyT IO a -forall = withFrozenCallStack $ forAll $ genWith @a registry12 +forSome :: forall a. (Typeable a, Show a) => PropertyT IO a +forSome = withFrozenCallStack $ forAll $ genWith @a registry12 test_deparment_name = prop "make a department" $ do - department <- forall @Department + department <- forSome @Department collect (departmentName department)