Show number of successful tests, classification + better gave up mess…

…age (#30) * Show number of successful tests, classification + better gave up message (close #12) * Apply suggestions from code review --------- Co-authored-by: Matt von Hagen (Parsons) <[email protected]>
hspec · Nov 2, 2023 · af9178f · af9178f
1 parent 349e282
commit af9178f
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 11 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -1,5 +1,10 @@
 # Changelog for hspec-hedgehog
 
+## 0.1.1.0
+- [#30](https://github.com/parsonsmatt/hspec-hedgehog/pull/30) @sol
+    - Show classification on success
+    - Provide more information on "gave up"
+
 ## 0.1.0.0
 
 - [#25](https://github.com/parsonsmatt/hspec-hedgehog/pull/25) @sol

diff --git a/hspec-hedgehog.cabal b/hspec-hedgehog.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 name:           hspec-hedgehog
-version:        0.1.0.0
+version:        0.1.1.0
 description:    Please see the README on GitHub at <https://github.com/parsonsmatt/hspec-hedgehog#readme>
 synopsis:       Integrate Hedgehog and Hspec!
 category:       Testing

diff --git a/src/Test/Hspec/Hedgehog.hs b/src/Test/Hspec/Hedgehog.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE InstanceSigs          #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 {-# LANGUAGE ViewPatterns          #-}
 
@@ -102,7 +104,8 @@ import           Hedgehog.Internal.Property (DiscardLimit (..), Property (..),
                                              ShrinkLimit (..),
                                              TerminationCriteria (..),
                                              TestCount (..), TestLimit (..))
-import           Hedgehog.Internal.Report   as Hedge
+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 (..),
@@ -199,20 +202,24 @@ instance (m ~ IO) => Example (a -> PropertyT m ()) where
                Nothing       -> Seed.random
                Just (rng, _) -> pure (uncurry Seed (unseedSMGen (coerce rng)))
             hedgeResult <- checkReport propConfig size seed (propertyTest prop) cb
-            ppresult <- renderResult EnableColor Nothing hedgeResult
-            writeIORef ref $ Result "" $ case reportStatus hedgeResult of
-                Failed FailureReport{..} ->
+
+            let renderResult color = Hedge.renderResult color (Just "property") hedgeResult
+
+            case reportStatus hedgeResult of
+                Failed FailureReport{..} -> do
+                    ppresult <- renderResult EnableColor
                     let
                         fromSpan Span{..} =
                             Location
                                 { locationFile = spanFile
                                 , locationLine = coerce spanStartLine
                                 , locationColumn = coerce spanStartColumn
                                 }
-                    in
-                        Hspec.Failure (fromSpan <$> failureLocation) $ ColorizedReason ppresult
-                GaveUp ->
-                    Failure Nothing (Reason "GaveUp")
-                OK ->
-                    Success
+                    writeIORef ref $ Result "" $ Hspec.Failure (fromSpan <$> failureLocation) $ ColorizedReason ppresult
+                GaveUp -> do
+                    ppresult <- renderResult DisableColor
+                    writeIORef ref $ Result "" $ Failure Nothing (Reason ppresult)
+                OK -> do
+                    ppresult <- renderResult DisableColor
+                    writeIORef ref $ Result ppresult Success
         readIORef ref