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