{-# LANGUAGE FlexibleInstances #-}
{-|

This module defines types (and small auxiliary functions)
for organizing tests, for configuring the execution of
tests, and for representing and reporting their results.

-}
module Test.Framework.TestTypes (

  -- * Organizing tests
  TestID, Test(..), TestOptions(..), AssertionWithTestOptions(..), WithTestOptions(..),
  TestSuite(..), TestSort(..),
  TestPath(..), GenFlatTest(..), FlatTest, TestFilter,
  testPathToList, flatName, finalName, prefixName, defaultTestOptions, withOptions, historyKey,

  -- * Executing tests
  TR, TestState(..), initTestState, TestConfig(..), TestOutput(..),

  -- * Reporting results
  ReportAllTests, ReportGlobalStart, ReportTestStart, ReportTestResult, ReportGlobalResults, ReportGlobalResultsArg(..),
  TestReporter(..), emptyTestReporter, attachCallStack, CallStack,

  -- * Specifying results.
  TestResult(..), FlatTestResult, Milliseconds, RunResult(..)

) where

import Test.Framework.Location
import Test.Framework.Colors
import Test.Framework.History
import Test.Framework.TestInterface

import Control.Monad.RWS
import System.IO
import Data.Maybe
import qualified Data.List as List
import qualified Data.Text as T

-- | Type for naming tests.
type TestID = String

-- | Type for distinguishing different sorts of tests.
data TestSort = UnitTest | QuickCheckTest | BlackBoxTest
              deriving (TestSort -> TestSort -> Bool
(TestSort -> TestSort -> Bool)
-> (TestSort -> TestSort -> Bool) -> Eq TestSort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestSort -> TestSort -> Bool
$c/= :: TestSort -> TestSort -> Bool
== :: TestSort -> TestSort -> Bool
$c== :: TestSort -> TestSort -> Bool
Eq,Int -> TestSort -> ShowS
[TestSort] -> ShowS
TestSort -> String
(Int -> TestSort -> ShowS)
-> (TestSort -> String) -> ([TestSort] -> ShowS) -> Show TestSort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestSort] -> ShowS
$cshowList :: [TestSort] -> ShowS
show :: TestSort -> String
$cshow :: TestSort -> String
showsPrec :: Int -> TestSort -> ShowS
$cshowsPrec :: Int -> TestSort -> ShowS
Show,ReadPrec [TestSort]
ReadPrec TestSort
Int -> ReadS TestSort
ReadS [TestSort]
(Int -> ReadS TestSort)
-> ReadS [TestSort]
-> ReadPrec TestSort
-> ReadPrec [TestSort]
-> Read TestSort
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestSort]
$creadListPrec :: ReadPrec [TestSort]
readPrec :: ReadPrec TestSort
$creadPrec :: ReadPrec TestSort
readList :: ReadS [TestSort]
$creadList :: ReadS [TestSort]
readsPrec :: Int -> ReadS TestSort
$creadsPrec :: Int -> ReadS TestSort
Read)

-- | General options for tests
data TestOptions = TestOptions {
      TestOptions -> Bool
to_parallel :: Bool
    }
    deriving (TestOptions -> TestOptions -> Bool
(TestOptions -> TestOptions -> Bool)
-> (TestOptions -> TestOptions -> Bool) -> Eq TestOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestOptions -> TestOptions -> Bool
$c/= :: TestOptions -> TestOptions -> Bool
== :: TestOptions -> TestOptions -> Bool
$c== :: TestOptions -> TestOptions -> Bool
Eq,Int -> TestOptions -> ShowS
[TestOptions] -> ShowS
TestOptions -> String
(Int -> TestOptions -> ShowS)
-> (TestOptions -> String)
-> ([TestOptions] -> ShowS)
-> Show TestOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestOptions] -> ShowS
$cshowList :: [TestOptions] -> ShowS
show :: TestOptions -> String
$cshow :: TestOptions -> String
showsPrec :: Int -> TestOptions -> ShowS
$cshowsPrec :: Int -> TestOptions -> ShowS
Show,ReadPrec [TestOptions]
ReadPrec TestOptions
Int -> ReadS TestOptions
ReadS [TestOptions]
(Int -> ReadS TestOptions)
-> ReadS [TestOptions]
-> ReadPrec TestOptions
-> ReadPrec [TestOptions]
-> Read TestOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestOptions]
$creadListPrec :: ReadPrec [TestOptions]
readPrec :: ReadPrec TestOptions
$creadPrec :: ReadPrec TestOptions
readList :: ReadS [TestOptions]
$creadList :: ReadS [TestOptions]
readsPrec :: Int -> ReadS TestOptions
$creadsPrec :: Int -> ReadS TestOptions
Read)

