diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,10 @@
+## Version 0.2 (2017-05-06)
+
+- Added a quiet test runner which can be activated by setting `HEDGEHOG_VERBOSITY=0`
+- Concurrent test runner does not display tests until they are executing.
+- Test runner now outputs a summary of how many successful / failed tests were run.
+- `checkSequential` and `checkParallel` now allow for tests to be run without Template Haskell.
+- Auto-discovery of properties is now available via `discover` instead of being baked in.
+- `annotate` allows source code to be annotated inline with extra information.
+- `forAllWith` can be used to generate values without a `Show` instance.
+- Removed uses of `Typeable` to allow for generating types which cannot implement it.
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-hedgehog [![Hackage version](https://img.shields.io/hackage/v/hedgehog.svg?style=flat)](http://hackage.haskell.org/package/hedgehog) [![Build Status](https://travis-ci.org/hedgehogqa/haskell-hedgehog.svg?branch=master)](https://travis-ci.org/hedgehogqa/haskell-hedgehog)
+hedgehog [![Hackage][hackage-shield]][hackage] [![Travis][travis-shield]][travis]
 ========
 
 > Hedgehog will eat all your bugs.
@@ -16,3 +16,69 @@
 - Range combinators for full control over the scope of generated numbers and collections.
 - Equality and roundtrip assertions show a diff instead of the two inequal values.
 - Template Haskell test runner which executes properties concurrently.
+
+## Example
+
+The main module, [Hedgehog][haddock-hedgehog], includes almost
+everything you need to get started writing property tests with Hedgehog.
+
+It is designed to be used alongside [Hedgehog.Gen][haddock-hedgehog-gen]
+and [Hedgehog.Range][haddock-hedgehog-range] which should be imported
+qualified. You also need to enable Template Haskell so the Hedgehog test
+runner can find your properties.
+
+```hs
+{-# LANGUAGE TemplateHaskell #-}
+
+import           Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+```
+
+Once you have your imports set up, you can write a simple property:
+
+```hs
+prop_reverse :: Property
+prop_reverse =
+  property $ do
+    xs <- forAll $ Gen.list (Range.linear 0 100) Gen.alpha
+    reverse (reverse xs) === xs
+```
+
+And add the Template Haskell splice which will discover your properties:
+
+```hs
+tests :: IO Bool
+tests =
+  checkParallel $$(discover)
+```
+
+If you prefer to avoid macros, you can specify the group of properties
+to run manually instead:
+
+```hs
+tests :: IO Bool
+tests =
+  checkParallel $ Group "Test.Example" [
+      ("prop_reverse", prop_reverse)
+    ]
+```
+
+You can then load the module in GHCi, and run it:
+
+```
+λ tests
+━━━ Test.Example ━━━
+  ✓ prop_reverse passed 100 tests.
+
+```
+
+ [hackage]: http://hackage.haskell.org/package/hedgehog
+ [hackage-shield]: http://img.shields.io/hackage/v/hedgehog.svg?style=flat
+
+ [travis]: https://travis-ci.org/hedgehogqa/haskell-hedgehog
+ [travis-shield]: https://travis-ci.org/hedgehogqa/haskell-hedgehog.svg?branch=master
+
+ [haddock-hedgehog]: http://hackage.haskell.org/package/hedgehog/docs/Hedgehog.html
+ [haddock-hedgehog-gen]: http://hackage.haskell.org/package/hedgehog/docs/Hedgehog-Gen.html
+ [haddock-hedgehog-range]: http://hackage.haskell.org/package/hedgehog/docs/Hedgehog-Range.html
diff --git a/hedgehog.cabal b/hedgehog.cabal
--- a/hedgehog.cabal
+++ b/hedgehog.cabal
@@ -1,7 +1,7 @@
 name:
   hedgehog
 version:
-  0.1
+  0.2
 license:
   BSD3
 author:
@@ -38,6 +38,7 @@
   , GHC == 8.0.2
 extra-source-files:
   README.md
+  CHANGELOG.md
 
 source-repository head
   type: git
@@ -59,6 +60,7 @@
     , primitive                       >= 0.6        && < 0.7
     , random                          >= 1.1        && < 1.2
     , resourcet                       >= 1.1        && < 1.2
+    , stm                             >= 2.4        && < 2.5
     , template-haskell                >= 2.10       && < 2.12
     , text                            >= 1.1        && < 1.3
     , th-lift                         >= 0.7        && < 0.8
@@ -71,6 +73,10 @@
     build-depends:
       semigroups                      >= 0.16       && < 0.19
 
+  if !os(windows)
+    build-depends:
+      unix                            >= 2.6        && < 2.8
+
   ghc-options:
     -Wall
 
@@ -82,8 +88,11 @@
     Hedgehog.Gen
     Hedgehog.Range
 
+    Hedgehog.Internal.Config
     Hedgehog.Internal.Discovery
     Hedgehog.Internal.Property
+    Hedgehog.Internal.Queue
+    Hedgehog.Internal.Region
     Hedgehog.Internal.Report
     Hedgehog.Internal.Runner
     Hedgehog.Internal.Seed
diff --git a/src/Hedgehog.hs b/src/Hedgehog.hs
--- a/src/Hedgehog.hs
+++ b/src/Hedgehog.hs
@@ -20,20 +20,32 @@
 -- >     xs <- forAll $ Gen.list (Range.linear 0 100) Gen.alpha
 -- >     reverse (reverse xs) === xs
 --
--- And add the Template Haskell splice which will run your properies:
+-- And add the Template Haskell splice which will discover your properties:
 --
 -- > tests :: IO Bool
 -- > tests =
--- >   $$(checkConcurrent)
+-- >   checkParallel $$(discover)
 --
+-- If you prefer to avoid macros, you can specify the group of properties to
+-- run manually instead:
+--
+-- > tests :: IO Bool
+-- > tests =
+-- >   checkParallel $ Group "Test.Example" [
+-- >       ("prop_reverse", prop_reverse)
+-- >     ]
+--
 -- You can then load the module in GHCi, and run it:
 --
--- >>> tests
--- ━━━ Test.Example ━━━
---   ✓ prop_reverse passed 100 tests.
+-- > λ tests
+-- > ━━━ Test.Example ━━━
+-- >   ✓ prop_reverse passed 100 tests.
 --
 module Hedgehog (
-    Property
+    Group(..)
+  , GroupName
+  , Property
+  , PropertyName
   , Test
   , TestLimit
   , DiscardLimit
@@ -51,13 +63,19 @@
   , withShrinks
 
   , check
-  , checkSequential
-  , checkConcurrent
   , recheck
 
+  , discover
+  , checkParallel
+  , checkSequential
+
   -- * Test
   , forAll
-  , info
+  , forAllWith
+  , annotate
+  , annotateShow
+  , footnote
+  , footnoteShow
   , success
   , discard
   , failure
@@ -75,14 +93,16 @@
 import           Hedgehog.Internal.Property (assert, (===))
 import           Hedgehog.Internal.Property (discard, failure, success)
 import           Hedgehog.Internal.Property (DiscardLimit, withDiscards)
-import           Hedgehog.Internal.Property (forAll, info)
+import           Hedgehog.Internal.Property (forAll, forAllWith)
+import           Hedgehog.Internal.Property (annotate, annotateShow)
+import           Hedgehog.Internal.Property (footnote, footnoteShow)
 import           Hedgehog.Internal.Property (liftEither, liftExceptT, withResourceT)
-import           Hedgehog.Internal.Property (Property)
+import           Hedgehog.Internal.Property (Property, PropertyName, Group(..), GroupName)
 import           Hedgehog.Internal.Property (ShrinkLimit, withShrinks)
 import           Hedgehog.Internal.Property (Test, property)
 import           Hedgehog.Internal.Property (TestLimit, withTests)
-import           Hedgehog.Internal.Runner (check, recheck)
+import           Hedgehog.Internal.Runner (check, recheck, checkSequential, checkParallel)
 import           Hedgehog.Internal.Seed (Seed(..))
-import           Hedgehog.Internal.TH (checkSequential, checkConcurrent)
+import           Hedgehog.Internal.TH (discover)
 import           Hedgehog.Internal.Tripping (tripping)
 import           Hedgehog.Range (Range, Size(..))
diff --git a/src/Hedgehog/Gen.hs b/src/Hedgehog/Gen.hs
--- a/src/Hedgehog/Gen.hs
+++ b/src/Hedgehog/Gen.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
@@ -74,6 +73,7 @@
   , bytes
 
   -- ** Choice
+  , constant
   , element
   , choice
   , frequency
@@ -87,6 +87,7 @@
   -- ** Collections
   , maybe
   , list
+  , seq
   , nonEmpty
   , set
   , map
@@ -162,6 +163,8 @@
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.Maybe as Maybe
+import           Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
 import           Data.Set (Set)
 import           Data.Text (Text)
 import qualified Data.Text as Text
@@ -176,7 +179,7 @@
 import           Hedgehog.Range (Size, Range)
 import qualified Hedgehog.Range as Range
 
-import           Prelude hiding (filter, print, maybe, map)
+import           Prelude hiding (filter, print, maybe, map, seq)
 
 
 ------------------------------------------------------------------------
@@ -236,7 +239,7 @@
 --   at the nodes. 'Nothing' means discarded, 'Just' means we have a value.
 --
 runDiscardEffect :: Monad m => Tree (MaybeT m) a -> Tree m (Maybe a)
-runDiscardEffect s = do
+runDiscardEffect s =
   Tree $ do
     mx <- runMaybeT $ runTree s
     case mx of
@@ -768,6 +771,13 @@
 ------------------------------------------------------------------------
 -- Combinators - Choice
 
+-- | Trivial generator that always produces the same element.
+--
+--   /This is another name for 'pure' \/ 'return'./
+constant :: Monad m => a -> Gen m a
+constant =
+  pure
+
 -- | Randomly selects one of the elements in the list.
 --
 --   This generator shrinks towards the first element in the list.
@@ -889,8 +899,7 @@
 -- @
 --
 --   It differs from the above in that we keep some state to avoid looping
---   forever. If we trigger these limits then the whole whole generator is
---   discarded.
+--   forever. If we trigger these limits then the whole generator is discarded.
 --
 filter :: Monad m => (a -> Bool) -> Gen m a -> Gen m a
 filter p gen =
@@ -922,7 +931,7 @@
 -- | Generates a 'Nothing' some of the time.
 --
 maybe :: Monad m => Gen m a -> Gen m (Maybe a)
-maybe gen = do
+maybe gen =
   sized $ \n ->
     frequency [
         (2, pure Nothing)
@@ -940,6 +949,12 @@
       k <- integral_ range
       replicateM k (freeze gen)
 
+-- | Generates a seq using a 'Range' to determine the length.
+--
+seq :: Monad m => Range Int -> Gen m a -> Gen m (Seq a)
+seq range gen =
+  Seq.fromList <$> list range gen
+
 -- | Generates a non-empty list using a 'Range' to determine the length.
 --
 nonEmpty :: Monad m => Range Int -> Gen m a -> Gen m (NonEmpty a)
@@ -1155,7 +1170,7 @@
 sample gen =
   fmap (fmap nodeValue . Maybe.catMaybes) .
   replicateM 10 $ do
-    seed <- liftIO $ Seed.random
+    seed <- liftIO Seed.random
     runMaybeT . runTree $ runGen 30 seed gen
 
 -- | Print the value produced by a generator, and the first level of shrinks,
@@ -1199,7 +1214,7 @@
 --
 print :: (MonadIO m, Show a) => Gen m a -> m ()
 print gen = do
-  seed <- liftIO $ Seed.random
+  seed <- liftIO Seed.random
   printWith 30 seed gen
 
 -- | Run a generator with a random seed and print the resulting shrink tree.
@@ -1221,7 +1236,7 @@
 --
 printTree :: (MonadIO m, Show a) => Gen m a -> m ()
 printTree gen = do
-  seed <- liftIO $ Seed.random
+  seed <- liftIO Seed.random
   printTreeWith 30 seed gen
 
 -- | Render a generator as a tree of strings.
diff --git a/src/Hedgehog/Internal/Config.hs b/src/Hedgehog/Internal/Config.hs
new file mode 100644
--- /dev/null
+++ b/src/Hedgehog/Internal/Config.hs
@@ -0,0 +1,171 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Hedgehog.Internal.Config (
+    UseColor(..)
+  , resolveColor
+
+  , Verbosity(..)
+  , resolveVerbosity
+
+  , WorkerCount(..)
+  , resolveWorkers
+
+  , detectMark
+  , detectColor
+  , detectVerbosity
+  , detectWorkers
+  ) where
+
+import           Control.Monad.IO.Class (MonadIO(..))
+
+import qualified GHC.Conc as Conc
+
+import           Language.Haskell.TH.Lift (deriveLift)
+
+import           System.Console.ANSI (hSupportsANSI)
+import           System.Environment (lookupEnv)
+import           System.IO (stdout)
+
+#if !mingw32_HOST_OS
+import           System.Posix.User (getEffectiveUserName)
+#endif
+
+import           Text.Read (readMaybe)
+
+
+-- | Whether to render output using ANSI colors or not.
+--
+data UseColor =
+    DisableColor
+    -- ^ Disable ANSI colors in report output.
+  | EnableColor
+    -- ^ Enable ANSI colors in report output.
+    deriving (Eq, Ord, Show)
+
+-- | How verbose should the report output be.
+--
+data Verbosity =
+    Quiet
+    -- ^ Only display the summary of the test run.
+  | Normal
+    -- ^ Display each property as it is running, as well as the summary.
+    deriving (Eq, Ord, Show)
+
+-- | The number of workers to use when running properties in parallel.
+--
+newtype WorkerCount =
+  WorkerCount Int
+  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
+
+detectMark :: MonadIO m => m Bool
+detectMark = do
+#if mingw32_HOST_OS
+   pure False
+#else
+   user <- liftIO getEffectiveUserName
+   pure $ user == "mth"
+#endif
+
+lookupBool :: MonadIO m => String -> m (Maybe Bool)
+lookupBool key =
+  liftIO $ do
+    menv <- lookupEnv key
+    case menv of
+      Just "0" ->
+        pure $ Just False
+      Just "no" ->
+        pure $ Just False
+      Just "false" ->
+        pure $ Just False
+
+      Just "1" ->
+        pure $ Just True
+      Just "yes" ->
+        pure $ Just True
+      Just "true" ->
+        pure $ Just True
+
+      _ ->
+        pure Nothing
+
+detectColor :: MonadIO m => m UseColor
+detectColor =
+  liftIO $ do
+    ok <- lookupBool "HEDGEHOG_COLOR"
+    case ok of
+      Just False ->
+        pure DisableColor
+
+      Just True ->
+        pure EnableColor
+
+      Nothing -> do
+        mth <- detectMark
+        if mth then
+          pure DisableColor -- avoid getting fired :)
+        else do
+          enable <- hSupportsANSI stdout
+          if enable then
+            pure EnableColor
+          else
+            pure DisableColor
+
+detectVerbosity :: MonadIO m => m Verbosity
+detectVerbosity =
+  liftIO $ do
+    menv <- (readMaybe =<<) <$> lookupEnv "HEDGEHOG_VERBOSITY"
+    case menv of
+      Just (0 :: Int) ->
+        pure Quiet
+
+      Just (1 :: Int) ->
+        pure Normal
+
+      _ -> do
+        mth <- detectMark
+        if mth then
+          pure Quiet
+        else
+          pure Normal
+
+detectWorkers :: MonadIO m => m WorkerCount
+detectWorkers = do
+  liftIO $ do
+    menv <- (readMaybe =<<) <$> lookupEnv "HEDGEHOG_WORKERS"
+    case menv of
+      Nothing ->
+        WorkerCount <$> Conc.getNumProcessors
+      Just env ->
+        pure $ WorkerCount env
+
+resolveColor :: MonadIO m => Maybe UseColor -> m UseColor
+resolveColor = \case
+  Nothing ->
+    detectColor
+  Just x ->
+    pure x
+
+resolveVerbosity :: MonadIO m => Maybe Verbosity -> m Verbosity
+resolveVerbosity = \case
+  Nothing ->
+    detectVerbosity
+  Just x ->
+    pure x
+
+resolveWorkers :: MonadIO m => Maybe WorkerCount -> m WorkerCount
+resolveWorkers = \case
+  Nothing ->
+    detectWorkers
+  Just x ->
+    pure x
+
+------------------------------------------------------------------------
+-- FIXME Replace with DeriveLift when we drop 7.10 support.
+
+$(deriveLift ''UseColor)
+$(deriveLift ''Verbosity)
+$(deriveLift ''WorkerCount)
diff --git a/src/Hedgehog/Internal/Discovery.hs b/src/Hedgehog/Internal/Discovery.hs
--- a/src/Hedgehog/Internal/Discovery.hs
+++ b/src/Hedgehog/Internal/Discovery.hs
@@ -31,7 +31,7 @@
     } deriving (Eq, Ord, Show)
 
 readProperties :: MonadIO m => FilePath -> m (Map PropertyName PropertySource)
-readProperties path = do
+readProperties path =
   findProperties path <$> liftIO (readFile path)
 
 readDeclaration :: MonadIO m => FilePath -> LineNo -> m (Maybe (String, Pos String))
diff --git a/src/Hedgehog/Internal/Property.hs b/src/Hedgehog/Internal/Property.hs
--- a/src/Hedgehog/Internal/Property.hs
+++ b/src/Hedgehog/Internal/Property.hs
@@ -15,7 +15,6 @@
 module Hedgehog.Internal.Property (
   -- * Property
     Property(..)
-  , GroupName(..)
   , PropertyName(..)
   , PropertyConfig(..)
   , TestLimit(..)
@@ -26,13 +25,21 @@
   , withDiscards
   , withShrinks
 
+  -- * Group
+  , Group(..)
+  , GroupName(..)
+
   -- * Test
   , Test(..)
   , Log(..)
   , Failure(..)
   , Diff(..)
   , forAll
-  , info
+  , forAllWith
+  , annotate
+  , annotateShow
+  , footnote
+  , footnoteShow
   , discard
   , failure
   , success
@@ -69,7 +76,8 @@
 import           Control.Monad.Trans.Writer.Lazy (WriterT(..))
 import           Control.Monad.Writer.Class (MonadWriter(..))
 
-import           Data.Typeable (Typeable, TypeRep, typeOf)
+import           Data.Semigroup (Semigroup)
+import           Data.String (IsString)
 
 import           Hedgehog.Gen (Gen)
 import qualified Hedgehog.Gen as Gen
@@ -96,19 +104,12 @@
       unTest :: ExceptT Failure (WriterT [Log] (Gen m)) a
     } deriving (Functor, Applicative)
 
--- | The name of a group of properties.
---
-newtype GroupName =
-  GroupName {
-      unGroupName :: String
-    } deriving (Eq, Ord, Show)
-
 -- | The name of a property.
 --
 newtype PropertyName =
   PropertyName {
       unPropertyName :: String
-    } deriving (Eq, Ord, Show)
+    } deriving (Eq, Ord, Show, IsString, Semigroup)
 
 -- | Configuration for a property test.
 --
@@ -138,7 +139,22 @@
   DiscardLimit Int
   deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
 
+-- | A named collection of property tests.
 --
+data Group =
+  Group {
+      groupName :: !GroupName
+    , groupProperties :: ![(PropertyName, Property)]
+    }
+
+-- | The name of a group of properties.
+--
+newtype GroupName =
+  GroupName {
+      unGroupName :: String
+    } deriving (Eq, Ord, Show, IsString, Semigroup)
+
+--
 -- FIXME This whole Log/Failure thing could be a lot more structured to allow
 -- FIXME for richer user controlled error messages, think Doc. Ideally we'd
 -- FIXME allow user's to create their own diffs anywhere.
@@ -147,8 +163,8 @@
 -- | Log messages which are recorded during a test run.
 --
 data Log =
-    Info String
-  | Input (Maybe Span) TypeRep String
+    Annotation (Maybe Span) String
+  | Footnote String
     deriving (Eq, Show)
 
 -- | Details on where and why a test failed.
@@ -318,18 +334,50 @@
 
 -- | Generates a random input for the test by running the provided generator.
 --
-forAll :: (Monad m, Show a, Typeable a, HasCallStack) => Gen m a -> Test m a
-forAll gen = do
+forAll :: (Monad m, Show a, HasCallStack) => Gen m a -> Test m a
+forAll gen =
+  withFrozenCallStack $ forAllWith showPretty gen
+
+-- | Generates a random input for the test by running the provided generator.
+--
+--   /This is a the same as 'forAll' but allows the user to provide a custom/
+--   /rendering function. This is useful for values which don't have a/
+--   /'Show' instance./
+--
+forAllWith :: (Monad m, HasCallStack) => (a -> String) -> Gen m a -> Test m a
+forAllWith render gen = do
   x <- Test . lift $ lift gen
-  writeLog $ Input (getCaller callStack) (typeOf x) (showPretty x)
+  withFrozenCallStack $ annotate (render x)
   return x
 
--- | Logs an information message to be displayed if the test fails.
+-- | Annotates the source code with a message that might be useful for
+--   debugging a test failure.
 --
-info :: Monad m => String -> Test m ()
-info =
-  writeLog . Info
+annotate :: (Monad m, HasCallStack) => String -> Test m ()
+annotate x = do
+  writeLog $ Annotation (getCaller callStack) x
 
+-- | Annotates the source code with a value that might be useful for
+--   debugging a test failure.
+--
+annotateShow :: (Monad m, Show a, HasCallStack) => a -> Test m ()
+annotateShow x = do
+  withFrozenCallStack $ annotate (showPretty x)
+
+-- | Logs a message to be displayed as additional information in the footer of
+--   the failure report.
+--
+footnote :: Monad m => String -> Test m ()
+footnote =
+  writeLog . Footnote
+
+-- | Logs a value to be displayed as additional information in the footer of
+--   the failure report.
+--
+footnoteShow :: (Monad m, Show a) => a -> Test m ()
+footnoteShow =
+  writeLog . Footnote . showPretty
+
 -- | Discards a test entirely.
 --
 discard :: Monad m => Test m a
@@ -360,7 +408,7 @@
 assert b =
   if b then
     success
-  else do
+  else
     withFrozenCallStack failure
 
 infix 4 ===
@@ -389,7 +437,7 @@
 --
 liftEither :: (Monad m, Show x, HasCallStack) => Either x a -> Test m a
 liftEither = \case
-  Left x -> do
+  Left x ->
     withFrozenCallStack $ failWith Nothing $ showPretty x
   Right x ->
     pure x
@@ -398,7 +446,7 @@
 --   the 'Right'.
 --
 liftExceptT :: (Monad m, Show x, HasCallStack) => ExceptT x m a -> Test m a
-liftExceptT m = do
+liftExceptT m =
   withFrozenCallStack liftEither =<< lift (runExceptT m)
 
 -- | Run a computation which requires resource acquisition / release.
diff --git a/src/Hedgehog/Internal/Queue.hs b/src/Hedgehog/Internal/Queue.hs
new file mode 100644
--- /dev/null
+++ b/src/Hedgehog/Internal/Queue.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+module Hedgehog.Internal.Queue (
+    TaskIndex(..)
+  , TasksRemaining(..)
+
+  , runTasks
+  , finalizeTask
+ 
+  , runActiveFinalizers
+  , dequeueMVar
+
+  , updateNumCapabilities
+  ) where
+
+import           Control.Concurrent.Async (forConcurrently)
+import           Control.Concurrent.MVar (MVar)
+import qualified Control.Concurrent.MVar as MVar
+import           Control.Monad (when)
+import           Control.Monad.IO.Class (MonadIO(..))
+
+import           Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+
+import qualified GHC.Conc as Conc
+
+import           Hedgehog.Internal.Config
+
+
+newtype TaskIndex =
+  TaskIndex Int
+  deriving (Eq, Ord, Enum, Num)
+
+newtype TasksRemaining =
+  TasksRemaining Int
+
+dequeueMVar ::
+     MVar [(TaskIndex, a)]
+  -> (TasksRemaining -> TaskIndex -> a -> IO b)
+  -> IO (Maybe (TaskIndex, b))
+dequeueMVar mvar start =
+  MVar.modifyMVar mvar $ \case
+    [] ->
+      pure ([], Nothing)
+    (ix, x) : xs -> do
+      y <- start (TasksRemaining $ length xs) ix x
+      pure (xs, Just (ix, y))
+
+runTasks ::
+     WorkerCount
+  -> [a]
+  -> (TasksRemaining -> TaskIndex -> a -> IO b)
+  -> (b -> IO ())
+  -> (b -> IO ())
+  -> (b -> IO c)
+  -> IO [c]
+runTasks n tasks start finish finalize runTask = do
+  qvar <- MVar.newMVar (zip [0..] tasks)
+  fvar <- MVar.newMVar (-1, Map.empty)
+
+  let
+    worker rs = do
+      mx <- dequeueMVar qvar start
+      case mx of
+        Nothing ->
+          pure rs
+        Just (ix, x) -> do
+          r <- runTask x
+          finish x
+          finalizeTask fvar ix (finalize x)
+          worker (r : rs)
+
+  -- FIXME ensure all workers have finished running
+  fmap concat . forConcurrently [1..max 1 n] $ \_ix ->
+    worker []
+
+runActiveFinalizers ::
+     MonadIO m
+  => MVar (TaskIndex, Map TaskIndex (IO ()))
+  -> m ()
+runActiveFinalizers mvar =
+  liftIO $ do
+    again <-
+      MVar.modifyMVar mvar $ \original@(minIx, finalizers0) ->
+        case Map.minViewWithKey finalizers0 of
+          Nothing ->
+            pure (original, False)
+
+          Just ((ix, finalize), finalizers) ->
+            if ix == minIx + 1 then do
+              finalize
+              pure ((ix, finalizers), True)
+            else
+              pure (original, False)
+
+    when again $
+      runActiveFinalizers mvar
+
+finalizeTask ::
+     MonadIO m
+  => MVar (TaskIndex, Map TaskIndex (IO ()))
+  -> TaskIndex
+  -> IO ()
+  -> m ()
+finalizeTask mvar ix finalize = do
+  liftIO . MVar.modifyMVar_ mvar $ \(minIx, finalizers) ->
+    pure (minIx, Map.insert ix finalize finalizers)
+  runActiveFinalizers mvar
+
+-- | Update the number of capabilities but never set it lower than it already
+--   is.
+--
+updateNumCapabilities :: WorkerCount -> IO ()
+updateNumCapabilities (WorkerCount n) = do
+  ncaps <- Conc.getNumCapabilities
+  Conc.setNumCapabilities (max n ncaps)
diff --git a/src/Hedgehog/Internal/Region.hs b/src/Hedgehog/Internal/Region.hs
new file mode 100644
--- /dev/null
+++ b/src/Hedgehog/Internal/Region.hs
@@ -0,0 +1,110 @@
+module Hedgehog.Internal.Region (
+    Region(..)
+  , newEmptyRegion
+  , newRegion
+  , forceRegion
+  , setRegion
+  , displayRegions
+  , displayRegion
+  , moveToBottom
+  , finishRegion
+  ) where
+
+import           Control.Concurrent.STM (STM, TVar, atomically)
+import qualified Control.Concurrent.STM.TMVar as TMVar
+import qualified Control.Concurrent.STM.TVar as TVar
+import           Control.Monad.Catch (MonadMask(..), bracket)
+import           Control.Monad.IO.Class (MonadIO(..))
+
+import           System.Console.Regions (ConsoleRegion, RegionLayout(..), LiftRegion(..))
+import qualified System.Console.Regions as Console
+
+
+newtype Region =
+  Region {
+      unRegion :: TVar (Maybe ConsoleRegion)
+    }
+
+newEmptyRegion :: LiftRegion m => m Region
+newEmptyRegion =
+  liftRegion $ do
+    ref <- TVar.newTVar Nothing
+    pure $ Region ref
+
+newRegion :: LiftRegion m => m Region
+newRegion =
+  liftRegion $ do
+    region <- Console.openConsoleRegion Linear
+    ref <- TVar.newTVar $ Just region
+    pure $ Region ref
+
+forceRegion :: LiftRegion m => Region -> String -> m ()
+forceRegion (Region var) content =
+  liftRegion $ do
+    mregion <- TVar.readTVar var
+    case mregion of
+      Nothing -> do
+        region <- Console.openConsoleRegion Linear
+        TVar.writeTVar var $ Just region
+        Console.setConsoleRegion region content
+
+      Just region ->
+        Console.setConsoleRegion region content
+
+setRegion :: LiftRegion m => Region -> String -> m ()
+setRegion (Region var) content =
+  liftRegion $ do
+    mregion <- TVar.readTVar var
+    case mregion of
+      Nothing -> do
+        pure ()
+
+      Just region ->
+        Console.setConsoleRegion region content
+
+displayRegions :: (MonadIO m, MonadMask m) => m a -> m a
+displayRegions io = do
+  liftIO . atomically $ do
+    -- clear old regions
+    mxs <- TMVar.tryTakeTMVar Console.regionList
+    case mxs of
+      Nothing ->
+        pure ()
+      Just _xs ->
+        TMVar.putTMVar Console.regionList []
+
+  Console.displayConsoleRegions io
+
+displayRegion ::
+     MonadIO m
+  => MonadMask m
+  => LiftRegion m
+  => (Region -> m a)
+  -> m a
+displayRegion =
+  displayRegions . bracket newRegion finishRegion
+
+moveToBottom :: ConsoleRegion -> STM ()
+moveToBottom region = do
+  mxs <- TMVar.tryTakeTMVar Console.regionList
+  case mxs of
+    Nothing ->
+      pure ()
+    Just xs0 ->
+      let
+        xs1 =
+          filter (/= region) xs0
+      in
+        TMVar.putTMVar Console.regionList (region : xs1)
+
+finishRegion :: LiftRegion m => Region -> m ()
+finishRegion (Region var) =
+  liftRegion $ do
+    mregion <- TVar.readTVar var
+    case mregion of
+      Nothing ->
+        pure ()
+
+      Just region -> do
+        content <- Console.getConsoleRegion region
+        Console.finishConsoleRegion region content
diff --git a/src/Hedgehog/Internal/Report.hs b/src/Hedgehog/Internal/Report.hs
--- a/src/Hedgehog/Internal/Report.hs
+++ b/src/Hedgehog/Internal/Report.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DoAndIfThenElse #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
@@ -6,21 +8,31 @@
 {-# LANGUAGE TupleSections #-}
 module Hedgehog.Internal.Report (
   -- * Report
-    Report(..)
-  , Status(..)
+    Summary(..)
+  , Report(..)
+  , Progress(..)
+  , Result(..)
   , FailureReport(..)
-  , FailedInput(..)
+  , FailedAnnotation(..)
 
-  , ShrinkCount
-  , TestCount
-  , DiscardCount
+  , ShrinkCount(..)
+  , TestCount(..)
+  , DiscardCount(..)
+  , PropertyCount(..)
 
   , Style(..)
   , Markup(..)
 
-  , renderReport
-  , ppReport
+  , renderProgress
+  , renderResult
+  , renderSummary
+  , renderDoc
 
+  , ppProgress
+  , ppResult
+  , ppSummary
+
+  , fromResult
   , mkFailure
   ) where
 
@@ -36,8 +48,8 @@
 import qualified Data.Map as Map
 import           Data.Maybe (mapMaybe, catMaybes)
 import           Data.Semigroup (Semigroup(..))
-import           Data.Typeable (TypeRep)
 
+import           Hedgehog.Internal.Config
 import           Hedgehog.Internal.Discovery (Pos(..), Position(..))
 import qualified Hedgehog.Internal.Discovery as Discovery
 import           Hedgehog.Internal.Property (PropertyName(..), Log(..), Diff(..))
@@ -48,10 +60,8 @@
 
 import           System.Console.ANSI (ColorIntensity(..), Color(..))
 import           System.Console.ANSI (ConsoleLayer(..), ConsoleIntensity(..))
-import           System.Console.ANSI (SGR(..), setSGRCode, hSupportsANSI)
+import           System.Console.ANSI (SGR(..), setSGRCode)
 import           System.Directory (makeRelativeToCurrentDirectory)
-import           System.Environment (lookupEnv)
-import           System.IO (stdout)
 
 import           Text.PrettyPrint.Annotated.WL (Doc, (<+>))
 import qualified Text.PrettyPrint.Annotated.WL as WL
@@ -78,10 +88,15 @@
   DiscardCount Int
   deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
 
-data FailedInput =
-  FailedInput {
+-- | The number of properties in a group.
+--
+newtype PropertyCount =
+  PropertyCount Int
+  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
+
+data FailedAnnotation =
+  FailedAnnotation {
       failedSpan :: !(Maybe Span)
-    , failedType :: !TypeRep
     , failedValue :: !String
     } deriving (Eq, Show)
 
@@ -90,36 +105,83 @@
       failureSize :: !Size
     , failureSeed :: !Seed
     , failureShrinks :: !ShrinkCount
-    , failureInputs :: ![FailedInput]
+    , failureAnnotations :: ![FailedAnnotation]
     , failureLocation :: !(Maybe Span)
     , failureMessage :: !String
     , failureDiff :: !(Maybe Diff)
-    , failureMessages :: ![String]
+    , failureFootnotes :: ![String]
     } deriving (Eq, Show)
 
--- | The status of a property test run.
+-- | The status of a running property test.
 --
+data Progress =
+    Running
+  | Shrinking !FailureReport
+    deriving (Eq, Show)
+
+-- | The status of a completed property test.
+--
 --   In the case of a failure it provides the seed used for the test, the
 --   number of shrinks, and the execution log.
 --
-data Status =
-    Waiting
-  | Running
-  | Shrinking !FailureReport
-  | Failed !FailureReport
+data Result =
+    Failed !FailureReport
   | GaveUp
   | OK
     deriving (Eq, Show)
 
--- | The report from a property test run.
+-- | A report on a running or completed property test.
 --
-data Report =
+data Report a =
   Report {
       reportTests :: !TestCount
     , reportDiscards :: !DiscardCount
-    , reportStatus :: !Status
+    , reportStatus :: !a
+    } deriving (Show, Functor, Foldable, Traversable)
+
+-- | A summary of all the properties executed.
+--
+data Summary =
+  Summary {
+      summaryWaiting :: !PropertyCount
+    , summaryRunning :: !PropertyCount
+    , summaryFailed :: !PropertyCount
+    , summaryGaveUp :: !PropertyCount
+    , summaryOK :: !PropertyCount
     } deriving (Show)
 
+instance Monoid Summary where
+  mempty =
+    Summary 0 0 0 0 0
+  mappend (Summary x1 x2 x3 x4 x5) (Summary y1 y2 y3 y4 y5) =
+    Summary
+      (x1 + y1)
+      (x2 + y2)
+      (x3 + y3)
+      (x4 + y4)
+      (x5 + y5)
+
+instance Semigroup Summary
+
+-- | Construct a summary from a single result.
+--
+fromResult :: Result -> Summary
+fromResult = \case
+  Failed _ ->
+    mempty { summaryFailed = 1 }
+  GaveUp ->
+    mempty { summaryGaveUp = 1 }
+  OK ->
+    mempty { summaryOK = 1 }
+
+summaryCompleted :: Summary -> PropertyCount
+summaryCompleted (Summary _ _ x3 x4 x5) =
+  x3 + x4 + x5
+
+summaryTotal :: Summary -> PropertyCount
+summaryTotal (Summary x1 x2 x3 x4 x5) =
+  x1 + x2 + x3 + x4 + x5
+
 ------------------------------------------------------------------------
 -- Pretty Printing Helpers
 
@@ -139,8 +201,8 @@
     } deriving (Eq, Ord, Show, Functor)
 
 data Style =
-    StyleInfo
-  | StyleInput
+    StyleDefault
+  | StyleAnnotation
   | StyleFailure
     deriving (Eq, Ord, Show)
 
@@ -161,8 +223,8 @@
   | StyledLineNo !Style
   | StyledBorder !Style
   | StyledSource !Style
-  | InputGutter
-  | InputValue
+  | AnnotationGutter
+  | AnnotationValue
   | FailureArrows
   | FailureGutter
   | FailureMessage
@@ -184,25 +246,25 @@
         StyleFailure
       (_, StyleFailure) ->
         StyleFailure
-      (StyleInput, _) ->
-        StyleInput
-      (_, StyleInput) ->
-        StyleInput
-      (StyleInfo, _) ->
-        StyleInfo
+      (StyleAnnotation, _) ->
+        StyleAnnotation
+      (_, StyleAnnotation) ->
+        StyleAnnotation
+      (StyleDefault, _) ->
+        StyleDefault
 
 ------------------------------------------------------------------------
 
-takeInput :: Log -> Maybe FailedInput
-takeInput = \case
-  Input loc typ val ->
-    Just $ FailedInput loc typ val
+takeAnnotation :: Log -> Maybe FailedAnnotation
+takeAnnotation = \case
+  Annotation loc val ->
+    Just $ FailedAnnotation loc val
   _ ->
     Nothing
 
-takeInfo :: Log -> Maybe String
-takeInfo = \case
-  Info x ->
+takeFootnote :: Log -> Maybe String
+takeFootnote = \case
+  Footnote x ->
     Just x
   _ ->
     Nothing
@@ -219,12 +281,12 @@
 mkFailure size seed shrinks location message diff logs =
   let
     inputs =
-      mapMaybe takeInput logs
+      mapMaybe takeAnnotation logs
 
-    info =
-      mapMaybe takeInfo logs
+    footnotes =
+      mapMaybe takeFootnote logs
   in
-    FailureReport size seed shrinks inputs location message diff info
+    FailureReport size seed shrinks inputs location message diff footnotes
 
 ------------------------------------------------------------------------
 -- Pretty Printing
@@ -266,6 +328,10 @@
   ShrinkCount n ->
     ppShow n <+> "shrinks"
 
+ppRawPropertyCount :: PropertyCount -> Doc a
+ppRawPropertyCount (PropertyCount n) =
+  ppShow n
+
 ppWithDiscardCount :: DiscardCount -> Doc Markup
 ppWithDiscardCount = \case
   DiscardCount 0 ->
@@ -340,7 +406,7 @@
 
 defaultStyle :: Declaration a -> Declaration (Style, [(Style, Doc Markup)])
 defaultStyle =
-  fmap $ const (StyleInfo, [])
+  fmap $ const (StyleDefault, [])
 
 lastLineSpan :: Monad m => Span -> Declaration a -> MaybeT m (ColumnNo, ColumnNo)
 lastLineSpan sloc decl =
@@ -351,19 +417,18 @@
       pure $
         lineSpan x
 
-ppFailedInputTypedArgument :: Int -> FailedInput -> Doc Markup
-ppFailedInputTypedArgument ix (FailedInput _ typ val) =
+ppFailedInputTypedArgument :: Int -> FailedAnnotation -> Doc Markup
+ppFailedInputTypedArgument ix (FailedAnnotation _ val) =
   WL.vsep [
-      WL.text "forAll" <> ppShow ix <+> "::" <+> ppShow typ
-    , WL.text "forAll" <> ppShow ix <+> "="
-    , WL.indent 2 . WL.vsep . fmap (markup InputValue . WL.text) $ lines val
+      WL.text "forAll" <> ppShow ix <+> "="
+    , WL.indent 2 . WL.vsep . fmap (markup AnnotationValue . WL.text) $ lines val
     ]
 
 ppFailedInputDeclaration ::
      MonadIO m
-  => FailedInput
+  => FailedAnnotation
   -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
-ppFailedInputDeclaration (FailedInput msloc _ val) =
+ppFailedInputDeclaration (FailedAnnotation msloc val) =
   runMaybeT $ do
     sloc <- MaybeT $ pure msloc
     decl <- fmap defaultStyle . MaybeT $ readDeclaration sloc
@@ -372,12 +437,12 @@
     let
       ppValLine =
         WL.indent startCol .
-          (markup InputGutter (WL.text "│ ") <>) .
-          markup InputValue .
+          (markup AnnotationGutter (WL.text "│ ") <>) .
+          markup AnnotationValue .
           WL.text
 
       valDocs =
-        fmap ((StyleInput, ) . ppValLine) $
+        fmap ((StyleAnnotation, ) . ppValLine) $
         List.lines val
 
       startLine =
@@ -387,7 +452,7 @@
         fromIntegral $ spanEndLine sloc
 
       styleInput kvs =
-        foldr (Map.adjust . fmap . first $ const StyleInput) kvs [startLine..endLine]
+        foldr (Map.adjust . fmap . first $ const StyleAnnotation) kvs [startLine..endLine]
 
       insertDoc =
         Map.adjust (fmap . second $ const valDocs) endLine
@@ -398,7 +463,7 @@
 ppFailedInput ::
      MonadIO m
   => Int
-  -> FailedInput
+  -> FailedAnnotation
   -> m (Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
 ppFailedInput ix input = do
   mdecl <- ppFailedInputDeclaration input
@@ -488,9 +553,9 @@
       let
         ppLocation =
           WL.indent (digits + 1) $
-            markup (StyledBorder StyleInfo) "┏━━" <+>
+            markup (StyledBorder StyleDefault) "┏━━" <+>
             markup DeclarationLocation (WL.text (declarationFile decl)) <+>
-            markup (StyledBorder StyleInfo) "━━━"
+            markup (StyledBorder StyleDefault) "━━━"
 
         digits =
           length . show . unLineNo $ lineNumber lastLine
@@ -601,14 +666,10 @@
   Just (PropertyName name) ->
     WL.text name
 
-ppReport :: MonadIO m => Maybe PropertyName -> Report -> m (Doc Markup)
-ppReport name (Report tests discards status) =
+ppProgress :: MonadIO m => Maybe PropertyName -> Report Progress -> m (Doc Markup)
+ppProgress name (Report tests discards status) =
   case status of
-    Waiting -> do
-      pure . icon WaitingIcon '○' . WL.annotate WaitingHeader $
-        ppName name
-
-    Running -> do
+    Running ->
       pure . icon RunningIcon '●' . WL.annotate RunningHeader $
         ppName name <+>
         "passed" <+>
@@ -616,7 +677,7 @@
         ppWithDiscardCount discards <+>
         "(running)"
 
-    Shrinking failure -> do
+    Shrinking failure ->
       pure . icon ShrinkingIcon '↯' . WL.annotate ShrinkingHeader $
         ppName name <+>
         "failed after" <+>
@@ -624,6 +685,9 @@
         ppShrinkDiscard (failureShrinks failure) discards <+>
         "(shrinking)"
 
+ppResult :: MonadIO m => Maybe PropertyName -> Report Result -> m (Doc Markup)
+ppResult name (Report tests discards result) =
+  case result of
     Failed failure -> do
       pfailure <- ppFailureReport name failure
       pure . WL.vsep $ [
@@ -637,6 +701,7 @@
         , pfailure
         , mempty
         ]
+
     GaveUp ->
       pure . icon GaveUpIcon '⚐' . WL.annotate GaveUpHeader $
         ppName name <+>
@@ -645,6 +710,7 @@
         ", passed" <+>
         ppTestCount tests <>
         "."
+
     OK ->
       pure . icon SuccessIcon '✓' . WL.annotate SuccessHeader $
         ppName name <+>
@@ -652,35 +718,68 @@
         ppTestCount tests <>
         "."
 
-useColor :: MonadIO m => m Bool
-useColor =
-  liftIO $ do
-    menv <- lookupEnv "HEDGEHOG_COLOR"
-    case menv of
-      Just "0" ->
-        pure False
-      Just "no" ->
-        pure False
-      Just "false" ->
-        pure False
+ppWhenNonZero :: Doc a -> PropertyCount -> Maybe (Doc a)
+ppWhenNonZero suffix n =
+  if n <= 0 then
+    Nothing
+  else
+    Just $ ppRawPropertyCount n <+> suffix
 
-      Just "1" ->
-        pure True
-      Just "yes" ->
-        pure True
-      Just "true" ->
-        pure True
+annotateSummary :: Summary -> Doc Markup -> Doc Markup
+annotateSummary summary =
+  if summaryFailed summary > 0 then
+    icon FailedIcon '✗' . WL.annotate FailedHeader
+  else if summaryGaveUp summary > 0 then
+    icon GaveUpIcon '⚐' . WL.annotate GaveUpHeader
+  else if summaryWaiting summary > 0 || summaryRunning summary > 0 then
+    icon WaitingIcon '○' . WL.annotate WaitingHeader
+  else
+    icon SuccessIcon '✓' . WL.annotate SuccessHeader
 
-      Just _ ->
-        hSupportsANSI stdout
-      Nothing ->
-        hSupportsANSI stdout
+ppSummary :: MonadIO m => Summary -> m (Doc Markup)
+ppSummary summary =
+  let
+    complete =
+      summaryCompleted summary == summaryTotal summary
 
-renderReport :: MonadIO m => Maybe PropertyName -> Report -> m String
-renderReport name x = do
-  doc <- ppReport name x
-  color <- useColor
+    prefix end =
+      if complete then
+        mempty
+      else
+        ppRawPropertyCount (summaryCompleted summary) <>
+        "/" <>
+        ppRawPropertyCount (summaryTotal summary) <+>
+        "complete" <> end
 
+    addPrefix xs =
+      if null xs then
+        prefix mempty : []
+      else
+        prefix ": " : xs
+
+    suffix =
+      if complete then
+        "."
+      else
+        " (running)"
+  in
+    pure .
+      annotateSummary summary .
+      (<> suffix) .
+      WL.hcat .
+      addPrefix .
+      WL.punctuate ", " $
+      catMaybes [
+          ppWhenNonZero "failed" (summaryFailed summary)
+        , ppWhenNonZero "gave up" (summaryGaveUp summary)
+        , if complete then
+            ppWhenNonZero "succeeded" (summaryOK summary)
+          else
+            Nothing
+        ]
+
+renderDoc :: MonadIO m => Maybe UseColor -> Doc Markup -> m String
+renderDoc mcolor doc = do
   let
     dull =
       SetColor Foreground Dull
@@ -720,22 +819,22 @@
       DeclarationLocation ->
         setSGRCode []
 
-      StyledLineNo StyleInfo ->
+      StyledLineNo StyleDefault ->
         setSGRCode []
-      StyledSource StyleInfo ->
+      StyledSource StyleDefault ->
         setSGRCode []
-      StyledBorder StyleInfo ->
+      StyledBorder StyleDefault ->
         setSGRCode []
 
-      StyledLineNo StyleInput ->
+      StyledLineNo StyleAnnotation ->
         setSGRCode [dull Magenta]
-      StyledSource StyleInput ->
+      StyledSource StyleAnnotation ->
         setSGRCode []
-      StyledBorder StyleInput ->
+      StyledBorder StyleAnnotation ->
         setSGRCode []
-      InputGutter ->
+      AnnotationGutter ->
         setSGRCode [dull Magenta]
-      InputValue ->
+      AnnotationValue ->
         setSGRCode [dull Magenta]
 
       StyledLineNo StyleFailure ->
@@ -774,13 +873,29 @@
     end _ =
       setSGRCode [Reset]
 
+  color <- resolveColor mcolor
+
+  let
     display =
-      if color then
-        WL.displayDecorated start end id
-      else
-        WL.display
+      case color of
+        EnableColor ->
+          WL.displayDecorated start end id
+        DisableColor ->
+          WL.display
 
   pure .
     display .
     WL.renderSmart 100 $
     WL.indent 2 doc
+
+renderProgress :: MonadIO m => Maybe UseColor -> Maybe PropertyName -> Report Progress -> m String
+renderProgress mcolor name x =
+  renderDoc mcolor =<< ppProgress name x
+
+renderResult :: MonadIO m => Maybe UseColor -> Maybe PropertyName -> Report Result -> m String
+renderResult mcolor name x =
+  renderDoc mcolor =<< ppResult name x
+
+renderSummary :: MonadIO m => Maybe UseColor -> Summary -> m String
+renderSummary mcolor x =
+  renderDoc mcolor =<< ppSummary x
diff --git a/src/Hedgehog/Internal/Runner.hs b/src/Hedgehog/Internal/Runner.hs
--- a/src/Hedgehog/Internal/Runner.hs
+++ b/src/Hedgehog/Internal/Runner.hs
@@ -1,63 +1,69 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Hedgehog.Internal.Runner (
-  -- * Runner
-    RunnerConfig(..)
-  , check
-  , checkGroupWith
+  -- * Running Individual Properties
+    check
   , recheck
 
+  -- * Running Groups of Properties
+  , RunnerConfig(..)
+  , checkParallel
+  , checkSequential
+  , checkGroup
+
   -- * Internal
   , checkReport
-  , checkConsoleRegion
+  , checkRegion
   , checkNamed
   ) where
 
-import           Control.Concurrent.Async (forConcurrently)
-import           Control.Concurrent.MVar (MVar)
-import qualified Control.Concurrent.MVar as MVar
-import qualified Control.Concurrent.QSem as QSem
-import           Control.Monad (when)
-import           Control.Monad.Catch (MonadMask(..), MonadCatch(..), catchAll, bracket)
+import           Control.Concurrent.STM (TVar, atomically)
+import qualified Control.Concurrent.STM.TVar as TVar
+import           Control.Monad.Catch (MonadCatch(..), catchAll)
 import           Control.Monad.IO.Class (MonadIO(..))
 
-import           Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import           Data.Traversable (for)
-
-import qualified GHC.Conc as Conc
+import           Data.Semigroup ((<>))
 
 import           Hedgehog.Gen (runGen)
 import qualified Hedgehog.Gen as Gen
+import           Hedgehog.Internal.Config
+import           Hedgehog.Internal.Property (Group(..), GroupName(..))
+import           Hedgehog.Internal.Property (Property(..), PropertyConfig(..), PropertyName(..))
+import           Hedgehog.Internal.Property (ShrinkLimit, withTests)
+import           Hedgehog.Internal.Property (Test, Log(..), Failure(..), runTest)
+import           Hedgehog.Internal.Queue
+import           Hedgehog.Internal.Region
 import           Hedgehog.Internal.Report
 import           Hedgehog.Internal.Seed (Seed)
 import qualified Hedgehog.Internal.Seed as Seed
 import           Hedgehog.Internal.Tree (Tree(..), Node(..))
-import           Hedgehog.Internal.Property (PropertyName(..), GroupName(..))
-import           Hedgehog.Internal.Property (Test, Log(..), Failure(..), runTest)
-import           Hedgehog.Internal.Property (Property(..), PropertyConfig(..))
-import           Hedgehog.Internal.Property (ShrinkLimit, withTests)
 import           Hedgehog.Range (Size)
 
 import           Language.Haskell.TH.Lift (deriveLift)
 
-import           System.Console.Regions (ConsoleRegion, RegionLayout(..), LiftRegion)
+import           System.Console.Regions (ConsoleRegion, RegionLayout(..))
 import qualified System.Console.Regions as Console
-import           System.Environment (lookupEnv)
 
-import           Text.Read (readMaybe)
 
-
 -- | Configuration for a property test run.
 --
 data RunnerConfig =
   RunnerConfig {
       -- | The number of property tests to run concurrently. 'Nothing' means
       --   use one worker per processor.
-      runnerWorkers :: !(Maybe Int)
+      runnerWorkers :: !(Maybe WorkerCount)
+
+      -- | Whether to use colored output or not. 'Nothing' means detect from
+      --   the environment.
+    , runnerColor :: !(Maybe UseColor)
+
+      -- | How verbose to be in the runner output. 'Nothing' means detect from
+      --   the environment.
+    , runnerVerbosity :: !(Maybe Verbosity)
     } deriving (Eq, Ord, Show)
 
 findM :: Monad m => [a] -> b -> (a -> m (Maybe b)) -> m b
@@ -86,9 +92,9 @@
   -> Seed
   -> ShrinkCount
   -> ShrinkLimit
-  -> (Status -> m ())
+  -> (Progress -> m ())
   -> Node m (Maybe (Either Failure (), [Log]))
-  -> m Status
+  -> m Result
 takeSmallest size seed shrinks slimit updateUI = \case
   Node Nothing _ ->
     pure GaveUp
@@ -124,14 +130,14 @@
   -> Size
   -> Seed
   -> Test m ()
-  -> (Report -> m ())
-  -> m Report
+  -> (Report Progress -> m ())
+  -> m (Report Result)
 checkReport cfg size0 seed0 test0 updateUI =
   let
     test =
       catchAll test0 (fail . show)
 
-    loop :: TestCount -> DiscardCount -> Size -> Seed -> m Report
+    loop :: TestCount -> DiscardCount -> Size -> Seed -> m (Report Result)
     loop !tests !discards !size !seed = do
       updateUI $ Report tests discards Running
 
@@ -175,37 +181,54 @@
   in
     loop 0 0 size0 seed0
 
-checkConsoleRegion ::
+checkRegion ::
      MonadIO m
-  => ConsoleRegion
+  => Region
+  -> Maybe UseColor
   -> Maybe PropertyName
   -> Size
   -> Seed
   -> Property
-  -> m Report
-checkConsoleRegion region name size seed prop =
+  -> m (Report Result)
+checkRegion region mcolor name size seed prop =
   liftIO $ do
-    report <-
-      checkReport (propertyConfig prop) size seed (propertyTest prop) $ \report -> do
-        setRegionReport region name report
+    result <-
+      checkReport (propertyConfig prop) size seed (propertyTest prop) $ \progress -> do
+        ppprogress <- renderProgress mcolor name progress
+        case reportStatus progress of
+          Running ->
+            setRegion region ppprogress
+          Shrinking _ ->
+            forceRegion region ppprogress
 
-    setRegionReport region name report
+    ppresult <- renderResult mcolor name result
+    case reportStatus result of
+      Failed _ ->
+        forceRegion region ppresult
+      GaveUp ->
+        forceRegion region ppresult
+      OK ->
+        setRegion region ppresult
 
-    pure report
+    pure result
 
-checkNamed :: MonadIO m => ConsoleRegion -> Maybe PropertyName -> Property -> m Bool
-checkNamed region name prop = do
+checkNamed ::
+     MonadIO m
+  => Region
+  -> Maybe UseColor
+  -> Maybe PropertyName
+  -> Property
+  -> m (Report Result)
+checkNamed region mcolor name prop = do
   seed <- liftIO Seed.random
-  report <- checkConsoleRegion region name 0 seed prop
-  pure $
-    reportStatus report == OK
+  checkRegion region mcolor name 0 seed prop
 
 -- | Check a property.
 --
 check :: MonadIO m => Property -> m Bool
-check prop = do
+check prop =
   liftIO . displayRegion $ \region ->
-    checkNamed region Nothing prop
+    (== OK) . reportStatus <$> checkNamed region Nothing Nothing prop
 
 -- | Check a property using a specific size and seed.
 --
@@ -213,125 +236,151 @@
 recheck size seed prop0 = do
   let prop = withTests 1 prop0
   _ <- liftIO . displayRegion $ \region ->
-    checkConsoleRegion region Nothing size seed prop
+    checkRegion region Nothing Nothing size seed prop
   pure ()
 
 -- | Check a group of properties using the specified runner config.
 --
-checkGroupWith ::
-     MonadIO m
-  => RunnerConfig
-  -> GroupName
-  -> [(PropertyName, Property)]
-  -> m Bool
-checkGroupWith config group props0 =
+checkGroup :: MonadIO m => RunnerConfig -> Group -> m Bool
+checkGroup config (Group group props) =
   liftIO $ do
-    n <- maybe getNumWorkers pure (runnerWorkers config)
+    n <- resolveWorkers (runnerWorkers config)
 
-    -- ensure one spare capability for concurrent-output, it's likely that our
-    -- tests will saturate all the capabilities they're given.
-    updateNumCapabilities (n + 1)
+    -- ensure few spare capabilities for concurrent-output, it's likely that
+    -- our tests will saturate all the capabilities they're given.
+    updateNumCapabilities (n + 2)
 
     putStrLn $ "━━━ " ++ unGroupName group ++ " ━━━"
-    Console.displayConsoleRegions $ do
-      mvar <- MVar.newMVar (-1, Map.empty)
 
-      props <-
-        fmap (zip [0..]) . for props0 $ \(name, p) -> do
-          region <- Console.openConsoleRegion Linear
-          setRegionReport region (Just name) $ Report 0 0 Waiting
-          pure (name, p, region)
+    verbosity <- resolveVerbosity (runnerVerbosity config)
+    summary <- checkGroupWith n verbosity (runnerColor config) props
 
-      qsem <- QSem.newQSem n
+    pure $
+      summaryFailed summary == 0 &&
+      summaryGaveUp summary == 0
 
-      results <-
-        forConcurrently props $ \(ix, (name, p, region)) ->
-          bracket (QSem.waitQSem qsem) (const $ QSem.signalQSem qsem) $ \_ -> do
-            ok <- checkNamed region (Just name) p
-            finishIndexedRegion mvar ix region
-            pure ok
+updateSummary :: ConsoleRegion -> TVar Summary -> Maybe UseColor -> (Summary -> Summary) -> IO ()
+updateSummary sregion svar mcolor f = do
+  summary <- atomically (TVar.modifyTVar' svar f >> TVar.readTVar svar)
+  Console.setConsoleRegion sregion =<< renderSummary mcolor summary
 
-      pure $
-        and results
+checkGroupWith ::
+     WorkerCount
+  -> Verbosity
+  -> Maybe UseColor
+  -> [(PropertyName, Property)]
+  -> IO Summary
+checkGroupWith n verbosity mcolor props =
+  displayRegions $ do
+    sregion <- Console.openConsoleRegion Linear
+    svar <- atomically . TVar.newTVar $ mempty { summaryWaiting = PropertyCount (length props) }
 
-------------------------------------------------------------------------
--- concurrent-output utils
+    let
+      start (TasksRemaining tasks) _ix (name, prop) =
+        liftIO $ do
+          updateSummary sregion svar mcolor $ \x -> x {
+              summaryWaiting =
+                PropertyCount tasks
+            , summaryRunning =
+                summaryRunning x + 1
+            }
 
-displayRegion ::
-     MonadIO m
-  => MonadMask m
-  => LiftRegion m
-  => (ConsoleRegion -> m a)
-  -> m a
-displayRegion =
-  Console.displayConsoleRegions .
-  bracket (Console.openConsoleRegion Linear) finishRegion
+          atomically $ do
+            region <-
+              case verbosity of
+                Quiet ->
+                  newEmptyRegion
+                Normal ->
+                  newRegion
 
-setRegionReport ::
-     MonadIO m
-  => LiftRegion m
-  => ConsoleRegion
-  -> Maybe PropertyName
-  -> Report
-  -> m ()
-setRegionReport region name report = do
-  content <- renderReport name report
-  Console.setConsoleRegion region content
+            moveToBottom sregion
 
-finishRegion :: (Monad m, LiftRegion m) => ConsoleRegion -> m ()
-finishRegion region = do
-  content <- Console.getConsoleRegion region
-  Console.finishConsoleRegion region content
+            pure (name, prop, region)
 
-flushRegions ::
-     MonadIO m
-  => MVar (Int, Map Int ConsoleRegion)
-  -> m ()
-flushRegions mvar =
-  liftIO $ do
-    again <-
-      MVar.modifyMVar mvar $ \original@(minIx, regions0) ->
-        case Map.minViewWithKey regions0 of
-          Nothing ->
-            pure (original, False)
+      finish (_name, _prop, _region) =
+        updateSummary sregion svar mcolor $ \x -> x {
+            summaryRunning =
+              summaryRunning x - 1
+          }
 
-          Just ((ix, region), regions) ->
-            if ix == minIx + 1 then do
-              finishRegion region
-              pure ((ix, regions), True)
-            else
-              pure (original, False)
+      finalize (_name, _prop, region) =
+        finishRegion region
 
-    when again $
-      flushRegions mvar
+    summary <-
+      fmap (mconcat . fmap (fromResult . reportStatus)) $
+        runTasks n props start finish finalize $ \(name, prop, region) -> do
+          result <- checkNamed region mcolor (Just name) prop
+          updateSummary sregion svar mcolor
+            (<> fromResult (reportStatus result))
+          pure result
 
-finishIndexedRegion ::
-     MonadIO m
-  => MVar (Int, Map Int ConsoleRegion)
-  -> Int
-  -> ConsoleRegion
-  -> m ()
-finishIndexedRegion mvar ix region = do
-  liftIO . MVar.modifyMVar_ mvar $ \(minIx, regions) ->
-    pure (minIx, Map.insert ix region regions)
-  flushRegions mvar
+    updateSummary sregion svar mcolor (const summary)
+    Console.finishConsoleRegion sregion =<< Console.getConsoleRegion sregion
 
--- | Update the number of capabilities but never set it lower than it already
---   is.
+    pure summary
+
+-- | Check a group of properties sequentially.
 --
-updateNumCapabilities :: Int -> IO ()
-updateNumCapabilities n = do
-  ncaps <- Conc.getNumCapabilities
-  Conc.setNumCapabilities (max n ncaps)
+--   Using Template Haskell for property discovery:
+--
+-- > tests :: IO Bool
+-- > tests =
+-- >   checkSequential $$(discover)
+--
+--   With manually specified properties:
+--
+-- > tests :: IO Bool
+-- > tests =
+-- >   checkSequential $ Group "Test.Example" [
+-- >       ("prop_reverse", prop_reverse)
+-- >     ]
+--
+--
+checkSequential :: MonadIO m => Group -> m Bool
+checkSequential =
+  checkGroup
+    RunnerConfig {
+        runnerWorkers =
+          Just 1
+      , runnerColor =
+          Nothing
+      , runnerVerbosity =
+          Nothing
+      }
 
-getNumWorkers :: IO Int
-getNumWorkers = do
-  menv <- (readMaybe =<<) <$> lookupEnv "HEDGEHOG_WORKERS"
-  case menv of
-    Nothing ->
-      Conc.getNumProcessors
-    Just env ->
-      pure env
+-- | Check a group of properties in parallel.
+--
+--   /Warning: although this check function runs tests faster than/
+--   /'checkSequential', it should be noted that it may cause problems with/
+--   /properties that are not self-contained. For example, if you have a group/
+--   /of tests which all use the same database table, you may find that they/
+--   /interfere with each other when being run in parallel./
+--
+--   Using Template Haskell for property discovery:
+--
+-- > tests :: IO Bool
+-- > tests =
+-- >   checkParallel $$(discover)
+--
+--   With manually specified properties:
+--
+-- > tests :: IO Bool
+-- > tests =
+-- >   checkParallel $ Group "Test.Example" [
+-- >       ("prop_reverse", prop_reverse)
+-- >     ]
+--
+checkParallel :: MonadIO m => Group -> m Bool
+checkParallel =
+  checkGroup
+    RunnerConfig {
+        runnerWorkers =
+          Nothing
+      , runnerColor =
+          Nothing
+      , runnerVerbosity =
+          Nothing
+      }
 
 ------------------------------------------------------------------------
 -- FIXME Replace with DeriveLift when we drop 7.10 support.
diff --git a/src/Hedgehog/Internal/Seed.hs b/src/Hedgehog/Internal/Seed.hs
--- a/src/Hedgehog/Internal/Seed.hs
+++ b/src/Hedgehog/Internal/Seed.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE LambdaCase #-}
 -- |
 -- This is a port of "Fast Splittable Pseudorandom Number Generators" by Steele
 -- et. al. [1].
@@ -93,7 +92,7 @@
 -- | Create a random 'Seed' using an effectful source of randomness.
 --
 random :: MonadIO m => m Seed
-random = do
+random =
   liftIO $ IORef.atomicModifyIORef' global split
 
 -- | Create a 'Seed' using an 'Int64'.
diff --git a/src/Hedgehog/Internal/Shrink.hs b/src/Hedgehog/Internal/Shrink.hs
--- a/src/Hedgehog/Internal/Shrink.hs
+++ b/src/Hedgehog/Internal/Shrink.hs
@@ -37,11 +37,11 @@
 
 -- | Shrink a floating-point number by edging towards a destination.
 --
---   >>> towards 0.0 100
---   [0.0,50.0,75.0,87.5,93.75,96.875,98.4375,..
+--   >>> take 7 (towardsFloat 0.0 100)
+--   [0.0,50.0,75.0,87.5,93.75,96.875,98.4375]
 --
---   >>> towards 1.0 0.5
---   [1.0,0.75,0.625,0.5625,0.53125,0.515625,0.5078125,..
+--   >>> take 7 (towardsFloat 1.0 0.5)
+--   [1.0,0.75,0.625,0.5625,0.53125,0.515625,0.5078125]
 --
 --   /Note we always try the destination first, as that is the optimal shrink./
 --
@@ -72,7 +72,7 @@
 --   /Note we always try the empty list first, as that is the optimal shrink./
 --
 list :: [a] -> [[a]]
-list xs = do
+list xs =
  concatMap
    (\k -> removes k xs)
    (halves $ length xs)
diff --git a/src/Hedgehog/Internal/TH.hs b/src/Hedgehog/Internal/TH.hs
--- a/src/Hedgehog/Internal/TH.hs
+++ b/src/Hedgehog/Internal/TH.hs
@@ -2,9 +2,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Hedgehog.Internal.TH (
     TExpQ
-  , checkSequential
-  , checkConcurrent
-  , checkWith
+  , discover
   ) where
 
 import qualified Data.List as List
@@ -13,7 +11,6 @@
 
 import           Hedgehog.Internal.Discovery
 import           Hedgehog.Internal.Property
-import           Hedgehog.Internal.Runner
 
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Syntax
@@ -21,38 +18,12 @@
 type TExpQ a =
   Q (TExp a)
 
--- | Check all the properties in a file sequentially.
---
--- > tests :: IO Bool
--- > tests =
--- >   $$(checkSequential)
---
-checkSequential :: TExpQ (IO Bool)
-checkSequential =
-  checkWith $
-    RunnerConfig {
-        runnerWorkers =
-          Just 1
-      }
-
--- | Check all the properties in a file concurrently.
---
--- > tests :: IO Bool
--- > tests =
--- >   $$(checkConcurrent)
+-- | Discover all the properties in a module.
 --
-checkConcurrent :: TExpQ (IO Bool)
-checkConcurrent =
-  checkWith $
-    RunnerConfig {
-        runnerWorkers =
-          Nothing
-      }
-
--- | Check all the properties in a file.
+--   Functions starting with `prop_` are assumed to be properties.
 --
-checkWith :: RunnerConfig -> TExpQ (IO Bool)
-checkWith config = do
+discover :: TExpQ Group
+discover = do
   file <- getCurrentFile
   properties <- Map.toList <$> runIO (readProperties file)
 
@@ -68,7 +39,7 @@
       fmap (mkNamedProperty . fst) $
       List.sortBy startLine properties
 
-  [|| checkGroupWith config $$(moduleName) $$(listTE names) ||]
+  [|| Group $$(moduleName) $$(listTE names) ||]
 
 mkNamedProperty :: PropertyName -> TExpQ (PropertyName, Property)
 mkNamedProperty name = do
diff --git a/src/Hedgehog/Internal/Tree.hs b/src/Hedgehog/Internal/Tree.hs
--- a/src/Hedgehog/Internal/Tree.hs
+++ b/src/Hedgehog/Internal/Tree.hs
@@ -242,7 +242,7 @@
 
 passTree :: MonadWriter w m => Tree m (a, w -> w) -> Tree m a
 passTree (Tree m) =
-  Tree $ do
+  Tree $
     pure . passNode =<< m
 
 instance MonadWriter w m => MonadWriter w (Tree m) where
diff --git a/src/Hedgehog/Range.hs b/src/Hedgehog/Range.hs
--- a/src/Hedgehog/Range.hs
+++ b/src/Hedgehog/Range.hs
@@ -34,6 +34,10 @@
 
 import           Prelude hiding (minimum, maximum)
 
+-- $setup
+-- >>> import Data.Int (Int8)
+-- >>> let x = 3
+
 -- | Tests are parameterized by the size of the randomly-generated data, the
 --   meaning of which depends on the particular generator used.
 --
