test-framework: Improve output

1 files changed, 17 insertions, 14 deletions

diff --git a/test-framework/Test/Framework.hs b/test-framework/Test/Framework.hs
index e8c1295..0eee830 100644
--- a/test-framework/Test/Framework.hs
+++ b/test-framework/Test/Framework.hs
@@ -76,6 +76,9 @@ newtype M a = M (StateT Stats IO a)
 modifyStats :: (Stats -> Stats) -> M ()
 modifyStats f = M (modify f)
 
+defaultMain :: TestTree -> IO ()
+defaultMain tree = runTests tree >>= exitWith
+
 runTests :: TestTree -> IO ExitCode
 runTests = \tree -> do
   let M m = let ?maxlen = computeMaxLen tree in go 0 tree
@@ -103,24 +106,24 @@ runTests = \tree -> do
       seed <- H.Seed.random
 
       starttm <- liftIO getCurrentTime
-      report <- liftIO $ H.checkReport config 0 seed test (outputProgress (?maxlen + 2) name)
+      report <- liftIO $ H.checkReport config 0 seed test (outputProgress (?maxlen + 2))
       endtm <- liftIO getCurrentTime
 
-      liftIO $ printResult name report (diffUTCTime endtm starttm)
+      liftIO $ printResult report (diffUTCTime endtm starttm)
 
       modifyStats $ \stats -> stats { statsOK = fromEnum (H.reportStatus report == H.OK) + statsOK stats
                                     , statsTotal = 1 + statsTotal stats }
 
-outputProgress :: Int -> String -> H.Report H.Progress -> IO ()
-outputProgress indent name report = do
-  str <- H.renderProgress H.EnableColor (Just (fromString name)) report
-  putStr (str ++ "\x1B[" ++ show (indent+1) ++ "G")
+outputProgress :: Int -> H.Report H.Progress -> IO ()
+outputProgress indent report = do
+  str <- H.renderProgress H.EnableColor (Just (fromString "")) report
+  putStr (replace '\n' "  " str ++ "\x1B[" ++ show (indent+1) ++ "G")
   hFlush stdout
 
-printResult :: String -> H.Report H.Result -> NominalDiffTime -> IO ()
-printResult name report timeTaken = do
-  str <- H.renderResult H.EnableColor (Just (fromString name)) report
-  if timeTaken >= 0.01
+printResult :: H.Report H.Result -> NominalDiffTime -> IO ()
+printResult report timeTaken = do
+  str <- H.renderResult H.EnableColor (Just (fromString "")) report
+  if timeTaken >= 0.5 && H.reportStatus report == H.OK
     then putStrLn ("\x1B[K" ++ str ++ " (" ++ prettySeconds (realToFrac timeTaken) ++ ")")
     else putStrLn ("\x1B[K" ++ str)
 
@@ -128,11 +131,11 @@ printStats :: Stats -> NominalDiffTime -> IO ()
 printStats stats timeTaken
   | statsOK stats == statsTotal stats = do
       putStrLn $ "\x1B[32mAll " ++ show (statsTotal stats) ++
-                 " tests passed (" ++ prettySeconds (realToFrac timeTaken) ++ ")\x1B[0m"
+                 " tests passed. (" ++ prettySeconds (realToFrac timeTaken) ++ ")\x1B[0m"
   | otherwise =
       let nfailed = statsTotal stats - statsOK stats
       in putStrLn $ "\x1B[31mFailed " ++ show nfailed ++ " out of " ++ show (statsTotal stats) ++
-                    " tests (" ++ prettySeconds (realToFrac timeTaken) ++ ")\x1B[0m"
+                    " tests. (" ++ prettySeconds (realToFrac timeTaken) ++ ")\x1B[0m"
 
 prettySeconds :: Double -> String
 prettySeconds x =
@@ -141,5 +144,5 @@ prettySeconds x =
       (pre, post) = splitAt (length str' - 2) str'
   in pre ++ "." ++ post ++ "s"
 
-defaultMain :: TestTree -> IO ()
-defaultMain tree = runTests tree >>= exitWith
+replace :: Eq a => a -> [a] -> [a] -> [a]
+replace x ys = concatMap (\y -> if y == x then ys else [y])