Show less context on failure (fixes #26)

.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

.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

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

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 <https://github.com/hspec/hspec-hedgehog#readme>
 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

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 0
+                , 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