1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
module Test.Framework.Runners.Options (
module Test.Framework.Runners.Options,
TestPattern
) where
import Test.Framework.Options
import Test.Framework.Utilities
import Test.Framework.Runners.TestPattern
import Data.Monoid
import Data.Semigroup as Sem hiding (Last(..))
data ColorMode = ColorAuto | ColorNever | ColorAlways
type RunnerOptions = RunnerOptions' Maybe
type CompleteRunnerOptions = RunnerOptions' K
data RunnerOptions' f = RunnerOptions {
ropt_threads :: f Int,
ropt_test_options :: f TestOptions,
ropt_test_patterns :: f [TestPattern],
ropt_xml_output :: f (Maybe FilePath),
ropt_xml_nested :: f Bool,
ropt_color_mode :: f ColorMode,
ropt_hide_successes :: f Bool,
ropt_list_only :: f Bool
}
instance Semigroup (RunnerOptions' Maybe) where
ro1 <> ro2 = RunnerOptions {
ropt_threads = getLast (mappendBy (Last . ropt_threads) ro1 ro2),
ropt_test_options = mappendBy ropt_test_options ro1 ro2,
ropt_test_patterns = mappendBy ropt_test_patterns ro1 ro2,
ropt_xml_output = mappendBy ropt_xml_output ro1 ro2,
ropt_xml_nested = getLast (mappendBy (Last . ropt_xml_nested) ro1 ro2),
ropt_color_mode = getLast (mappendBy (Last . ropt_color_mode) ro1 ro2),
ropt_hide_successes = getLast (mappendBy (Last . ropt_hide_successes) ro1 ro2),
ropt_list_only = getLast (mappendBy (Last . ropt_list_only) ro1 ro2)
}
instance Monoid (RunnerOptions' Maybe) where
mempty = RunnerOptions {
ropt_threads = Nothing,
ropt_test_options = Nothing,
ropt_test_patterns = Nothing,
ropt_xml_output = Nothing,
ropt_xml_nested = Nothing,
ropt_color_mode = Nothing,
ropt_hide_successes = Nothing,
ropt_list_only = Nothing
}
mappend = (Sem.<>)
|
