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