make cabal test show a FAIL when at least one test fails

Ignore-this: b603ea6350e50cb9197f3a22fac32eae

darcs-hash:20140503054629-1499c-6af82516b153555d2dfad056c7114447b4d8f3cb.gz

1 files changed, 10 insertions, 2 deletions

diff --git a/tests/Properties.hs b/tests/Properties.hs
index 120e950..b5762d7 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -21,15 +21,23 @@ import Properties.Layout.Tall
 import System.Environment
 import Text.Printf
 
+import Control.Monad
+import Control.Applicative
 
 main :: IO ()
 main = do
   arg <- fmap (drop 1) getArgs
   let n = if null arg then 100 else read $ head arg
       args = stdArgs { maxSuccess = n, maxSize = 100 }
-      qc   = quickCheckWithResult args
+      qc t = do
+          c <- quickCheckWithResult args t
+          case c of
+            Success {} -> return True
+            _ -> return False
       perform (s, t) = printf "%-35s: " s >> qc t
-  mapM_ perform tests
+  n <- length . filter not ok <$> mapM perform tests
+  unless (n == 0) (error (show n ++ " test(s) failed"))
+
 
 
 tests =