tasty-hedgehog 1.0.1.0 → 1.4.0.2

raw patch · 4 files changed

Files

• changelog.md +30/−1
• src/Test/Tasty/Hedgehog.hs +63/−23
• tasty-hedgehog.cabal +5/−5
• test/Main.hs +9/−1

@@ -1,5 +1,34 @@ # Revision history for tasty-hedgehog +## 1.4.0.2 -- 2023-08-07++* Support hedgehog 1.4++## 1.4.0.1 -- 2023-03-15++* Support base 4.18 (GHC 9.6)+* Improve suggested test replay command++## 1.4.0.0 -- 2022-10-12++* Support `hedgehog-1.2`. This is a breaking change due to `hedgehog`'s [new mechanism for skipping to a particular test and shrink result](https://github.com/hedgehogqa/haskell-hedgehog/pull/454). The `--hedgehog-replay` option now expects a `Skip` value and a `Seed`, for example: `stack test --test-arguments='--pattern "$NF ~ /badReverse involutive fails/" --hedgehog-replay "3:b2 Seed 10332913068362713902 1302058653756691475"'` ([#63](https://github.com/qfpl/tasty-hedgehog/pull/63))++## 1.3.1.0 -- 2022-10-03++* The instructions for reproducing test failures are now more clearly distinguished from `hedgehog`'s own instructions and include a pattern in the example to limit which tests are re-run. ([#62](https://github.com/qfpl/tasty-hedgehog/pull/62))++## 1.3.0.0 -- 2022-08-22++* The `testProperty` function has been undeprecated. Its behaviour differs from that in version `1.1.0.0` and below in that it now passes no `PropertyName` to Hedgehog. Therefore, Hedgehog will render the text `<property>` in its instructions for reproducing test failures, as opposed to whatever description is provided for `testProperty`.++## 1.2.0.0 -- 2022-03-07++* Add `testPropertyNamed` function and deprecate `testProperty`.++## 1.1.0.0 -- 2021-04-03++* Add fromGroup function+ ## 1.0.1.0 -- 2021-01-25  * Automatically enable or disable colour, based on the same criteria@@ -21,7 +50,7 @@ ## 0.2.0.0  -- 2018-03-13  * Removes the verbosity option, which was unsupported-* Fixes a bug in configuration option handling, which +* Fixes a bug in configuration option handling, which   was overwriting use configuration with the defaults.  ## 0.1.0.2  -- 2018-01-22