-- | The default 'TestOptions'
defaultTestOptions :: TestOptions
defaultTestOptions :: TestOptions
defaultTestOptions = TestOptions :: Bool -> TestOptions
TestOptions {
                       to_parallel :: Bool
to_parallel = Bool
True
                     }

-- | Something with 'TestOptions'
data WithTestOptions a = WithTestOptions {
      WithTestOptions a -> TestOptions
wto_options :: TestOptions
    , WithTestOptions a -> a
wto_payload :: a
    }
    deriving (WithTestOptions a -> WithTestOptions a -> Bool
(WithTestOptions a -> WithTestOptions a -> Bool)
-> (WithTestOptions a -> WithTestOptions a -> Bool)
-> Eq (WithTestOptions a)
forall a. Eq a => WithTestOptions a -> WithTestOptions a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithTestOptions a -> WithTestOptions a -> Bool
$c/= :: forall a. Eq a => WithTestOptions a -> WithTestOptions a -> Bool
== :: WithTestOptions a -> WithTestOptions a -> Bool
$c== :: forall a. Eq a => WithTestOptions a -> WithTestOptions a -> Bool
Eq,Int -> WithTestOptions a -> ShowS
[WithTestOptions a] -> ShowS
WithTestOptions a -> String
(Int -> WithTestOptions a -> ShowS)
-> (WithTestOptions a -> String)
-> ([WithTestOptions a] -> ShowS)
-> Show (WithTestOptions a)
forall a. Show a => Int -> WithTestOptions a -> ShowS
forall a. Show a => [WithTestOptions a] -> ShowS
forall a. Show a => WithTestOptions a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithTestOptions a] -> ShowS
$cshowList :: forall a. Show a => [WithTestOptions a] -> ShowS
show :: WithTestOptions a -> String
$cshow :: forall a. Show a => WithTestOptions a -> String
showsPrec :: Int -> WithTestOptions a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithTestOptions a -> ShowS
Show,ReadPrec [WithTestOptions a]
ReadPrec (WithTestOptions a)
Int -> ReadS (WithTestOptions a)
ReadS [WithTestOptions a]
(Int -> ReadS (WithTestOptions a))
-> ReadS [WithTestOptions a]
-> ReadPrec (WithTestOptions a)
-> ReadPrec [WithTestOptions a]
-> Read (WithTestOptions a)
forall a. Read a => ReadPrec [WithTestOptions a]
forall a. Read a => ReadPrec (WithTestOptions a)
forall a. Read a => Int -> ReadS (WithTestOptions a)
forall a. Read a => ReadS [WithTestOptions a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WithTestOptions a]
$creadListPrec :: forall a. Read a => ReadPrec [WithTestOptions a]
readPrec :: ReadPrec (WithTestOptions a)
$creadPrec :: forall a. Read a => ReadPrec (WithTestOptions a)
readList :: ReadS [WithTestOptions a]
$creadList :: forall a. Read a => ReadS [WithTestOptions a]
readsPrec :: Int -> ReadS (WithTestOptions a)
$creadsPrec :: forall a. Read a => Int -> ReadS (WithTestOptions a)
Read)

