Merge pull request #168 from erikd/topic/test-runner

Add a runTests function

Author: jacobstanley

hedgehog/src/Hedgehog.hs

@@ -139,6 +139,9 @@ module Hedgehog (
 
   , Show1
   , showsPrec1
+
+  -- * Test runner
+  , runTests
   ) where
 
 import           Data.Functor.Classes (Eq1, eq1, Ord1, compare1, Show1, showsPrec1)
@@ -164,6 +167,8 @@ import           Hedgehog.Internal.Property (Test, TestT, property, test)
 import           Hedgehog.Internal.Property (TestLimit, withTests)
 import           Hedgehog.Internal.Range (Range, Size(..))
 import           Hedgehog.Internal.Runner (check, recheck, checkSequential, checkParallel)
+import           Hedgehog.Internal.Runner (runTests)
+
 import           Hedgehog.Internal.Seed (Seed(..))
 import           Hedgehog.Internal.State (Command(..), Callback(..))
 import           Hedgehog.Internal.State (Action, Sequential(..), Parallel(..))

hedgehog/src/Hedgehog/Internal/Runner.hs

@@ -17,6 +17,9 @@ module Hedgehog.Internal.Runner (
   , checkSequential
   , checkGroup
 
+  -- * Top level testsuite runner
+  , runTests
+
   -- * Internal
   , checkReport
   , checkRegion
@@ -25,6 +28,7 @@ module Hedgehog.Internal.Runner (
 
 import           Control.Concurrent.STM (TVar, atomically)
 import qualified Control.Concurrent.STM.TVar as TVar
+import           Control.Monad (unless)
 import           Control.Monad.Catch (MonadCatch(..), catchAll)
 import           Control.Monad.IO.Class (MonadIO(..))
 
@@ -46,8 +50,11 @@ import           Hedgehog.Range (Size)
 
 import           Language.Haskell.TH.Lift (deriveLift)
 
+import           System.Exit (exitFailure)
 #if mingw32_HOST_OS
-import           System.IO (hSetEncoding, stdout, stderr, utf8)
+import           System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, stderr, utf8)
+#else
+import           System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout)
 #endif
 
 -- | Configuration for a property test run.
@@ -402,6 +409,16 @@ checkParallel =
           Nothing
       }
 
+-- | Like `runTests` but exit with `exitFailure` if one or more of the tests
+-- fail.
+runTests :: [IO Bool] -> IO ()
+runTests tests = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
+  result <- and <$> sequence tests
+  unless result
+    exitFailure
+
 ------------------------------------------------------------------------
 -- FIXME Replace with DeriveLift when we drop 7.10 support.
 

hedgehog/test/test.hs

@@ -1,20 +1,12 @@
-import           Control.Monad (unless)
-import           System.IO (BufferMode(..), hSetBuffering, stdout, stderr)
-import           System.Exit (exitFailure)
+import           Hedgehog (runTests)
 
 import qualified Test.Hedgehog.Seed
 import qualified Test.Hedgehog.Text
 
 
 main :: IO ()
-main = do
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stderr LineBuffering
-
-  results <- sequence [
+main =
+  runTests [
       Test.Hedgehog.Text.tests
     , Test.Hedgehog.Seed.tests
     ]
-
-  unless (and results) $
-    exitFailure