Fix mysterious hanging issue

hedgehog/hedgehog.cabal

@@ -92,6 +92,7 @@ library
     Hedgehog.Range
 
     Hedgehog.Internal.Barbie
+    Hedgehog.Internal.Check
     Hedgehog.Internal.Config
     Hedgehog.Internal.Discovery
     Hedgehog.Internal.Distributive

hedgehog/src/Hedgehog.hs

@@ -171,6 +171,7 @@ import           Data.Functor.Classes (Eq1, eq1, Ord1, compare1, Show1, showsPre
 
 import           Hedgehog.Internal.Barbie (FunctorB(..), TraversableB(..), Rec(..))
 import           Hedgehog.Internal.Distributive (distributeT)
+import           Hedgehog.Internal.Check (check)
 import           Hedgehog.Internal.Gen (Gen, GenT, MonadGen(..))
 import           Hedgehog.Internal.HTraversable (HTraversable(..))
 import           Hedgehog.Internal.Opaque (Opaque(..))
@@ -194,7 +195,7 @@ import           Hedgehog.Internal.Property (Test, TestT, property, test)
 import           Hedgehog.Internal.Property (TestLimit, withTests)
 import           Hedgehog.Internal.Property (collect, label)
 import           Hedgehog.Internal.Range (Range, Size(..))
-import           Hedgehog.Internal.Runner (check, recheck, recheckAt, checkSequential, checkParallel)
+import           Hedgehog.Internal.Runner (recheck, recheckAt, checkSequential, checkParallel)
 import           Hedgehog.Internal.Seed (Seed(..))
 import           Hedgehog.Internal.State (Command(..), Callback(..))
 import           Hedgehog.Internal.State (Action, Sequential(..), Parallel(..))

hedgehog/src/Hedgehog/Internal/Check.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Hedgehog.Internal.Check
+  ( check
+  ) where
+
+import           Control.Monad.IO.Class (MonadIO(..))
+import           Hedgehog.Internal.Config
+import           Hedgehog.Internal.Prelude
+import           Hedgehog.Internal.Property
+import           Hedgehog.Internal.Region
+import           Hedgehog.Internal.Report
+import           Hedgehog.Internal.Runner (checkReport)
+import           Hedgehog.Range (Size)
+
+checkRegion ::
+     MonadIO m
+  => Region
+  -> UseColor
+  -> Maybe PropertyName
+  -> Size
+  -> Seed
+  -> Property
+  -> m (Report Result)
+checkRegion region color name size seed prop =
+  liftIO $ do
+    result <-
+      checkReport (propertyConfig prop) size seed (propertyTest prop) $ \progress -> do
+        ppprogress <- renderProgress color name progress
+        case reportStatus progress of
+          Running ->
+            setRegion region ppprogress
+          Shrinking _ ->
+            openRegion region ppprogress
+
+    ppresult <- renderResult color name result
+    case reportStatus result of
+      Failed _ ->
+        openRegion region ppresult
+      GaveUp ->
+        openRegion region ppresult
+      OK ->
+        setRegion region ppresult
+
+    pure result
+
+checkNamed ::
+     MonadIO m
+  => Region
+  -> UseColor
+  -> Maybe PropertyName
+  -> Maybe Seed
+  -> Property
+  -> m (Report Result)
+checkNamed region color name mseed prop = do
+  seed <- resolveSeed mseed
+  checkRegion region color name 0 seed prop
+
+-- | Check a property.
+--
+check :: MonadIO m => Property -> m Bool
+check prop = do
+  color <- detectColor
+  liftIO . displayRegion $ \region ->
+    (== OK) . reportStatus <$> checkNamed region color Nothing Nothing prop

hedgehog/src/Hedgehog/Internal/Runner.hs

@@ -11,8 +11,7 @@
 
 module Hedgehog.Internal.Runner (
   -- * Running Individual Properties
-    check
-  , recheck
+    recheck
   , recheckAt
 
   -- * Running Groups of Properties
@@ -23,8 +22,6 @@ module Hedgehog.Internal.Runner (
 
   -- * Internal
   , checkReport
-  , checkRegion
-  , checkNamed
   ) where
 
 import           Control.Concurrent.STM (TVar, atomically)
@@ -420,14 +417,6 @@ checkNamed region color name mseed prop = do
   seed <- resolveSeed mseed
   checkRegion region color name 0 seed prop
 
--- | Check a property.
---
-check :: MonadIO m => Property -> m Bool
-check prop = do
-  color <- detectColor
-  liftIO . displayRegion $ \region ->
-    (== OK) . reportStatus <$> checkNamed region color Nothing Nothing prop
-
 -- | Check a property using a specific size and seed.
 --
 recheck :: MonadIO m => Size -> Seed -> Property -> m ()