-- | Shortcut for constructing a 'WithTestOptions' value.
withOptions :: (TestOptions -> TestOptions) -> a -> WithTestOptions a
withOptions :: (TestOptions -> TestOptions) -> a -> WithTestOptions a
withOptions TestOptions -> TestOptions
f a
x = TestOptions -> a -> WithTestOptions a
forall a. TestOptions -> a -> WithTestOptions a
WithTestOptions (TestOptions -> TestOptions
f TestOptions
defaultTestOptions) a
x

-- | A type class for an assertion with 'TestOptions'.
class AssertionWithTestOptions a where
    testOptions :: a -> TestOptions
    assertion :: a -> Assertion

instance AssertionWithTestOptions (IO a) where
    testOptions :: IO a -> TestOptions
testOptions IO a
_ = TestOptions
defaultTestOptions
    assertion :: IO a -> Assertion
assertion IO a
io = IO a
io IO a -> Assertion -> Assertion
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance AssertionWithTestOptions (WithTestOptions (IO a)) where
    testOptions :: WithTestOptions (IO a) -> TestOptions
testOptions (WithTestOptions TestOptions
opts IO a
_) = TestOptions
opts
    assertion :: WithTestOptions (IO a) -> Assertion
assertion (WithTestOptions TestOptions
_ IO a
io) = IO a
io IO a -> Assertion -> Assertion
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Abstract type for tests and their results.
data Test = BaseTest TestSort TestID (Maybe Location) TestOptions Assertion
          | CompoundTest TestSuite

-- | Abstract type for test suites and their results.
data TestSuite = TestSuite TestID [Test]
               | AnonTestSuite [Test]

-- | A type denoting the hierarchical name of a test.
data TestPath = TestPathBase TestID
              | TestPathCompound (Maybe TestID) TestPath
                deriving (Int -> TestPath -> ShowS
[TestPath] -> ShowS
TestPath -> String
(Int -> TestPath -> ShowS)
-> (TestPath -> String) -> ([TestPath] -> ShowS) -> Show TestPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestPath] -> ShowS
$cshowList :: [TestPath] -> ShowS
show :: TestPath -> String
$cshow :: TestPath -> String
showsPrec :: Int -> TestPath -> ShowS
$cshowsPrec :: Int -> TestPath -> ShowS
Show)

-- | Splits a 'TestPath' into a list of test identifiers.
testPathToList :: TestPath -> [Maybe TestID]
testPathToList :: TestPath -> [Maybe String]
testPathToList (TestPathBase String
i) = [String -> Maybe String
forall a. a -> Maybe a
Just String
i]
testPathToList (TestPathCompound Maybe String
mi TestPath
p) =
    Maybe String
mi Maybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
: TestPath -> [Maybe String]
testPathToList TestPath
p

-- | Creates a string representation from a 'TestPath'.
flatName :: TestPath -> String
flatName :: TestPath -> String
flatName TestPath
p =
    [Maybe String] -> String
flatNameFromList (TestPath -> [Maybe String]
testPathToList TestPath
p)

flatNameFromList :: [Maybe TestID] -> String
flatNameFromList :: [Maybe String] -> String
flatNameFromList [Maybe String]
l =
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
":" ((Maybe String -> String) -> [Maybe String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"") [Maybe String]
l)

-- | Returns the final name of a 'TestPath'
finalName :: TestPath -> String
finalName :: TestPath -> String
finalName (TestPathBase String
i) = String
i
finalName (TestPathCompound Maybe String
_ TestPath
p) = TestPath -> String
finalName TestPath
p

-- | Returns the name of the prefix of a test path. The prefix is everything except the
--   last element.
prefixName :: TestPath -> String
prefixName :: TestPath -> String
prefixName TestPath
path =
    let l :: [Maybe String]
l = case [Maybe String] -> [Maybe String]
forall a. [a] -> [a]
reverse (TestPath -> [Maybe String]
testPathToList TestPath
path) of
              [] -> []
              (Maybe String
_:[Maybe String]
xs) -> [Maybe String] -> [Maybe String]
forall a. [a] -> [a]
reverse [Maybe String]
xs
    in [Maybe String] -> String
