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"