diff --git a/core/Test/Tasty/Ingredients/ConsoleReporter.hs b/core/Test/Tasty/Ingredients/ConsoleReporter.hs index 09af2002..58600cde 100644 --- a/core/Test/Tasty/Ingredients/ConsoleReporter.hs +++ b/core/Test/Tasty/Ingredients/ConsoleReporter.hs @@ -1,5 +1,5 @@ -- vim:fdm=marker -{-# LANGUAGE BangPatterns, ImplicitParams, MultiParamTypeClasses, DeriveDataTypeable, FlexibleContexts, CApiFFI, NamedFieldPuns #-} +{-# LANGUAGE BangPatterns, ImplicitParams, MultiParamTypeClasses, DeriveDataTypeable, FlexibleContexts, CApiFFI, NamedFieldPuns, TupleSections #-} -- | Console reporter ingredient. -- -- @since 0.11.3 @@ -303,22 +303,28 @@ consoleOutput toutput smap = consoleOutputHidingSuccesses :: (?colors :: Bool) => TestOutput -> StatusMap -> IO () consoleOutputHidingSuccesses toutput smap = - void . getApp $ foldTestOutput foldTest foldHeading toutput smap + void . getApp $ fst $ foldTestOutput foldTest foldHeading toutput smap where + foldTest :: p -> IO () -> IO Result -> (Result -> IO ()) -> (Ap IO Any, Any) foldTest _name printName getResult printResult = - Ap $ do + (, Any True) $ Ap $ do printName :: IO () r <- getResult if resultSuccessful r then do clearThisLine; return $ Any False else do printResult r :: IO (); return $ Any True - foldHeading _name printHeading printBody = - Ap $ do - printHeading :: IO () - Any failed <- getApp printBody - unless failed clearAboveLine - return $ Any failed + foldHeading :: p -> IO () -> (Ap IO Any, Any) -> (Ap IO Any, Any) + foldHeading _name printHeading (printBody, Any nonEmpty) = + (, Any nonEmpty) $ Ap $ + if nonEmpty + then do + printHeading :: IO () + Any failed <- getApp printBody + unless failed clearAboveLine + return $ Any failed + else + return mempty clearAboveLine = do cursorUpLine 1; clearThisLine clearThisLine = do clearLine; setCursorColumn 0