flatNameFromList [Maybe String]
l

-- | Generic type for flattened tests and their results.
data GenFlatTest a
    = FlatTest
      { GenFlatTest a -> TestSort
ft_sort :: TestSort           -- ^ The sort of the test.
      , GenFlatTest a -> TestPath
ft_path :: TestPath           -- ^ Hierarchival path.
      , GenFlatTest a -> Maybe Location
ft_location :: Maybe Location -- ^ Place of definition.
      , GenFlatTest a -> a
ft_payload :: a               -- ^ A generic payload.
      }

-- | Key of a flat test for the history database.
historyKey :: GenFlatTest a -> T.Text
historyKey :: GenFlatTest a -> Text
historyKey GenFlatTest a
ft = String -> Text
T.pack (TestPath -> String
flatName (GenFlatTest a -> TestPath
forall a. GenFlatTest a -> TestPath
ft_path GenFlatTest a
ft))

-- | Flattened representation of tests.
type FlatTest = GenFlatTest (WithTestOptions Assertion)

-- | A filter is a predicate on 'FlatTest'. If the predicate is 'True', the flat test is run.
type TestFilter = FlatTest -> Bool

-- | A type for call-stacks
type CallStack = [(Maybe String, Location)]

-- | The result of a test run.
data RunResult
    = RunResult
      { RunResult -> TestResult
rr_result :: TestResult       -- ^ The summary result of the test.
      , RunResult -> Maybe Location
rr_location :: Maybe Location -- ^ The location where the test failed (if applicable).
      , RunResult -> CallStack
rr_callers :: CallStack       -- ^ Information about the callers of the location where the test failed
      , RunResult -> ColorString
rr_message :: ColorString     -- ^ A message describing the result.
      , RunResult -> Int
rr_wallTimeMs :: Milliseconds -- ^ Execution time in milliseconds.
      , RunResult -> Bool
rr_timeout :: Bool            -- ^ 'True' if the execution took too long
      }

attachCallStack :: ColorString -> CallStack -> ColorString
attachCallStack :: ColorString -> CallStack -> ColorString
attachCallStack ColorString
msg CallStack
callStack =
    case CallStack -> CallStack
forall a. [a] -> [a]
reverse CallStack
callStack of
      [] -> ColorString
msg
      CallStack
l -> ColorString -> ColorString
ensureNewlineColorString ColorString
msg ColorString -> ColorString -> ColorString
+++
           String -> ColorString
noColor ([String] -> String
unlines (((Maybe String, Location) -> String) -> CallStack -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe String, Location) -> String
formatCallStackElem CallStack
l))
    where
      formatCallStackElem :: (Maybe String, Location) -> String
formatCallStackElem (Maybe String
mMsg, Location
loc) =
          String
"  called from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ (case Maybe String
mMsg of
                                                Maybe String
Nothing -> String
""
                                                Just String
s -> String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")

-- | The result of running a 'FlatTest'
type FlatTestResult = GenFlatTest RunResult

-- | The state type for the 'TR' monad.
data TestState = TestState { TestState -> [FlatTestResult]
ts_results :: [FlatTestResult] -- ^ Results collected so far.
                           , TestState -> Int
ts_index :: Int                -- ^ Current index for splitted output.
                           }

-- | The initial test state.
initTestState :: TestState
initTestState :: TestState
initTestState = [FlatTestResult] -> Int -> TestState
TestState [] Int
0

-- | The 'TR' (test runner) monad.
type TR = RWST TestConfig () TestState IO

