{-# 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
    { 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 =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v 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)]
_) =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v 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 =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v 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
_ = 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]
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
    { 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v 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)]
_) =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v 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 =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v 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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif

printNotes :: [(String, String)] -> IO ()
printNotes :: [(String, String)] -> IO ()
printNotes [(String, String)]
notes =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
notes) forall a b. (a -> b) -> a -> b
$
    do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
notes 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 =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Failure]
fs 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 (forall a. Show a => a -> String
show Integer
line)
              Maybe Integer
Nothing -> String -> IO ()
putStrLn String
""
        Maybe Location
Nothing -> 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"