Add line wrap disablement to ConsoleReporter

cabal.project

@@ -5,6 +5,12 @@ packages:
   quickcheck
   smallcheck
 
+source-repository-package
+  type: git
+  location: https://github.com/kadena-io/ansi-terminal
+  tag: 2953f3b6361ec85c92c6449b8f540bcf84d1cf00
+  subdir: ansi-terminal
+
 if os(wasi)
   -- https://github.com/haskellari/splitmix/pull/73
   source-repository-package

core/Test/Tasty/Ingredients/ConsoleReporter.hs

@@ -135,7 +135,6 @@ buildTestOutput opts tree =
     !alignment = computeAlignment opts tree
 
     MinDurationToReport{minDurationMicros} = lookupOption opts
-    AnsiTricks{getAnsiTricks} = lookupOption opts
 
     runSingleTest
       :: (IsTest t, ?colors :: Bool)
@@ -153,7 +152,7 @@ buildTestOutput opts tree =
           (replicate postNamePadding ' ')
 
         printTestName = do
-          putStr testNamePadded
+          withoutLineWrap $ putStr testNamePadded
           hFlush stdout
 
         printTestProgress progress
@@ -173,8 +172,9 @@ buildTestOutput opts tree =
               -- A new progress message may be shorter than the previous one
               -- so we must clean whole line and print anew.
               clearLine
-              putStr testNamePadded
-              infoOk msg
+              withoutLineWrap $ do
+                putStr testNamePadded
+                infoOk msg
               hFlush stdout
 
         printTestResult result = do
@@ -192,7 +192,8 @@ buildTestOutput opts tree =
           when getAnsiTricks $ do
             putChar '\r'
             clearLine
-            putStr testNamePadded
+            withoutLineWrap $
+              putStr testNamePadded
 
           printFn (resultShortDescription result)
           when (floor (time * 1e6) >= minDurationMicros) $
@@ -211,7 +212,7 @@ buildTestOutput opts tree =
     runGroup _opts name grp = Ap $ do
       level <- ask
       let
-        printHeading = printf "%s%s\n" (indent level) name
+        printHeading = withoutLineWrap $ printf "%s%s\n" (indent level) name
         printBody = runReader (getApp (mconcat grp)) (level + 1)
       return $ PrintHeading name printHeading printBody
 
@@ -223,6 +224,19 @@ buildTestOutput opts tree =
           , foldGroup = runGroup
           }
           opts tree
+  where
+    AnsiTricks{getAnsiTricks} = lookupOption opts
+    -- We must ensure these lines don't wrap, otherwise the wrong
+    -- line will be cleared later or the test tree printing will
+    -- itself wrap.
+    withoutLineWrap :: IO () -> IO ()
+    withoutLineWrap m = do
+      when getAnsiTricks $
+        disableLineWrap
+      m
+      when getAnsiTricks $
+        enableLineWrap
+
 
 -- | Make sure the progress text does not contain any newlines or line feeds,
 -- lest our ANSI magic breaks. Since the progress text is expected to be short,