-- | The destination of progress and result messages from HTF.
data TestOutput = TestOutputHandle Handle Bool -- ^ Output goes to 'Handle', boolean flag indicates whether the handle should be closed at the end.
                | TestOutputSplitted FilePath  -- ^ Output goes to files whose names are derived from 'FilePath' by appending a number to it. Numbering starts at zero.
                  deriving (Int -> TestOutput -> ShowS
[TestOutput] -> ShowS
TestOutput -> String
(Int -> TestOutput -> ShowS)
-> (TestOutput -> String)
-> ([TestOutput] -> ShowS)
-> Show TestOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestOutput] -> ShowS
$cshowList :: [TestOutput] -> ShowS
show :: TestOutput -> String
$cshow :: TestOutput -> String
showsPrec :: Int -> TestOutput -> ShowS
$cshowsPrec :: Int -> TestOutput -> ShowS
Show, TestOutput -> TestOutput -> Bool
(TestOutput -> TestOutput -> Bool)
-> (TestOutput -> TestOutput -> Bool) -> Eq TestOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestOutput -> TestOutput -> Bool
$c/= :: TestOutput -> TestOutput -> Bool
== :: TestOutput -> TestOutput -> Bool
$c== :: TestOutput -> TestOutput -> Bool
Eq)

-- | Configuration of test execution.
data TestConfig
    = TestConfig
      { TestConfig -> Bool
tc_quiet :: Bool                -- ^ If set, displays messages only for failed tests.
      , TestConfig -> Maybe Int
tc_threads :: Maybe Int         -- ^ Use @Just i@ for parallel execution with @i@ threads, @Nothing@ for sequential execution.
      , TestConfig -> Bool
tc_shuffle :: Bool              -- ^ Shuffle tests before parallel execution
      , TestConfig -> TestOutput
tc_output :: TestOutput         -- ^ Output destination of progress and result messages.
      , TestConfig -> Maybe String
tc_outputXml :: Maybe FilePath  -- ^ Output destination of XML result summary
      , TestConfig -> TestFilter
tc_filter :: TestFilter         -- ^ Filter for the tests to run.
      , TestConfig -> [TestReporter]
tc_reporters :: [TestReporter]  -- ^ Test reporters to use.
      , TestConfig -> Bool
tc_useColors :: Bool            -- ^ Whether to use colored output
      , TestConfig -> String
tc_historyFile :: FilePath      -- ^ Path to history file
      , TestConfig -> TestHistory
tc_history :: TestHistory       -- ^ History of previous test runs
      , TestConfig -> Bool
tc_sortByPrevTime :: Bool       -- ^ Sort ascending by previous execution times
      , TestConfig -> Bool
tc_failFast :: Bool             -- ^ Stop test run as soon as one test fails
      , TestConfig -> Bool
tc_timeoutIsSuccess :: Bool     -- ^ Do not regard timeout as an error
      , TestConfig -> Maybe Int
tc_maxSingleTestTime :: Maybe Milliseconds -- ^ Maximum time in milliseconds a single test is allowed to run
      , TestConfig -> Maybe Double
tc_prevFactor :: Maybe Double   -- ^ Maximum factor a single test is allowed to run slower than its previous execution
      , TestConfig -> Int
tc_repeat :: Int                -- ^ Number of times to repeat tests selected on the command line before reporting them as a success.
      }

instance Show TestConfig where
    showsPrec :: Int -> TestConfig -> ShowS
showsPrec Int
prec TestConfig
tc =
        Bool -> ShowS -> ShowS
showParen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"TestConfig { " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
"tc_quiet=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Bool
tc_quiet TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_threads=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Maybe Int
tc_threads TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_shuffle=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Bool
tc_shuffle TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_output=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TestOutput -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> TestOutput
tc_output TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_outputXml=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Maybe String
tc_outputXml TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_filter=<filter>" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_reporters=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [TestReporter] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> [TestReporter]
tc_reporters TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_useColors=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Bool
tc_useColors TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_historyFile=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> String
tc_historyFile TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_history=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TestHistory -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> TestHistory
tc_history TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_sortByPrevTime=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Bool
tc_sortByPrevTime TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_failFast=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Bool
tc_failFast TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_timeoutIsSuccess=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Bool
tc_timeoutIsSuccess TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_maxSingleTestTime=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Maybe Int
tc_maxSingleTestTime TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_prevFactor=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Maybe Double
tc_prevFactor TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", tc_repeat=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (TestConfig -> Int
tc_repeat TestConfig
tc) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
" }"

