Merge branch 'master' of github.com:batterseapower/test-framework

core/Test/Framework/Runners/Console.hs

@@ -71,8 +71,11 @@ optionsDescription = [
             (NoArg (mempty { ropt_xml_nested = Just True }))
             "use nested testsuites to represent groups in JUnit XML (not standards compliant)",
         Option [] ["plain"]
-            (NoArg (mempty { ropt_plain_output = Just True }))
+            (NoArg (mempty { ropt_color_mode = Just ColorNever }))
             "do not use any ANSI terminal features to display the test run",
+        Option [] ["color"]
+            (NoArg (mempty { ropt_color_mode = Just ColorAlways }))
+            "use ANSI terminal features to display the test run",
         Option [] ["hide-successes"]
             (NoArg (mempty { ropt_hide_successes = Just True }))
             "hide sucessful tests, and only show failures"
@@ -123,9 +126,14 @@ defaultMainWithOpts tests ropts = do
 
     -- Get a lazy list of the test results, as executed in parallel
     running_tests <- runTests ropts' tests
-
+
+    isplain <- case unK $ ropt_color_mode ropts' of
+        ColorAuto   -> not `fmap` hIsTerminalDevice stdout
+        ColorNever  -> return True
+        ColorAlways -> return False
+
     -- Show those test results to the user as we get them
-    fin_tests <- showRunTestsTop (unK $ ropt_plain_output ropts') (unK $ ropt_hide_successes ropts') running_tests
+    fin_tests <- showRunTestsTop isplain (unK $ ropt_hide_successes ropts') running_tests
     let test_statistics' = gatherStatistics fin_tests
 
     -- Output XML report (if requested)
@@ -146,6 +154,6 @@ completeRunnerOptions ro = RunnerOptions {
             ropt_test_patterns = K $ ropt_test_patterns ro `orElse` mempty,
             ropt_xml_output = K $ ropt_xml_output ro `orElse` Nothing,
             ropt_xml_nested = K $ ropt_xml_nested ro `orElse` False,
-            ropt_plain_output = K $ ropt_plain_output ro `orElse` False,
+            ropt_color_mode = K $ ropt_color_mode ro `orElse` ColorAuto,
             ropt_hide_successes = K $ ropt_hide_successes ro `orElse` False
         }

core/Test/Framework/Runners/Console/Run.hs

@@ -18,7 +18,7 @@ import System.IO
 
 import Text.PrettyPrint.ANSI.Leijen
 
-import Data.Monoid
+import Data.Monoid (mempty)
 
 import Control.Arrow (second, (&&&))
 import Control.Monad (unless)

core/Test/Framework/Runners/Options.hs

@@ -6,6 +6,7 @@ import Test.Framework.Runners.TestPattern
 
 import Data.Monoid
 
+data ColorMode = ColorAuto | ColorNever | ColorAlways
 
 type RunnerOptions = RunnerOptions' Maybe
 type CompleteRunnerOptions = RunnerOptions' K
@@ -15,7 +16,7 @@ data RunnerOptions' f = RunnerOptions {
         ropt_test_patterns :: f [TestPattern],
         ropt_xml_output :: f (Maybe FilePath),
         ropt_xml_nested :: f Bool,
-        ropt_plain_output :: f Bool,
+        ropt_color_mode :: f ColorMode,
         ropt_hide_successes :: f Bool
     }
 
@@ -26,7 +27,7 @@ instance Monoid (RunnerOptions' Maybe) where
             ropt_test_patterns = Nothing,
             ropt_xml_output = Nothing,
             ropt_xml_nested = Nothing,
-            ropt_plain_output = Nothing,
+            ropt_color_mode = Nothing,
             ropt_hide_successes = Nothing
         }
 
@@ -36,6 +37,6 @@ instance Monoid (RunnerOptions' Maybe) where
             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_plain_output = getLast (mappendBy (Last . ropt_plain_output) ro1 ro2),
+            ropt_color_mode = getLast (mappendBy (Last . ropt_color_mode) ro1 ro2),
             ropt_hide_successes = getLast (mappendBy (Last . ropt_hide_successes) ro1 ro2)
         }

core/test-framework.cabal

@@ -1,5 +1,5 @@
 Name:                test-framework
-Version:             0.4.2.0
+Version:             0.4.2.1
 Cabal-Version:       >= 1.2.3
 Category:            Testing
 Synopsis:            Framework for running and organising tests, with HUnit and QuickCheck support

hunit/Test/Framework/Providers/HUnit.hs

@@ -47,7 +47,7 @@ data TestCaseResult = TestCasePassed
 instance Show TestCaseResult where
     show result = case result of
         TestCasePassed         -> "OK"
-        TestCaseFailed message -> "Failed: " ++ message
+        TestCaseFailed message -> message
         TestCaseError message  -> "ERROR: " ++ message
 
 testCaseSucceeded :: TestCaseResult -> Bool