module Test.Framework.Runners.Console (
defaultMain, defaultMainWithArgs, defaultMainWithOpts,
SuppliedRunnerOptions, optionsDescription,
interpretArgs, interpretArgsOrExit
) where
import Test.Framework.Core
import Test.Framework.Options
import Test.Framework.Runners.Console.Run
import Test.Framework.Runners.Core
import Test.Framework.Runners.Options
import Test.Framework.Runners.Processors
import Test.Framework.Runners.Statistics
import qualified Test.Framework.Runners.XML as XML
import Test.Framework.Seed
import Test.Framework.Utilities
import Control.Monad (when)
import System.Console.GetOpt
import System.Environment
import System.Exit
import System.IO
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
#if !(MIN_VERSION_base(4,7,0))
import Data.Orphans ()
#endif
type SuppliedRunnerOptions = Maybe RunnerOptions
optionsDescription :: [OptDescr SuppliedRunnerOptions]
optionsDescription :: [OptDescr SuppliedRunnerOptions]
optionsDescription = [
[Char]
-> [[Char]]
-> ArgDescr SuppliedRunnerOptions
-> [Char]
-> OptDescr SuppliedRunnerOptions
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"help"]
(SuppliedRunnerOptions -> ArgDescr SuppliedRunnerOptions
forall a. a -> ArgDescr a
NoArg SuppliedRunnerOptions
forall a. Maybe a
Nothing)
[Char]
"show this help message"
] [OptDescr SuppliedRunnerOptions]
-> [OptDescr SuppliedRunnerOptions]
-> [OptDescr SuppliedRunnerOptions]
forall a. [a] -> [a] -> [a]
++ (OptDescr (RunnerOptions' Maybe) -> OptDescr SuppliedRunnerOptions)
-> [OptDescr (RunnerOptions' Maybe)]
-> [OptDescr SuppliedRunnerOptions]
forall a b. (a -> b) -> [a] -> [b]
map ((RunnerOptions' Maybe -> SuppliedRunnerOptions)
-> OptDescr (RunnerOptions' Maybe)
-> OptDescr SuppliedRunnerOptions
forall a b. (a -> b) -> OptDescr a -> OptDescr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RunnerOptions' Maybe -> SuppliedRunnerOptions
forall a. a -> Maybe a
Just) [
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'j'] [[Char]
"threads"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_threads :: Maybe Int
ropt_threads = Int -> Maybe Int
forall a. a -> Maybe a
Just ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
t) }) [Char]
"NUMBER")
[Char]
"number of threads to use to run tests",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"test-seed"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_test_options :: Maybe TestOptions
ropt_test_options = TestOptions -> Maybe TestOptions
forall a. a -> Maybe a
Just (TestOptions
forall a. Monoid a => a
mempty { topt_seed :: Maybe Seed
topt_seed = Seed -> Maybe Seed
forall a. a -> Maybe a
Just ([Char] -> Seed
forall a. Read a => [Char] -> a
read [Char]
t) }) }) ([Char]
"NUMBER|" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Seed -> [Char]
forall a. Show a => a -> [Char]
show Seed
RandomSeed))
[Char]
"default seed for test random number generator",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'a'] [[Char]
"maximum-generated-tests"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_test_options :: Maybe TestOptions
ropt_test_options = TestOptions -> Maybe TestOptions
forall a. a -> Maybe a
Just (TestOptions
forall a. Monoid a => a
mempty { topt_maximum_generated_tests :: Maybe Int
topt_maximum_generated_tests = Int -> Maybe Int
forall a. a -> Maybe a
Just ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
t) }) }) [Char]
"NUMBER")
[Char]
"how many automated tests something like QuickCheck should try, by default",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"maximum-unsuitable-generated-tests"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_test_options :: Maybe TestOptions
ropt_test_options = TestOptions -> Maybe TestOptions
forall a. a -> Maybe a
Just (TestOptions
forall a. Monoid a => a
mempty { topt_maximum_unsuitable_generated_tests :: Maybe Int
topt_maximum_unsuitable_generated_tests = Int -> Maybe Int
forall a. a -> Maybe a
Just ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
t) }) }) [Char]
"NUMBER")
[Char]
"how many unsuitable candidate tests something like QuickCheck should endure before giving up, by default",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
's'] [[Char]
"maximum-test-size"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty {ropt_test_options :: Maybe TestOptions
ropt_test_options = TestOptions -> Maybe TestOptions
forall a. a -> Maybe a
Just (TestOptions
forall a. Monoid a => a
mempty { topt_maximum_test_size :: Maybe Int
topt_maximum_test_size = Int -> Maybe Int
forall a. a -> Maybe a
Just ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
t) }) }) [Char]
"NUMBER")
[Char]
"to what size something like QuickCheck should test the properties, by default",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'd'] [[Char]
"maximum-test-depth"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_test_options :: Maybe TestOptions
ropt_test_options = TestOptions -> Maybe TestOptions
forall a. a -> Maybe a
Just (TestOptions
forall a. Monoid a => a
mempty { topt_maximum_test_depth :: Maybe Int
topt_maximum_test_depth = Int -> Maybe Int
forall a. a -> Maybe a
Just ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
t) }) }) [Char]
"NUMBER")
[Char]
"to what depth something like SmallCheck should test the properties, by default",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'o'] [[Char]
"timeout"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_test_options :: Maybe TestOptions
ropt_test_options = TestOptions -> Maybe TestOptions
forall a. a -> Maybe a
Just (TestOptions
forall a. Monoid a => a
mempty { topt_timeout :: Maybe (Maybe Int)
topt_timeout = Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
secondsToMicroseconds ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
t))) }) }) [Char]
"NUMBER")
[Char]
"how many seconds a test should be run for before giving up, by default",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"no-timeout"]
(RunnerOptions' Maybe -> ArgDescr (RunnerOptions' Maybe)
forall a. a -> ArgDescr a
NoArg (RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_test_options :: Maybe TestOptions
ropt_test_options = TestOptions -> Maybe TestOptions
forall a. a -> Maybe a
Just (TestOptions
forall a. Monoid a => a
mempty { topt_timeout :: Maybe (Maybe Int)
topt_timeout = Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just Maybe Int
forall a. Maybe a
Nothing }) }))
[Char]
"specifies that tests should be run without a timeout, by default",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'l'] [[Char]
"list-tests"]
(RunnerOptions' Maybe -> ArgDescr (RunnerOptions' Maybe)
forall a. a -> ArgDescr a
NoArg (RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_list_only :: Maybe Bool
ropt_list_only = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True }))
[Char]
"list available tests but don't run any; useful to guide subsequent --select-tests",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
't'] [[Char]
"select-tests"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_test_patterns :: Maybe [TestPattern]
ropt_test_patterns = [TestPattern] -> Maybe [TestPattern]
forall a. a -> Maybe a
Just [[Char] -> TestPattern
forall a. Read a => [Char] -> a
read [Char]
t] }) [Char]
"TEST-PATTERN")
[Char]
"only tests that match at least one glob pattern given by an instance of this argument will be run",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"jxml"]
(([Char] -> RunnerOptions' Maybe)
-> [Char] -> ArgDescr (RunnerOptions' Maybe)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
t -> RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_xml_output :: Maybe (Maybe [Char])
ropt_xml_output = Maybe [Char] -> Maybe (Maybe [Char])
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
t) }) [Char]
"FILE")
[Char]
"write a JUnit XML summary of the output to FILE",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"jxml-nested"]
(RunnerOptions' Maybe -> ArgDescr (RunnerOptions' Maybe)
forall a. a -> ArgDescr a
NoArg (RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_xml_nested :: Maybe Bool
ropt_xml_nested = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True }))
[Char]
"use nested testsuites to represent groups in JUnit XML (not standards compliant)",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"plain"]
(RunnerOptions' Maybe -> ArgDescr (RunnerOptions' Maybe)
forall a. a -> ArgDescr a
NoArg (RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_color_mode :: Maybe ColorMode
ropt_color_mode = ColorMode -> Maybe ColorMode
forall a. a -> Maybe a
Just ColorMode
ColorNever }))
[Char]
"do not use any ANSI terminal features to display the test run",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"color"]
(RunnerOptions' Maybe -> ArgDescr (RunnerOptions' Maybe)
forall a. a -> ArgDescr a
NoArg (RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_color_mode :: Maybe ColorMode
ropt_color_mode = ColorMode -> Maybe ColorMode
forall a. a -> Maybe a
Just ColorMode
ColorAlways }))
[Char]
"use ANSI terminal features to display the test run",
[Char]
-> [[Char]]
-> ArgDescr (RunnerOptions' Maybe)
-> [Char]
-> OptDescr (RunnerOptions' Maybe)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"hide-successes"]
(RunnerOptions' Maybe -> ArgDescr (RunnerOptions' Maybe)
forall a. a -> ArgDescr a
NoArg (RunnerOptions' Maybe
forall a. Monoid a => a
mempty { ropt_hide_successes :: Maybe Bool
ropt_hide_successes = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True }))
[Char]
"hide sucessful tests, and only show failures"
]
interpretArgs :: [String] -> IO (Either String (RunnerOptions, [String]))
interpretArgs :: [[Char]] -> IO (Either [Char] (RunnerOptions' Maybe, [[Char]]))
interpretArgs [[Char]]
args = do
[Char]
prog_name <- IO [Char]
getProgName
let usage_header :: [Char]
usage_header = [Char]
"Usage: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
prog_name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [OPTIONS]"
case ArgOrder SuppliedRunnerOptions
-> [OptDescr SuppliedRunnerOptions]
-> [[Char]]
-> ([SuppliedRunnerOptions], [[Char]], [[Char]])
forall a.
ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
getOpt ArgOrder SuppliedRunnerOptions
forall a. ArgOrder a
Permute [OptDescr SuppliedRunnerOptions]
optionsDescription [[Char]]
args of
([SuppliedRunnerOptions]
oas, [[Char]]
n, []) | Just [RunnerOptions' Maybe]
os <- [SuppliedRunnerOptions] -> Maybe [RunnerOptions' Maybe]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SuppliedRunnerOptions]
oas -> Either [Char] (RunnerOptions' Maybe, [[Char]])
-> IO (Either [Char] (RunnerOptions' Maybe, [[Char]]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] (RunnerOptions' Maybe, [[Char]])
-> IO (Either [Char] (RunnerOptions' Maybe, [[Char]])))
-> Either [Char] (RunnerOptions' Maybe, [[Char]])
-> IO (Either [Char] (RunnerOptions' Maybe, [[Char]]))
forall a b. (a -> b) -> a -> b
$ (RunnerOptions' Maybe, [[Char]])
-> Either [Char] (RunnerOptions' Maybe, [[Char]])
forall a b. b -> Either a b
Right ([RunnerOptions' Maybe] -> RunnerOptions' Maybe
forall a. Monoid a => [a] -> a
mconcat [RunnerOptions' Maybe]
os, [[Char]]
n)
([SuppliedRunnerOptions]
_, [[Char]]
_, [[Char]]
errs) -> Either [Char] (RunnerOptions' Maybe, [[Char]])
-> IO (Either [Char] (RunnerOptions' Maybe, [[Char]]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] (RunnerOptions' Maybe, [[Char]])
-> IO (Either [Char] (RunnerOptions' Maybe, [[Char]])))
-> Either [Char] (RunnerOptions' Maybe, [[Char]])
-> IO (Either [Char] (RunnerOptions' Maybe, [[Char]]))
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] (RunnerOptions' Maybe, [[Char]])
forall a b. a -> Either a b
Left ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
errs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [OptDescr SuppliedRunnerOptions] -> [Char]
forall a. [Char] -> [OptDescr a] -> [Char]
usageInfo [Char]
usage_header [OptDescr SuppliedRunnerOptions]
optionsDescription)
interpretArgsOrExit :: [String] -> IO RunnerOptions
interpretArgsOrExit :: [[Char]] -> IO (RunnerOptions' Maybe)
interpretArgsOrExit [[Char]]
args = do
Either [Char] (RunnerOptions' Maybe, [[Char]])
interpreted_args <- [[Char]] -> IO (Either [Char] (RunnerOptions' Maybe, [[Char]]))
interpretArgs [[Char]]
args
case Either [Char] (RunnerOptions' Maybe, [[Char]])
interpreted_args of
Right (RunnerOptions' Maybe
ropts, []) -> RunnerOptions' Maybe -> IO (RunnerOptions' Maybe)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RunnerOptions' Maybe
ropts
Right (RunnerOptions' Maybe
_, [[Char]]
leftovers) -> do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not understand these extra arguments: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
leftovers
ExitCode -> IO (RunnerOptions' Maybe)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Left [Char]
error_message -> do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
error_message
ExitCode -> IO (RunnerOptions' Maybe)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
defaultMain :: [Test] -> IO ()
defaultMain :: [Test] -> IO ()
defaultMain [Test]
tests = do
[[Char]]
args <- IO [[Char]]
getArgs
[Test] -> [[Char]] -> IO ()
defaultMainWithArgs [Test]
tests [[Char]]
args
defaultMainWithArgs :: [Test] -> [String] -> IO ()
defaultMainWithArgs :: [Test] -> [[Char]] -> IO ()
defaultMainWithArgs [Test]
tests [[Char]]
args = do
RunnerOptions' Maybe
ropts <- [[Char]] -> IO (RunnerOptions' Maybe)
interpretArgsOrExit [[Char]]
args
[Test] -> RunnerOptions' Maybe -> IO ()
defaultMainWithOpts [Test]
tests RunnerOptions' Maybe
ropts
defaultMainWithOpts :: [Test] -> RunnerOptions -> IO ()
defaultMainWithOpts :: [Test] -> RunnerOptions' Maybe -> IO ()
defaultMainWithOpts [Test]
tests RunnerOptions' Maybe
ropts = do
let ropts' :: CompleteRunnerOptions
ropts' = RunnerOptions' Maybe -> CompleteRunnerOptions
completeRunnerOptions RunnerOptions' Maybe
ropts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (K Bool -> Bool
forall a. K a -> a
unK(K Bool -> Bool) -> K Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CompleteRunnerOptions -> K Bool
forall (f :: * -> *). RunnerOptions' f -> f Bool
ropt_list_only CompleteRunnerOptions
ropts') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Test] -> [Char]
listTests [Test]
tests
IO ()
forall a. IO a
exitSuccess
[RunningTest]
running_tests <- CompleteRunnerOptions -> [Test] -> IO [RunningTest]
runTests CompleteRunnerOptions
ropts' [Test]
tests
Bool
isplain <- case K ColorMode -> ColorMode
forall a. K a -> a
unK (K ColorMode -> ColorMode) -> K ColorMode -> ColorMode
forall a b. (a -> b) -> a -> b
$ CompleteRunnerOptions -> K ColorMode
forall (f :: * -> *). RunnerOptions' f -> f ColorMode
ropt_color_mode CompleteRunnerOptions
ropts' of
ColorMode
ColorAuto -> Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Handle -> IO Bool
hIsTerminalDevice Handle
stdout
ColorMode
ColorNever -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
ColorMode
ColorAlways -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
[FinishedTest]
fin_tests <- Bool -> Bool -> [RunningTest] -> IO [FinishedTest]
showRunTestsTop Bool
isplain (K Bool -> Bool
forall a. K a -> a
unK (K Bool -> Bool) -> K Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CompleteRunnerOptions -> K Bool
forall (f :: * -> *). RunnerOptions' f -> f Bool
ropt_hide_successes CompleteRunnerOptions
ropts') [RunningTest]
running_tests
let test_statistics' :: TestStatistics
test_statistics' = [FinishedTest] -> TestStatistics
gatherStatistics [FinishedTest]
fin_tests
case CompleteRunnerOptions -> K (Maybe [Char])
forall (f :: * -> *). RunnerOptions' f -> f (Maybe [Char])
ropt_xml_output CompleteRunnerOptions
ropts' of
K (Just [Char]
file) -> Bool -> TestStatistics -> [FinishedTest] -> IO [Char]
XML.produceReport (K Bool -> Bool
forall a. K a -> a
unK (CompleteRunnerOptions -> K Bool
forall (f :: * -> *). RunnerOptions' f -> f Bool
ropt_xml_nested CompleteRunnerOptions
ropts')) TestStatistics
test_statistics' [FinishedTest]
fin_tests IO [Char] -> ([Char] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> [Char] -> IO ()
writeFile [Char]
file
K (Maybe [Char])
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ if TestStatistics -> Bool
ts_no_failures TestStatistics
test_statistics'
then ExitCode
ExitSuccess
else Int -> ExitCode
ExitFailure Int
1
listTests :: [Test] -> String
listTests :: [Test] -> [Char]
listTests [Test]
tests = [Char]
"\ntest-framework: All available tests:\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"====================================\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n") ((Test -> [[Char]]) -> [Test] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> Test -> [[Char]]
showTest [Char]
"") [Test]
tests))
where
showTest :: String -> Test -> [String]
showTest :: [Char] -> Test -> [[Char]]
showTest [Char]
path (Test [Char]
name t
_testlike) = [[Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name]
showTest [Char]
path (TestGroup [Char]
name [Test]
gtests) = (Test -> [[Char]]) -> [Test] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> Test -> [[Char]]
showTest ([Char]
path[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
":"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
name)) [Test]
gtests
showTest [Char]
path (PlusTestOptions TestOptions
_ Test
test) = [Char] -> Test -> [[Char]]
showTest [Char]
path Test
test
showTest [Char]
path (BuildTestBracketed IO (Test, IO ())
_) = [[Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"<created at runtime>"]
completeRunnerOptions :: RunnerOptions -> CompleteRunnerOptions
completeRunnerOptions :: RunnerOptions' Maybe -> CompleteRunnerOptions
completeRunnerOptions RunnerOptions' Maybe
ro = RunnerOptions {
ropt_threads :: K Int
ropt_threads = Int -> K Int
forall a. a -> K a
K (Int -> K Int) -> Int -> K Int
forall a b. (a -> b) -> a -> b
$ RunnerOptions' Maybe -> Maybe Int
forall (f :: * -> *). RunnerOptions' f -> f Int
ropt_threads RunnerOptions' Maybe
ro Maybe Int -> Int -> Int
forall a. Maybe a -> a -> a
`orElse` Int
processorCount,
ropt_test_options :: K TestOptions
ropt_test_options = TestOptions -> K TestOptions
forall a. a -> K a
K (TestOptions -> K TestOptions) -> TestOptions -> K TestOptions
forall a b. (a -> b) -> a -> b
$ RunnerOptions' Maybe -> Maybe TestOptions
forall (f :: * -> *). RunnerOptions' f -> f TestOptions
ropt_test_options RunnerOptions' Maybe
ro Maybe TestOptions -> TestOptions -> TestOptions
forall a. Maybe a -> a -> a
`orElse` TestOptions
forall a. Monoid a => a
mempty,
ropt_test_patterns :: K [TestPattern]
ropt_test_patterns = [TestPattern] -> K [TestPattern]
forall a. a -> K a
K ([TestPattern] -> K [TestPattern])
-> [TestPattern] -> K [TestPattern]
forall a b. (a -> b) -> a -> b
$ RunnerOptions' Maybe -> Maybe [TestPattern]
forall (f :: * -> *). RunnerOptions' f -> f [TestPattern]
ropt_test_patterns RunnerOptions' Maybe
ro Maybe [TestPattern] -> [TestPattern] -> [TestPattern]
forall a. Maybe a -> a -> a
`orElse` [TestPattern]
forall a. Monoid a => a
mempty,
ropt_xml_output :: K (Maybe [Char])
ropt_xml_output = Maybe [Char] -> K (Maybe [Char])
forall a. a -> K a
K (Maybe [Char] -> K (Maybe [Char]))
-> Maybe [Char] -> K (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ RunnerOptions' Maybe -> Maybe (Maybe [Char])
forall (f :: * -> *). RunnerOptions' f -> f (Maybe [Char])
ropt_xml_output RunnerOptions' Maybe
ro Maybe (Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> a -> a
`orElse` Maybe [Char]
forall a. Maybe a
Nothing,
ropt_xml_nested :: K Bool
ropt_xml_nested = Bool -> K Bool
forall a. a -> K a
K (Bool -> K Bool) -> Bool -> K Bool
forall a b. (a -> b) -> a -> b
$ RunnerOptions' Maybe -> Maybe Bool
forall (f :: * -> *). RunnerOptions' f -> f Bool
ropt_xml_nested RunnerOptions' Maybe
ro Maybe Bool -> Bool -> Bool
forall a. Maybe a -> a -> a
`orElse` Bool
False,
ropt_color_mode :: K ColorMode
ropt_color_mode = ColorMode -> K ColorMode
forall a. a -> K a
K (ColorMode -> K ColorMode) -> ColorMode -> K ColorMode
forall a b. (a -> b) -> a -> b
$ RunnerOptions' Maybe -> Maybe ColorMode
forall (f :: * -> *). RunnerOptions' f -> f ColorMode
ropt_color_mode RunnerOptions' Maybe
ro Maybe ColorMode -> ColorMode -> ColorMode
forall a. Maybe a -> a -> a
`orElse` ColorMode
ColorAuto,
ropt_hide_successes :: K Bool
ropt_hide_successes = Bool -> K Bool
forall a. a -> K a
K (Bool -> K Bool) -> Bool -> K Bool
forall a b. (a -> b) -> a -> b
$ RunnerOptions' Maybe -> Maybe Bool
forall (f :: * -> *). RunnerOptions' f -> f Bool
ropt_hide_successes RunnerOptions' Maybe
ro Maybe Bool -> Bool -> Bool
forall a. Maybe a -> a -> a
`orElse` Bool
False,
ropt_list_only :: K Bool
ropt_list_only = Bool -> K Bool
forall a. a -> K a
K (Bool -> K Bool) -> Bool -> K Bool
forall a b. (a -> b) -> a -> b
$ RunnerOptions' Maybe -> Maybe Bool
forall (f :: * -> *). RunnerOptions' f -> f Bool
ropt_list_only RunnerOptions' Maybe
ro Maybe Bool -> Bool -> Bool
forall a. Maybe a -> a -> a
`orElse` Bool
False
}