-- | A 'TestReporter' provides hooks to customize the output of HTF.
data TestReporter
    = TestReporter
      { TestReporter -> String
tr_id :: String
      , TestReporter -> ReportAllTests
tr_reportAllTests :: ReportAllTests        -- ^ Called to report the IDs of all tests available.
      , TestReporter -> ReportAllTests
tr_reportGlobalStart :: ReportGlobalStart  -- ^ Called to report the start of test execution.
      , TestReporter -> ReportTestStart
tr_reportTestStart :: ReportTestStart      -- ^ Called to report the start of a single test.
      , TestReporter -> ReportTestResult
tr_reportTestResult :: ReportTestResult    -- ^ Called to report the result of a single test.
      , TestReporter -> ReportGlobalResults
tr_reportGlobalResults :: ReportGlobalResults  -- ^ Called to report the overall results of all tests.
      }

emptyTestReporter :: String -> TestReporter
emptyTestReporter :: String -> TestReporter
emptyTestReporter String
id =
    TestReporter :: String
-> ReportAllTests
-> ReportAllTests
-> ReportTestStart
-> ReportTestResult
-> ReportGlobalResults
-> TestReporter
TestReporter
      { tr_id :: String
tr_id = String
id
      , tr_reportAllTests :: ReportAllTests
tr_reportAllTests = \[FlatTest]
_ -> () -> RWST TestConfig () TestState IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tr_reportGlobalStart :: ReportAllTests
tr_reportGlobalStart = \[FlatTest]
_ -> () -> RWST TestConfig () TestState IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tr_reportTestStart :: ReportTestStart
tr_reportTestStart = \FlatTest
_ -> () -> RWST TestConfig () TestState IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tr_reportTestResult :: ReportTestResult
tr_reportTestResult = \FlatTestResult
_ -> () -> RWST TestConfig () TestState IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tr_reportGlobalResults :: ReportGlobalResults
tr_reportGlobalResults = \ReportGlobalResultsArg
_ -> () -> RWST TestConfig () TestState IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      }

instance Show TestReporter where
    showsPrec :: Int -> TestReporter -> ShowS
showsPrec Int
_ TestReporter
x = String -> ShowS
showString (TestReporter -> String
tr_id TestReporter
x)

instance Eq TestReporter where
    TestReporter
x == :: TestReporter -> TestReporter -> Bool
== TestReporter
y = (TestReporter -> String
tr_id TestReporter
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (TestReporter -> String
tr_id TestReporter
y)

-- | Reports the IDs of all tests available.
type ReportAllTests = [FlatTest] -> TR ()

-- | Signals that test execution is about to start.
type ReportGlobalStart = [FlatTest] -> TR ()

-- | Reports the start of a single test.
type ReportTestStart = FlatTest -> TR ()

-- | Reports the result of a single test.
type ReportTestResult = FlatTestResult -> TR ()

data ReportGlobalResultsArg
    = ReportGlobalResultsArg
    { ReportGlobalResultsArg -> Int
rgra_timeMs :: Milliseconds
    , ReportGlobalResultsArg -> [FlatTestResult]
rgra_passed :: [FlatTestResult]
    , ReportGlobalResultsArg -> [FlatTestResult]
rgra_pending :: [FlatTestResult]
    , ReportGlobalResultsArg -> [FlatTestResult]
rgra_failed :: [FlatTestResult]
    , ReportGlobalResultsArg -> [FlatTestResult]
rgra_errors :: [FlatTestResult]
    , ReportGlobalResultsArg -> [FlatTestResult]
rgra_timedOut :: [FlatTestResult]
    , ReportGlobalResultsArg -> [FlatTest]
rgra_filtered :: [FlatTest]
    }

-- | Reports the overall results of all tests.
type ReportGlobalResults = ReportGlobalResultsArg -> TR ()