{-# LANGUAGE FlexibleInstances #-}
--
-- Copyright (c) 2005-2022   Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
--
{-|

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

This functionality is mainly used internally in the code
generated by the @hftpp@ pre-processor.
-}
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
$c== :: TestSort -> TestSort -> Bool
== :: TestSort -> TestSort -> Bool
$c/= :: TestSort -> TestSort -> Bool
/= :: 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
$cshowsPrec :: Int -> TestSort -> ShowS
showsPrec :: Int -> TestSort -> ShowS
$cshow :: TestSort -> String
show :: TestSort -> String
$cshowList :: [TestSort] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS TestSort
readsPrec :: Int -> ReadS TestSort
$creadList :: ReadS [TestSort]
readList :: ReadS [TestSort]
$creadPrec :: ReadPrec TestSort
readPrec :: ReadPrec TestSort
$creadListPrec :: ReadPrec [TestSort]
readListPrec :: ReadPrec [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
$c== :: TestOptions -> TestOptions -> Bool
== :: TestOptions -> TestOptions -> Bool
$c/= :: TestOptions -> TestOptions -> Bool
/= :: 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
$cshowsPrec :: Int -> TestOptions -> ShowS
showsPrec :: Int -> TestOptions -> ShowS
$cshow :: TestOptions -> String
show :: TestOptions -> String
$cshowList :: [TestOptions] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS TestOptions
readsPrec :: Int -> ReadS TestOptions
$creadList :: ReadS [TestOptions]
readList :: ReadS [TestOptions]
$creadPrec :: ReadPrec TestOptions
readPrec :: ReadPrec TestOptions
$creadListPrec :: ReadPrec [TestOptions]
readListPrec :: ReadPrec [TestOptions]
Read)

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

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

-- | Shortcut for constructing a 'WithTestOptions' value.
withOptions :: (TestOptions -> TestOptions) -> a -> WithTestOptions a
withOptions :: forall a. (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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Assertion
forall a. a -> IO a
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Assertion
forall a. a -> IO a
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
$cshowsPrec :: Int -> TestPath -> ShowS
showsPrec :: Int -> TestPath -> ShowS
$cshow :: TestPath -> String
show :: TestPath -> String
$cshowList :: [TestPath] -> ShowS
showList :: [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
      { forall a. GenFlatTest a -> TestSort
ft_sort :: TestSort           -- ^ The sort of the test.
      , forall a. GenFlatTest a -> TestPath
ft_path :: TestPath           -- ^ Hierarchival path.
      , forall a. GenFlatTest a -> Maybe Location
ft_location :: Maybe Location -- ^ Place of definition.
      , forall a. GenFlatTest a -> a
ft_payload :: a               -- ^ A generic payload.
      }

-- | Key of a flat test for the history database.
historyKey :: GenFlatTest a -> T.Text
historyKey :: forall a. 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 -> HtfStack
rr_stack :: HtfStack          -- ^ The stack leading to the test failure
      , 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 -> HtfStack -> ColorString
attachCallStack :: ColorString -> HtfStack -> ColorString
attachCallStack ColorString
msg HtfStack
stack =
    let fstack :: String
fstack = HtfStack -> String
formatHtfStack HtfStack
stack
    in if String
fstack String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""
       then ColorString
msg
       else ColorString -> ColorString
ensureNewlineColorString ColorString
msg ColorString -> ColorString -> ColorString
+++ String -> ColorString
noColor String
fstack

-- | 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
$cshowsPrec :: Int -> TestOutput -> ShowS
showsPrec :: Int -> TestOutput -> ShowS
$cshow :: TestOutput -> String
show :: TestOutput -> String
$cshowList :: [TestOutput] -> ShowS
showList :: [TestOutput] -> ShowS
Show, TestOutput -> TestOutput -> Bool
(TestOutput -> TestOutput -> Bool)
-> (TestOutput -> TestOutput -> Bool) -> Eq TestOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestOutput -> TestOutput -> Bool
== :: TestOutput -> TestOutput -> Bool
$c/= :: TestOutput -> TestOutput -> Bool
/= :: 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
      { tr_id :: String
tr_id = String
id
      , tr_reportAllTests :: ReportAllTests
tr_reportAllTests = \[FlatTest]
_ -> () -> RWST TestConfig () TestState IO ()
forall a. a -> RWST TestConfig () TestState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tr_reportGlobalStart :: ReportAllTests
tr_reportGlobalStart = \[FlatTest]
_ -> () -> RWST TestConfig () TestState IO ()
forall a. a -> RWST TestConfig () TestState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tr_reportTestStart :: ReportTestStart
tr_reportTestStart = \FlatTest
_ -> () -> RWST TestConfig () TestState IO ()
forall a. a -> RWST TestConfig () TestState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tr_reportTestResult :: ReportTestResult
tr_reportTestResult = \FlatTestResult
_ -> () -> RWST TestConfig () TestState IO ()
forall a. a -> RWST TestConfig () TestState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tr_reportGlobalResults :: ReportGlobalResults
tr_reportGlobalResults = \ReportGlobalResultsArg
_ -> () -> RWST TestConfig () TestState IO ()
forall a. a -> RWST TestConfig () TestState IO a
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 ()