@@ -4,14 +4,16 @@ -- -- @ -- testGroup "tasty-hedgehog tests" [---    testProperty "reverse involutive" prop_reverse_involutive---  , testProperty "sort idempotent"    prop_sort_idempotent+--    testPropertyNamed "reverse involutive" "prop_reverse_involutive" prop_reverse_involutive+--  , testPropertyNamed "sort idempotent"    "prop_sort_idempotent"    prop_sort_idempotent --  ] -- @ -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Tasty.Hedgehog (     testProperty+  , testPropertyNamed+  , fromGroup   -- * Options you can pass in via tasty   , HedgehogReplay(..)   , HedgehogShowReplay(..)@@ -24,6 +26,7 @@ import Data.Maybe (fromMaybe) import Data.Typeable +import qualified Test.Tasty as T import qualified Test.Tasty.Providers as T import Test.Tasty.Options @@ -34,23 +37,51 @@ import Hedgehog.Internal.Report import Hedgehog.Internal.Seed as Seed -data HP = HP T.TestName Property+data HP = HP T.TestName (Maybe PropertyName) Property   deriving (Typeable)  -- | Create a 'T.TestTree' from a Hedgehog 'Property'. testProperty :: T.TestName -> Property -> T.TestTree-testProperty name prop = T.singleTest name (HP name prop)+testProperty name prop = T.singleTest name (HP name Nothing prop) +-- | `testPropertyNamed` @testName propertyName property@ creates a+-- 'T.TestTree' from @property@ using @testName@ as the displayed+-- description for the property. The @propertyName@ is used by Hedgehog+-- when a failure occurs to provide instructions for how to re-run+-- the property and should normally be set to a string representation+-- of the @property@ argument.+--+-- @+-- testPropertyNamed+--  "reverse is involutive"+--  "prop_reverse_involutive"+--  prop_reverse_involutive+-- @+--+-- @since 1.2.0.0+testPropertyNamed :: T.TestName -> PropertyName -> Property -> T.TestTree+testPropertyNamed name propName prop =+  T.singleTest name (HP name (Just propName) prop)++-- | Create a 'T.TestTree' from a Hedgehog 'Group'.+fromGroup :: Group -> T.TestTree+fromGroup group =+    T.testGroup (unGroupName $ groupName group) $+      map mkTestTree (groupProperties group)+  where+    mkTestTree :: (PropertyName, Property) -> T.TestTree+    mkTestTree (propName, prop) = testProperty (unPropertyName propName) prop+ -- | The replay token to use for replaying a previous test run-newtype HedgehogReplay = HedgehogReplay (Maybe (Size, Seed))+newtype HedgehogReplay = HedgehogReplay (Maybe (Skip, Seed))   deriving (Typeable)  instance IsOption HedgehogReplay where   defaultValue = HedgehogReplay Nothing   parseValue v = HedgehogReplay . Just <$> replay-    -- Reads a replay token in the form "{size} {seed}"-    where replay = (,) <$> safeRead (unwords size) <*> safeRead (unwords seed)-          (size, seed) = splitAt 2 $ words v+    -- Reads a replay token in the form "{skip} {seed}"+    where replay = (,) <$> skipDecompress (unwords skip) <*> safeRead (unwords seed)+          (skip, seed) = splitAt 1 $ words v   optionName = return "hedgehog-replay"   optionHelp = return "Replay token to use for replaying a previous test run" @@ -116,7 +147,10 @@ reportToProgress :: PropertyConfig                  -> Report Progress                  -> T.Progress-reportToProgress config (Report testsDone _ _ status) =+reportToProgress config Report{+    reportTests = testsDone,+    reportStatus = status+  } =   let     TestLimit testLimit = propertyTestLimit config     ShrinkLimit shrinkLimit = propertyShrinkLimit config@@ -131,22 +165,29 @@  reportOutput :: Bool              -> UseColor-             -> String+             -> T.TestName+             -> Maybe PropertyName              -> Report Result              -> IO String-reportOutput showReplay useColor name report = do-  s <- renderResult useColor (Just (PropertyName name)) report+reportOutput showReplay useColor testName name report = do+  s <- renderResult useColor name report   pure $ case reportStatus report of     Failed fr ->       let-        size = failureSize fr-        seed = failureSeed fr+        count = reportTests report+        seed = reportSeed report+        discards = reportDiscards report+        shrinkPath = failureShrinkPath fr         replayStr =           if showReplay           then-            "\nUse '--hedgehog-replay \"" ++-            show size ++ " " ++ show seed ++-            "\"' to reproduce."+            "\nUse \"--pattern \'$NF ~ /" +++            testName +++            "/\' --hedgehog-replay \'" +++            skipCompress (SkipToShrink count discards shrinkPath) +++            " " +++            show seed +++            "\'\" to reproduce from the command-line."           else ""       in         s ++ replayStr ++ "\n"@@ -162,7 +203,7 @@            , Option (Proxy :: Proxy HedgehogShrinkRetries)            ] -  run opts (HP name (Property pConfig pTest)) yieldProgress = do+  run opts (HP testName name (Property pConfig pTest)) yieldProgress = do     useColor <- detectColor     let       HedgehogReplay         replay = lookupOption opts@@ -177,18 +218,17 @@           (fromMaybe (propertyShrinkLimit pConfig) mShrinks)           (fromMaybe (propertyShrinkRetries pConfig) mRetries)           (NoConfidenceTermination $ fromMaybe (propertyTestLimit pConfig) mTests)+          (maybe Nothing (Just . fst) replay)      randSeed <- Seed.random-    let-      size = maybe 0 fst replay-      seed = maybe randSeed snd replay+    let seed = maybe randSeed snd replay -    report <- checkReport config size seed pTest (yieldProgress . reportToProgress config)+    report <- checkReport config 0 seed pTest (yieldProgress . reportToProgress config)      let       resultFn = if reportStatus report == OK                  then T.testPassed                  else T.testFailed -    out <- reportOutput showReplay useColor name report+    out <- reportOutput showReplay useColor testName name report     return $ resultFn out

@@ -1,5 +1,5 @@ name:                tasty-hedgehog-version:             1.0.1.0+version:             1.4.0.2 license:             BSD3 license-file:        LICENCE author:              Dave Laing@@ -21,10 +21,10 @@  library   exposed-modules:     Test.Tasty.Hedgehog-  build-depends:       base >= 4.8 && <4.15+  build-depends:       base >= 4.8 && <4.19                      , tagged >= 0.8 && < 0.9                      , tasty >= 0.11 && < 1.5-                     , hedgehog >= 1.0.2 && < 1.0.5+                     , hedgehog >= 1.4 && < 1.5   hs-source-dirs:      src   ghc-options:         -Wall   default-language:    Haskell2010@@ -33,10 +33,10 @@   type:                exitcode-stdio-1.0   main-is:             Main.hs   hs-source-dirs:      test-  build-depends:       base >= 4.8 && <4.15+  build-depends:       base >= 4.8 && <4.19                      , tasty >= 0.11 && < 1.5                      , tasty-expected-failure >= 0.11 && < 0.13-                     , hedgehog >= 1.0.2 && < 1.0.5+                     , hedgehog >= 1.4 && < 1.5                      , tasty-hedgehog   ghc-options:         -Wall   default-language:    Haskell2010

@@ -45,5 +45,13 @@         prop_reverse_involutive     , expectFail $ testProperty         "badReverse involutive fails"-         prop_badReverse_involutive+        prop_badReverse_involutive+    , testPropertyNamed+        "reverse involutive"+        "prop_reverse_involutive"+        prop_reverse_involutive+    , expectFail $ testPropertyNamed+        "badReverse involutive fails"+        "prop_badReverse_involutive"+        prop_badReverse_involutive     ]