{-# 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 { Output -> Test -> IO () outputStart :: Test -> IO () , Output -> Test -> TestResult -> IO () outputResult :: Test -> TestResult -> IO () } plainOutput :: Bool -> Output plainOutput :: Bool -> Output plainOutput Bool v = Output :: (Test -> IO ()) -> (Test -> TestResult -> IO ()) -> Output Output { outputStart :: Test -> IO () outputStart = Bool -> Test -> IO () plainOutputStart Bool v , outputResult :: Test -> TestResult -> IO () outputResult = Bool -> Test -> TestResult -> IO () plainOutputResult Bool v } plainOutputStart :: Bool -> Test -> IO () plainOutputStart :: Bool -> Test -> IO () plainOutputStart Bool v Test t = Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool v (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do String -> IO () putStr String "[ RUN ] " String -> IO () putStrLn (Test -> String testName Test t) plainOutputResult :: Bool -> Test -> TestResult -> IO () plainOutputResult :: Bool -> Test -> TestResult -> IO () plainOutputResult Bool v Test t (TestPassed [(String, String)] _) = Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool v (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do String -> IO () putStr String "[ PASS ] " String -> IO () putStrLn (Test -> String testName Test t) String -> IO () putStrLn String "" plainOutputResult Bool v Test t TestResult TestSkipped = Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool v (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do String -> IO () putStr String "[ SKIP ] " String -> IO () putStrLn (Test -> String testName Test t) String -> IO () putStrLn String "" plainOutputResult Bool _ Test t (TestFailed [(String, String)] notes [Failure] fs) = do String -> IO () putStr String "[ FAIL ] " String -> IO () putStrLn (Test -> String testName Test t) [(String, String)] -> IO () printNotes [(String, String)] notes [Failure] -> IO () printFailures [Failure] fs plainOutputResult Bool _ Test t (TestAborted [(String, String)] notes String msg) = do String -> IO () putStr String "[ ABORT ] " String -> IO () putStrLn (Test -> String testName Test t) [(String, String)] -> IO () printNotes [(String, String)] notes String -> IO () putStr String " " String -> IO () putStr String msg String -> IO () putStrLn String "\n" plainOutputResult Bool _ Test _ TestResult _ = () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () data ColorMode = ColorModeAuto | ColorModeAlways | ColorModeNever deriving (Int -> ColorMode ColorMode -> Int ColorMode -> [ColorMode] ColorMode -> ColorMode ColorMode -> ColorMode -> [ColorMode] ColorMode -> ColorMode -> ColorMode -> [ColorMode] (ColorMode -> ColorMode) -> (ColorMode -> ColorMode) -> (Int -> ColorMode) -> (ColorMode -> Int) -> (ColorMode -> [ColorMode]) -> (ColorMode -> ColorMode -> [ColorMode]) -> (ColorMode -> ColorMode -> [ColorMode]) -> (ColorMode -> ColorMode -> ColorMode -> [ColorMode]) -> Enum ColorMode forall a. (a -> a) -> (a -> a) -> (Int -> a) -> (a -> Int) -> (a -> [a]) -> (a -> a -> [a]) -> (a -> a -> [a]) -> (a -> a -> a -> [a]) -> Enum a enumFromThenTo :: ColorMode -> ColorMode -> ColorMode -> [ColorMode] $cenumFromThenTo :: ColorMode -> ColorMode -> ColorMode -> [ColorMode] enumFromTo :: ColorMode -> ColorMode -> [ColorMode] $cenumFromTo :: ColorMode -> ColorMode -> [ColorMode] enumFromThen :: ColorMode -> ColorMode -> [ColorMode] $cenumFromThen :: ColorMode -> ColorMode -> [ColorMode] enumFrom :: ColorMode -> [ColorMode] $cenumFrom :: ColorMode -> [ColorMode] fromEnum :: ColorMode -> Int $cfromEnum :: ColorMode -> Int toEnum :: Int -> ColorMode $ctoEnum :: Int -> ColorMode pred :: ColorMode -> ColorMode $cpred :: ColorMode -> ColorMode succ :: ColorMode -> ColorMode $csucc :: ColorMode -> ColorMode Enum) colorOutput :: Bool -> Output #ifndef MIN_VERSION_ansi_terminal colorOutput = plainOutput #else colorOutput :: Bool -> Output colorOutput Bool v = Output :: (Test -> IO ()) -> (Test -> TestResult -> IO ()) -> Output Output { outputStart :: Test -> IO () outputStart = Bool -> Test -> IO () colorOutputStart Bool v , outputResult :: Test -> TestResult -> IO () outputResult = Bool -> Test -> TestResult -> IO () colorOutputResult Bool v } colorOutputStart :: Bool -> Test -> IO () colorOutputStart :: Bool -> Test -> IO () colorOutputStart Bool v Test t = Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool v (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do String -> IO () putStr String "[ RUN ] " String -> IO () putStrLn (Test -> String testName Test t) colorOutputResult :: Bool -> Test -> TestResult -> IO () colorOutputResult :: Bool -> Test -> TestResult -> IO () colorOutputResult Bool v Test t (TestPassed [(String, String)] _) = Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool v (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do String -> IO () putStr String "[ " [SGR] -> IO () AnsiTerminal.setSGR [ ConsoleLayer -> ColorIntensity -> Color -> SGR AnsiTerminal.SetColor ConsoleLayer AnsiTerminal.Foreground ColorIntensity AnsiTerminal.Vivid Color AnsiTerminal.Green ] String -> IO () putStr String "PASS" [SGR] -> IO () AnsiTerminal.setSGR [ SGR AnsiTerminal.Reset ] String -> IO () putStr String " ] " String -> IO () putStrLn (Test -> String testName Test t) String -> IO () putStrLn String "" colorOutputResult Bool v Test t TestResult TestSkipped = Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool v (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do String -> IO () putStr String "[ " [SGR] -> IO () AnsiTerminal.setSGR [ ConsoleLayer -> ColorIntensity -> Color -> SGR AnsiTerminal.SetColor ConsoleLayer AnsiTerminal.Foreground ColorIntensity AnsiTerminal.Vivid Color AnsiTerminal.Yellow ] String -> IO () putStr String "SKIP" [SGR] -> IO () AnsiTerminal.setSGR [ SGR AnsiTerminal.Reset ] String -> IO () putStr String " ] " String -> IO () putStrLn (Test -> String testName Test t) String -> IO () putStrLn String "" colorOutputResult Bool _ Test t (TestFailed [(String, String)] notes [Failure] fs) = do String -> IO () putStr String "[ " [SGR] -> IO () AnsiTerminal.setSGR [ ConsoleLayer -> ColorIntensity -> Color -> SGR AnsiTerminal.SetColor ConsoleLayer AnsiTerminal.Foreground ColorIntensity AnsiTerminal.Vivid Color AnsiTerminal.Red ] String -> IO () putStr String "FAIL" [SGR] -> IO () AnsiTerminal.setSGR [ SGR AnsiTerminal.Reset ] String -> IO () putStr String " ] " String -> IO () putStrLn (Test -> String testName Test t) [(String, String)] -> IO () printNotes [(String, String)] notes [Failure] -> IO () printFailures [Failure] fs colorOutputResult Bool _ Test t (TestAborted [(String, String)] notes String msg) = do String -> IO () putStr String "[ " [SGR] -> IO () AnsiTerminal.setSGR [ ConsoleLayer -> ColorIntensity -> Color -> SGR AnsiTerminal.SetColor ConsoleLayer AnsiTerminal.Foreground ColorIntensity AnsiTerminal.Vivid Color AnsiTerminal.Red ] String -> IO () putStr String "ABORT" [SGR] -> IO () AnsiTerminal.setSGR [ SGR AnsiTerminal.Reset ] String -> IO () putStr String " ] " String -> IO () putStrLn (Test -> String testName Test t) [(String, String)] -> IO () printNotes [(String, String)] notes String -> IO () putStr String " " String -> IO () putStr String msg String -> IO () putStrLn String "\n" colorOutputResult Bool _ Test _ TestResult _ = () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () #endif printNotes :: [(String, String)] -> IO () printNotes :: [(String, String)] -> IO () printNotes [(String, String)] notes = Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless ([(String, String)] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [(String, String)] notes) (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do [(String, String)] -> ((String, String) -> IO ()) -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [(String, String)] notes (((String, String) -> IO ()) -> IO ()) -> ((String, String) -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \(String key, String value) -> do String -> IO () putStr String " note: " String -> IO () putStr String key String -> IO () putStr String "=" String -> IO () putStrLn String value String -> IO () putStrLn String "" printFailures :: [Failure] -> IO () printFailures :: [Failure] -> IO () printFailures [Failure] fs = [Failure] -> (Failure -> IO ()) -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [Failure] fs ((Failure -> IO ()) -> IO ()) -> (Failure -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \Failure f -> do String -> IO () putStr String " " case Failure -> Maybe Location failureLocation Failure f of Just Location loc -> do String -> IO () putStr (Location -> String locationFile Location loc) String -> IO () putStr String ":" case Location -> Maybe Integer locationLine Location loc of Just Integer line -> String -> IO () putStrLn (Integer -> String forall a. Show a => a -> String show Integer line) Maybe Integer Nothing -> String -> IO () putStrLn String "" Maybe Location Nothing -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () String -> IO () putStr String " " String -> IO () putStr (Failure -> String failureMessage Failure f) String -> IO () putStrLn String "\n"