{-# 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"