{-# LANGUAGE CPP #-} module Test.Chell.Output ( Output , outputStart , outputResult , ColorMode(..) , plainOutput , colorOutput ) where import Control.Monad (forM_, unless, when) #ifdef MIN_VERSION_ansi_terminal import qualified System.Console.ANSI as AnsiTerminal #endif import Test.Chell.Types data Output = Output { outputStart :: Test -> IO () , outputResult :: Test -> TestResult -> IO () } plainOutput :: Bool -> Output plainOutput v = Output { outputStart = plainOutputStart v , outputResult = plainOutputResult v } plainOutputStart :: Bool -> Test -> IO () plainOutputStart v t = when v $ do putStr "[ RUN ] " putStrLn (testName t) plainOutputResult :: Bool -> Test -> TestResult -> IO () plainOutputResult v t (TestPassed _) = when v $ do putStr "[ PASS ] " putStrLn (testName t) putStrLn "" plainOutputResult v t TestSkipped = when v $ do putStr "[ SKIP ] " putStrLn (testName t) putStrLn "" plainOutputResult _ t (TestFailed notes fs) = do putStr "[ FAIL ] " putStrLn (testName t) printNotes notes printFailures fs plainOutputResult _ t (TestAborted notes msg) = do putStr "[ ABORT ] " putStrLn (testName t) printNotes notes putStr " " putStr msg putStrLn "\n" plainOutputResult _ _ _ = return () data ColorMode = ColorModeAuto | ColorModeAlways | ColorModeNever deriving (Enum) colorOutput :: Bool -> Output #ifndef MIN_VERSION_ansi_terminal colorOutput = plainOutput #else colorOutput v = Output { outputStart = colorOutputStart v , outputResult = colorOutputResult v } colorOutputStart :: Bool -> Test -> IO () colorOutputStart v t = when v $ do putStr "[ RUN ] " putStrLn (testName t) colorOutputResult :: Bool -> Test -> TestResult -> IO () colorOutputResult v t (TestPassed _) = when v $ do putStr "[ " AnsiTerminal.setSGR [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Green ] putStr "PASS" AnsiTerminal.setSGR [ AnsiTerminal.Reset ] putStr " ] " putStrLn (testName t) putStrLn "" colorOutputResult v t TestSkipped = when v $ do putStr "[ " AnsiTerminal.setSGR [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Yellow ] putStr "SKIP" AnsiTerminal.setSGR [ AnsiTerminal.Reset ] putStr " ] " putStrLn (testName t) putStrLn "" colorOutputResult _ t (TestFailed notes fs) = do putStr "[ " AnsiTerminal.setSGR [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Red ] putStr "FAIL" AnsiTerminal.setSGR [ AnsiTerminal.Reset ] putStr " ] " putStrLn (testName t) printNotes notes printFailures fs colorOutputResult _ t (TestAborted notes msg) = do putStr "[ " AnsiTerminal.setSGR [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Red ] putStr "ABORT" AnsiTerminal.setSGR [ AnsiTerminal.Reset ] putStr " ] " putStrLn (testName t) printNotes notes putStr " " putStr msg putStrLn "\n" colorOutputResult _ _ _ = return () #endif printNotes :: [(String, String)] -> IO () printNotes notes = unless (null notes) $ do forM_ notes $ \(key, value) -> do putStr " note: " putStr key putStr "=" putStrLn value putStrLn "" printFailures :: [Failure] -> IO () printFailures fs = forM_ fs $ \f -> do putStr " " case failureLocation f of Just loc -> do putStr (locationFile loc) putStr ":" case locationLine loc of Just line -> putStrLn (show line) Nothing -> putStrLn "" Nothing -> return () putStr " " putStr (failureMessage f) putStrLn "\n"