-- | This module can be used by providers to perform colorful/formatted
-- output and possibly re-use tasty's own output formats.
--
-- @since 1.3.1
module Test.Tasty.Providers.ConsoleFormat
  ( ResultDetailsPrinter(..)
  , ConsoleFormat(..)
  , ConsoleFormatPrinter
  , noResultDetails
  , failFormat
  , infoFailFormat
  , infoOkFormat
  , okFormat
  , skippedFormat
  )
where

import System.Console.ANSI

-- | Console output format
--
-- @since 1.3.1
data ConsoleFormat = ConsoleFormat
  { ConsoleFormat -> ConsoleIntensity
consoleIntensity :: ConsoleIntensity
  , ConsoleFormat -> ColorIntensity
colorIntensity   :: ColorIntensity
  , ConsoleFormat -> Color
color            :: Color
  }

-- | Type of console format printer functions
--
-- @since 1.3.1
type ConsoleFormatPrinter
  =  ConsoleFormat -- ^ selected console format
  -> IO ()         -- ^ action to be executed with active console format
  -> IO ()

-- | Noop result details printer. The default for most providers.
--
-- @since 1.3.1
noResultDetails :: ResultDetailsPrinter
noResultDetails :: ResultDetailsPrinter
noResultDetails = (Int -> ConsoleFormatPrinter -> IO ()) -> ResultDetailsPrinter
ResultDetailsPrinter ((Int -> ConsoleFormatPrinter -> IO ()) -> ResultDetailsPrinter)
-> (IO () -> Int -> ConsoleFormatPrinter -> IO ())
-> IO ()
-> ResultDetailsPrinter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsoleFormatPrinter -> IO ())
-> Int -> ConsoleFormatPrinter -> IO ()
forall a b. a -> b -> a
const ((ConsoleFormatPrinter -> IO ())
 -> Int -> ConsoleFormatPrinter -> IO ())
-> (IO () -> ConsoleFormatPrinter -> IO ())
-> IO ()
-> Int
-> ConsoleFormatPrinter
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> ConsoleFormatPrinter -> IO ()
forall a b. a -> b -> a
const (IO () -> ResultDetailsPrinter) -> IO () -> ResultDetailsPrinter
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | An action that prints additional information about a test using
-- colors/formatting; see 'Test.Tasty.Providers.testFailedDetails' and
-- 'Test.Tasty.Runners.resultDetailsPrinter'.
--
-- As input, this action is provided with the current indentation level and
-- a 'ConsoleFormatPrinter', which tells it how perform output.
--
-- This is a newtype to allow a 'Show' instance.
--
-- @since 1.3.1
newtype ResultDetailsPrinter = ResultDetailsPrinter
  (Int -> ConsoleFormatPrinter -> IO ())

instance Show ResultDetailsPrinter where
  show :: ResultDetailsPrinter -> String
show ResultDetailsPrinter
_printer = String
"ResultDetailsPrinter"

-- | Format used to display failures
--
-- @since 1.3.1
failFormat :: ConsoleFormat
failFormat :: ConsoleFormat
failFormat = ConsoleIntensity -> ColorIntensity -> Color -> ConsoleFormat
ConsoleFormat ConsoleIntensity
BoldIntensity   ColorIntensity
Vivid Color
Red

-- | Format used to display additional information on failures
infoFailFormat :: ConsoleFormat
--
-- @since 1.3.1
infoFailFormat :: ConsoleFormat
infoFailFormat = ConsoleIntensity -> ColorIntensity -> Color -> ConsoleFormat
ConsoleFormat ConsoleIntensity
NormalIntensity ColorIntensity
Dull  Color
Red

-- | Format used to display sucesses
--
-- @since 1.3.1
okFormat :: ConsoleFormat
okFormat :: ConsoleFormat
okFormat = ConsoleIntensity -> ColorIntensity -> Color -> ConsoleFormat
ConsoleFormat ConsoleIntensity
NormalIntensity ColorIntensity
Dull  Color
Green

-- | Format used to display additional information on sucesses
--
-- @since 1.3.1
infoOkFormat :: ConsoleFormat
infoOkFormat :: ConsoleFormat
infoOkFormat = ConsoleIntensity -> ColorIntensity -> Color -> ConsoleFormat
ConsoleFormat ConsoleIntensity
NormalIntensity ColorIntensity
Dull  Color
White

-- | Format used to display skipped tests
--
-- @since 1.3.1
skippedFormat :: ConsoleFormat
skippedFormat :: ConsoleFormat
skippedFormat = ConsoleIntensity -> ColorIntensity -> Color -> ConsoleFormat
ConsoleFormat ConsoleIntensity
NormalIntensity ColorIntensity
Dull  Color
Magenta