From bac53e80275ccbecda55a6036795c643f0c3c7dd Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Sun, 22 Oct 2023 11:28:58 +0700 Subject: [PATCH] Show less context on failure (fixes #26) --- .github/workflows/build.yml | 2 +- .github/workflows/publish.yml | 2 +- ChangeLog.md | 4 ++++ hspec-hedgehog.cabal | 6 +++--- package.yaml | 4 ++-- src/Test/Hspec/Hedgehog.hs | 19 +++++++++++++++++-- test/Test/Hspec/HedgehogSpec.hs | 26 +++++++++++--------------- 7 files changed, 39 insertions(+), 24 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index d0f1d79..6060907 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -92,4 +92,4 @@ jobs: - name: Check for trailing whitespace run: '! git grep -I "\s\+$"' - run: curl -sSL https://raw.githubusercontent.com/sol/hpack/main/get-hpack.sh | bash - - run: hpack && git diff --exit-code + - run: hpack && git diff --color --exit-code diff --git a/.github/workflows/publish.yml b/.github/workflows/publish.yml index 4a19fb3..a07fcaf 100644 --- a/.github/workflows/publish.yml +++ b/.github/workflows/publish.yml @@ -14,7 +14,7 @@ jobs: steps: - uses: actions/checkout@v3 - - run: cabal check + - run: cabal check --ignore=missing-upper-bounds - uses: sol/haskell-autotag@v1 id: autotag diff --git a/ChangeLog.md b/ChangeLog.md index 61cbbb9..959799d 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for hspec-hedgehog +## 0.2.0.0 + - [#29](https://github.com/parsonsmatt/hspec-hedgehog/pull/29) @sol + - Show less context on failure. + ## 0.1.1.0 - [#30](https://github.com/parsonsmatt/hspec-hedgehog/pull/30) @sol - Show classification on success diff --git a/hspec-hedgehog.cabal b/hspec-hedgehog.cabal index ac9e7eb..1a632f0 100644 --- a/hspec-hedgehog.cabal +++ b/hspec-hedgehog.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: hspec-hedgehog -version: 0.1.1.0 +version: 0.2.0.0 description: Please see the README on GitHub at synopsis: Integrate Hedgehog and Hspec! category: Testing @@ -33,7 +33,7 @@ library build-depends: QuickCheck >=2.9.2 && <3 , base >=4.7 && <5 - , hedgehog >=1.0.2 && <2 + , hedgehog >=1.5 , hspec >=2.11.0 && <3 , hspec-core >=2.11.0 && <3 , splitmix >=0.0.1 && <1 @@ -54,7 +54,7 @@ test-suite spec HUnit , QuickCheck , base >=4.7 && <5 - , hedgehog >=1.0.2 && <2 + , hedgehog >=1.5 , hspec >=2.11.0 && <3 , hspec-core >=2.11.0 && <3 , hspec-hedgehog diff --git a/package.yaml b/package.yaml index 743dd69..68939c2 100644 --- a/package.yaml +++ b/package.yaml @@ -1,7 +1,7 @@ spec-version: 0.36.0 name: hspec-hedgehog -version: 0.1.1.0 +version: 0.2.0.0 synopsis: Integrate Hedgehog and Hspec! description: Please see the README on GitHub at category: Testing @@ -19,7 +19,7 @@ dependencies: - base >= 4.7 && < 5 - hspec >= 2.11.0 && < 3 - hspec-core >= 2.11.0 && < 3 - - hedgehog >= 1.0.2 && < 2 + - hedgehog >= 1.5 library: source-dirs: src diff --git a/src/Test/Hspec/Hedgehog.hs b/src/Test/Hspec/Hedgehog.hs index a9bdf89..090fcc3 100644 --- a/src/Test/Hspec/Hedgehog.hs +++ b/src/Test/Hspec/Hedgehog.hs @@ -94,6 +94,7 @@ module Test.Hspec.Hedgehog ) where import Control.Monad.IO.Class (liftIO) +import Data.Char (isSpace) import Data.Coerce (coerce) import Data.IORef (newIORef, readIORef, writeIORef) import GHC.Stack (withFrozenCallStack) @@ -105,7 +106,6 @@ import Hedgehog.Internal.Property (DiscardLimit (..), Property (..), TerminationCriteria (..), TestCount (..), TestLimit (..)) import Hedgehog.Internal.Report hiding (renderResult) -import qualified Hedgehog.Internal.Report as Hedge import Hedgehog.Internal.Runner (checkReport) import qualified Hedgehog.Internal.Seed as Seed import Hedgehog.Internal.Source (ColumnNo (..), LineNo (..), @@ -203,7 +203,14 @@ instance (m ~ IO) => Example (a -> PropertyT m ()) where Just (rng, _) -> pure (uncurry Seed (unseedSMGen (coerce rng))) hedgeResult <- checkReport propConfig size seed (propertyTest prop) cb - let renderResult color = Hedge.renderResult color (Just "property") hedgeResult + let + config = defaultConfig { + configContext = Context 3 + , configPrintFailedAtLocation = False + , configPrintReproduceMessage = False + , configPrintPrefixIcons = DisablePrefixIcons + } + renderResult color = unlines . unindent . lines . dropWhileEnd isSpace <$> renderResultWith config color (Just "") hedgeResult case reportStatus hedgeResult of Failed FailureReport{..} -> do @@ -223,3 +230,11 @@ instance (m ~ IO) => Example (a -> PropertyT m ()) where ppresult <- renderResult DisableColor writeIORef ref $ Result ppresult Success readIORef ref + +dropWhileEnd :: (a -> Bool) -> [a] -> [a] +dropWhileEnd p = reverse . dropWhile p . reverse + +unindent :: [String] -> [String] +unindent xs = map (drop indentation) xs + where + indentation = minimum $ map (length . takeWhile (== ' ')) xs diff --git a/test/Test/Hspec/HedgehogSpec.hs b/test/Test/Hspec/HedgehogSpec.hs index 4d91513..5f73cbf 100644 --- a/test/Test/Hspec/HedgehogSpec.hs +++ b/test/Test/Hspec/HedgehogSpec.hs @@ -56,35 +56,31 @@ spec = do context "on Success" $ do it "includes the number of passed tests" $ do eval success `shouldReturn` Result - " ✓ property passed 100 tests." + "passed 100 tests.\n" Success it "includes classification" $ do eval (label "foo" >> success) `shouldReturn` Result (joinLines [ - " ✓ property passed 100 tests." - , " foo 100% ████████████████████" + "passed 100 tests." + , "foo 100% ████████████████████\n" ]) Success context "on Failure" $ do it "includes the number of discarded tests" $ do eval discard `shouldReturn` Result "" (Failure Nothing (Reason - " ⚐ property gave up after 10 discards, passed 0 tests." + "gave up after 10 discards, passed 0 tests.\n" )) it "provides a detailed failure message" $ do Result "" (Failure (Just _loc) (ColorizedReason reason)) <- eval failingProperty - let line delta = " " <> show (failingPropertyLine + delta) + let line delta = "" <> show (failingPropertyLine + delta) stripAnsi reason `shouldBe` joinLines [ - " ✗ property failed at test/Test/Hspec/HedgehogSpec.hs:" <> show failingPropertyLine <> ":19" - , " after 1 test." - , " shrink path: 1:" - , " " - , " ┏━━ test/Test/Hspec/HedgehogSpec.hs ━━━" + "failed after 1 test." + , "shrink path: 1:" + , "" + , " ┏━━ test/Test/Hspec/HedgehogSpec.hs ━━━" , line -1 <> " ┃ failingProperty :: PropertyT IO ()" , line 0 <> " ┃ failingProperty = failure" - , " ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^" - , " " - , " This failure can be reproduced by running:" - , " > recheckAt (Seed 14375056955115587481 16778118630780010967) \"1:\" property" - , " " + , " ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^" + , "" ]