Final polishing

core/CHANGELOG.md

@@ -11,7 +11,8 @@ _YYYY-MM-DD_
 * Dependencies can now be defined pattern-free with `sequentialTestGroup` ([#343](https://github.com/UnkindPartition/tasty/issues/343)).
 * Added `--min-duration-to-report` flag that specifies the time a test must take before `tasty` outputs timing information ([#341](https://github.com/UnkindPartition/tasty/issues/341)).
 * When a test failed with an exception, print it using `displayException` instead of `show` ([#330](https://github.com/UnkindPartition/tasty/issues/330)).
-* `PrintTest` constructor has extra field used to report progress.
+* `PrintTest` constructor now has an extra field used to report progress.
+  Supply `const (pure ())` as this extra field value if you want to skip progress reporting.
 * Progress reporting is no longer ignored.
 
 Version 1.4.3

core/Test/Tasty/Ingredients/ConsoleReporter.hs

@@ -134,6 +134,7 @@ buildTestOutput opts tree =
     !alignment = computeAlignment opts tree
 
     MinDurationToReport{minDurationMicros} = lookupOption opts
+    AnsiTricks{getAnsiTricks} = lookupOption opts
 
     runSingleTest
       :: (IsTest t, ?colors :: Bool)
@@ -142,7 +143,8 @@ buildTestOutput opts tree =
       level <- ask
 
       let
-        postNamePadding = alignment - indentSize * level - stringWidth name
+        indentedNameWidth = indentSize * level + stringWidth name
+        postNamePadding = alignment - indentedNameWidth
 
         testNamePadded = printf "%s%s: %s"
           (indent level)
@@ -156,6 +158,10 @@ buildTestOutput opts tree =
           hFlush stdout
 
         printTestProgress progress
+          -- We cannot display progress properly if a terminal
+          -- does not support manipulations with cursor position.
+          | not getAnsiTricks = pure ()
+
           | progress == emptyProgress = pure ()
 
           | otherwise = do
@@ -166,6 +172,9 @@ buildTestOutput opts tree =
                         (txt, pct) -> printf "%s: %.0f%% " txt pct
               setCursorColumn resultPosition
               infoOk msg
+              -- A new progress message may be shorter than the previous one
+              -- so we must clean until the end of the line
+              clearFromCursorToLineEnd
               hFlush stdout
 
         printTestResult result = do
@@ -180,8 +189,9 @@ buildTestOutput opts tree =
                 _ -> fail
             time = resultTime result
 
-          setCursorColumn resultPosition
-          clearFromCursorToLineEnd
+          when getAnsiTricks $ do
+            setCursorColumn resultPosition
+            clearFromCursorToLineEnd
 
           printFn (resultShortDescription result)
           when (floor (time * 1e6) >= minDurationMicros) $
@@ -547,7 +557,11 @@ consoleTestReporterWithHook hook = TestReporter consoleTestReporterOptions $
             ?colors = useColor whenColor isTermColor
 
           let
-            toutput = applyHook hook $ buildTestOutput opts tree
+            -- 'buildTestOutput' is a pure function and cannot query 'hSupportsANSI' itself.
+            -- We also would rather not pass @isTerm@ as an extra argument,
+            -- since it's a breaking change, thus resorting to tweaking @opts@.
+            opts' = changeOption (\(AnsiTricks x) -> AnsiTricks (x && isTerm)) opts
+            toutput = applyHook hook $ buildTestOutput opts' tree
 
           case () of { _
             | hideSuccesses && isTerm && ansiTricks ->

core/Test/Tasty/Options/Core.hs

@@ -98,7 +98,10 @@ mkTimeout n =
   Timeout n $
     showFixed True (fromInteger n / (10^6) :: Micro) ++ "s"
 
--- | Hide progress information.
+-- | Hide progress information. If progress disabled, the test launcher
+-- 'Test.Tasty.Runners.launchTestTree' completely ignores callbacks to update progress.
+-- If enabled, it's up to individual 'Test.Tasty.Ingredients.TestReporter's
+-- how to execute, some might not be able to render progress anyways.
 --
 -- @since 1.5
 newtype HideProgress = HideProgress { getHideProgress :: Bool }

quickcheck/CHANGELOG.md

@@ -4,7 +4,7 @@ Changes
 Version 0.10.3
 --------------
 
-* Print quickcheck progress using tasty progress reporting.
+* Print Quickcheck progress using Tasty progress reporting.
 
 
 Version 0.10.2

quickcheck/Test/Tasty/QuickCheck.hs

@@ -54,6 +54,7 @@ import qualified Data.Char as Char
 import Data.Typeable
 import Data.List
 import Text.Printf
+import Text.Read (readMaybe)
 import Test.QuickCheck.Random (mkQCGen)
 import Options.Applicative (metavar)
 import System.Random (getStdRandom, randomR)
@@ -241,13 +242,16 @@ quickCheck yieldProgress args prop = do
   -- stderr and the overall status (which we don't need) to stdout
   tm <- QC.newTerminal
           (const $ pure ())
-          (\progressText -> yieldProgress emptyProgress { progressText = parseProgress progressText })
+          (\progressText -> yieldProgress emptyProgress { progressPercent = parseProgress progressText })
   QC.withState args $ \ s ->
     QC.test s { QC.terminal = tm } prop
   where
-    parseProgress :: String -> String
-    parseProgress = takeWhile Char.isDigit
-                  . dropWhile (not . Char.isDigit)
+    -- QuickCheck outputs something like "(15461 tests)\b\b\b\b\b\b\b\b\b\b\b\b\b"
+    parseProgress :: String -> Float
+    parseProgress = maybe 0 (\n -> fromIntegral (n :: Int) / fromIntegral (QC.maxSuccess args))
+                  . readMaybe
+                  . takeWhile Char.isDigit
+                  . drop 1
 
 successful :: QC.Result -> Bool
 successful r =