diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,38 +1,93 @@
+## Version 0.5 (2017-07-16)
+
+- Parallel state machine testing, allows detection of commands which are not-atomic ([#98][98], [@jystic][jystic])
+- Easier to use variables for state machine testing ([#94][94], [@jystic][jystic])
+- `MonadGen` class allows the use of transformers like `ReaderT` and `StateT` on the outside of generators ([#99][99], [@jystic][jystic])
+- Better error messages for tests which throw exceptions ([#95][95], [@jystic][jystic])
+- Separated test input generation and assertions in to `PropertyT` and `TestT` respectively, this allows `TestT` to have a `MonadBaseControl` instance ([#96][96], [@jystic][jystic])
+- This document grew links to the pull requests which introduced various changes ([#93][93], [@moodmosaic][moodmosaic])
+
 ## Version 0.4.1 (2017-06-28)
 
-- Fixed runtime type error that could occur when shrinking state machine commands (#91, @jystic)
+- Fixed runtime type error that could occur when shrinking state machine commands ([#91][91], [@jystic][jystic])
 
 ## Version 0.4 (2017-06-28)
 
-- Abstract state machine testing, check out the [process registry example](https://github.com/hedgehogqa/haskell-hedgehog/blob/master/hedgehog-example/test/Test/Example/Registry.hs) to see how it works (#89, @jystic)
-- `liftCatch`, `liftCatchIO`, `withCatch` functions for isolating exceptions during tests (#89, @jystic)
+- Abstract state machine testing, check out the Tim Humphries' great [blog post](http://teh.id.au/posts/2017/07/15/state-machine-testing) or the [process registry example](https://github.com/hedgehogqa/haskell-hedgehog/blob/master/hedgehog-example/test/Test/Example/Registry.hs) to see how it works ([#89][89], [@jystic][jystic])
+- `liftCatch`, `liftCatchIO`, `withCatch` functions for isolating exceptions during tests ([#89][89], [@jystic][jystic])
 
 ## Version 0.3 (2017-06-11)
 
-- Exponential range combinators (#43, @chris-martin)
-- Roundtrip example, check out the [blog post](http://teh.id.au/posts/2017/06/07/round-trip-property/) (#85, @thumphries)
-- `tripping` now displays intermediate value (#85, @jystic)
-- `distribute` function for pulling a transformer out to the top level (#83, @jystic)
-- `withExceptT` function for executing tests with an inner `ExceptT` (e.g. `Test (ExceptT x m) a`) (#83, @jystic)
+- Exponential range combinators ([#43][43], [@chris-martin][chris-martin])
+- Roundtrip example, check out the [blog post](http://teh.id.au/posts/2017/06/07/round-trip-property/) ([#85][85], [@thumphries][thumphries])
+- `tripping` now displays intermediate value ([#85][85], [@jystic][jystic])
+- `distribute` function for pulling a transformer out to the top level ([#83][83], [@jystic][jystic])
+- `withExceptT` function for executing tests with an inner `ExceptT` (e.g. `Test (ExceptT x m) a`) ([#83][83], [@jystic][jystic])
 
 ## Version 0.2.2 (2017-05-16)
 
-- Fixed scope of `unicode` character generators (#76, @moodmosaic)
-- Widen version bounds for some dependencies (#80, @amarpotghan)
-- Expose test modules to fix build on nix / hydra (#78, @amarpotghan)
-- Fixes for GHC 8.2 RC2 (#77, @erikd)
+- Fixed scope of `unicode` character generators ([#76][76], [@moodmosaic][moodmosaic])
+- Widen version bounds for some dependencies ([#80][80], [@amarpotghan][amarpotghan])
+- Expose test modules to fix build on nix / hydra ([#78][78], [@amarpotghan][amarpotghan])
+- Fixes for GHC 8.2 RC2 ([#77][77], [@erikd][erikd])
 
 ## Version 0.2.1 (2017-05-09)
 
-- Added `ascii`, `latin1`, `unicode` character generators (#73, @jystic)
+- Added `ascii`, `latin1`, `unicode` character generators ([#73][73], [@jystic][jystic])
 
 ## Version 0.2 (2017-05-06)
 
-- Added a quiet test runner which can be activated by setting `HEDGEHOG_VERBOSITY=0` (@jystic)
-- Concurrent test runner does not display tests until they are executing (@jystic)
-- Test runner now outputs a summary of how many successful / failed tests were run (@jystic)
-- `checkSequential` and `checkParallel` now allow for tests to be run without Template Haskell (@jystic)
-- Auto-discovery of properties is now available via `discover` instead of being baked in (@jystic)
-- `annotate` allows source code to be annotated inline with extra information (@jystic)
-- `forAllWith` can be used to generate values without a `Show` instance (@jystic)
-- Removed uses of `Typeable` to allow for generating types which cannot implement it (@jystic)
+- Added a quiet test runner which can be activated by setting `HEDGEHOG_VERBOSITY=0` ([@jystic][jystic])
+- Concurrent test runner does not display tests until they are executing ([@jystic][jystic])
+- Test runner now outputs a summary of how many successful / failed tests were run ([@jystic][jystic])
+- `checkSequential` and `checkParallel` now allow for tests to be run without Template Haskell ([@jystic][jystic])
+- Auto-discovery of properties is now available via `discover` instead of being baked in ([@jystic][jystic])
+- `annotate` allows source code to be annotated inline with extra information ([@jystic][jystic])
+- `forAllWith` can be used to generate values without a `Show` instance ([@jystic][jystic])
+- Removed uses of `Typeable` to allow for generating types which cannot implement it ([@jystic][jystic])
+
+[jystic]:
+  https://github.com/jystic
+[chris-martin]:
+  https://github.com/chris-martin
+[thumphries]:
+  https://github.com/thumphries
+[moodmosaic]:
+  https://github.com/moodmosaic
+[amarpotghan]:
+  https://github.com/amarpotghan
+[erikd]:
+  https://github.com/erikd
+
+[99]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/99
+[98]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/98
+[96]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/96
+[95]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/95
+[94]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/94
+[93]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/93
+[91]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/91
+[89]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/89
+[85]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/85
+[83]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/83
+[80]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/80
+[78]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/78
+[77]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/77
+[76]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/76
+[73]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/73
+[43]:
+  https://github.com/hedgehogqa/haskell-hedgehog/pull/43
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -12,6 +12,7 @@
 ## Features
 
 - Integrated shrinking, shrinks obey invariants by construction.
+- Abstract state machine testing.
 - Generators allow monadic effects.
 - 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.
@@ -76,7 +77,7 @@
 ```
 
  [hackage]: http://hackage.haskell.org/package/hedgehog
- [hackage-shield]: https://img.shields.io/badge/hackage-v0.4.1-blue.svg
+ [hackage-shield]: https://img.shields.io/badge/hackage-v0.5-blue.svg
 
  [travis]: https://travis-ci.org/hedgehogqa/haskell-hedgehog
  [travis-shield]: https://travis-ci.org/hedgehogqa/haskell-hedgehog.svg?branch=master
diff --git a/hedgehog.cabal b/hedgehog.cabal
--- a/hedgehog.cabal
+++ b/hedgehog.cabal
@@ -1,7 +1,7 @@
 name:
   hedgehog
 version:
-  0.4.1
+  0.5
 license:
   BSD3
 author:
@@ -50,11 +50,13 @@
     , ansi-terminal                   >= 0.6        && < 0.7
     , async                           >= 2.0        && < 2.2
     , bytestring                      >= 0.10       && < 0.11
-    , concurrent-output               >= 1.7        && < 2.0
+    , concurrent-output               >= 1.7        && < 1.11
     , containers                      >= 0.4        && < 0.6
     , directory                       >= 1.2        && < 1.4
     , exceptions                      >= 0.7        && < 0.9
+    , lifted-async                    >= 0.7        && < 0.10
     , mmorph                          >= 1.0        && < 1.2
+    , monad-control                   >= 1.0        && < 1.1
     , mtl                             >= 2.1        && < 2.3
     , pretty-show                     >= 1.6        && < 1.7
     , primitive                       >= 0.6        && < 0.7
diff --git a/src/Hedgehog.hs b/src/Hedgehog.hs
--- a/src/Hedgehog.hs
+++ b/src/Hedgehog.hs
@@ -44,26 +44,20 @@
 -- >   ✓ prop_reverse passed 100 tests.
 --
 module Hedgehog (
-    Group(..)
-  , GroupName
-  , Property
+  -- * Properties
+    Property
+  , PropertyT
+  , Group(..)
   , PropertyName
-  , Test
-  , TestLimit
-  , DiscardLimit
-  , ShrinkLimit
-
-  , Gen
-  , Range
-  , Size(..)
-  , Seed(..)
+  , GroupName
 
-  -- * Property
   , property
-  , withTests
-  , withDiscards
-  , withShrinks
+  , test
 
+  , forAll
+  , forAllWith
+  , discard
+
   , check
   , recheck
 
@@ -71,39 +65,62 @@
   , checkParallel
   , checkSequential
 
-  -- * Test
-  , forAll
-  , forAllWith
+  , withTests
+  , TestLimit
+
+  , withDiscards
+  , DiscardLimit
+
+  , withShrinks
+  , ShrinkLimit
+
+  , withRetries
+  , ShrinkRetries
+
+  -- * Generating Test Data
+  , Gen
+  , GenT
+  , MonadGen(..)
+
+  , Range
+  , Size(..)
+  , Seed(..)
+
+  -- * Tests
+  , Test
+  , TestT
+  , MonadTest(..)
   , annotate
   , annotateShow
   , footnote
   , footnoteShow
   , success
-  , discard
   , failure
   , assert
   , (===)
-
-  , liftCatch
-  , liftCatchIO
-  , liftEither
-  , liftExceptT
-
-  , withCatch
-  , withExceptT
-  , withResourceT
-
   , tripping
 
-  -- * Abstract State Machine
+  , eval
+  , evalM
+  , evalIO
+  , evalEither
+  , evalExceptT
+
+  -- * State Machine Tests
   , Command(..)
   , Callback(..)
   , Action
+  , Sequential(..)
+  , Parallel(..)
   , executeSequential
+  , executeParallel
 
+  , Var(..)
+  , concrete
+  , opaque
+
+  , Symbolic
   , Concrete(..)
-  , Symbolic(..)
-  , Var
   , Opaque(..)
 
   -- * Transformers
@@ -125,26 +142,30 @@
 import           Data.Functor.Classes (Eq1, eq1, Ord1, compare1, Show1, showsPrec1)
 
 import           Hedgehog.Internal.Distributive (Distributive(..))
-import           Hedgehog.Internal.Gen (Gen)
+import           Hedgehog.Internal.Gen (Gen, GenT, MonadGen(..))
 import           Hedgehog.Internal.HTraversable (HTraversable(..))
 import           Hedgehog.Internal.Opaque (Opaque(..))
 import           Hedgehog.Internal.Property (annotate, annotateShow)
 import           Hedgehog.Internal.Property (assert, (===))
 import           Hedgehog.Internal.Property (discard, failure, success)
 import           Hedgehog.Internal.Property (DiscardLimit, withDiscards)
+import           Hedgehog.Internal.Property (eval, evalM, evalIO)
+import           Hedgehog.Internal.Property (evalEither, evalExceptT)
 import           Hedgehog.Internal.Property (footnote, footnoteShow)
 import           Hedgehog.Internal.Property (forAll, forAllWith)
-import           Hedgehog.Internal.Property (liftCatch, liftCatchIO, liftEither, liftExceptT)
-import           Hedgehog.Internal.Property (Property, PropertyName, Group(..), GroupName)
+import           Hedgehog.Internal.Property (MonadTest(..))
+import           Hedgehog.Internal.Property (Property, PropertyT, PropertyName)
+import           Hedgehog.Internal.Property (Group(..), GroupName)
 import           Hedgehog.Internal.Property (ShrinkLimit, withShrinks)
-import           Hedgehog.Internal.Property (Test, property)
+import           Hedgehog.Internal.Property (ShrinkRetries, withRetries)
+import           Hedgehog.Internal.Property (Test, TestT, property, test)
 import           Hedgehog.Internal.Property (TestLimit, withTests)
-import           Hedgehog.Internal.Property (withCatch, withExceptT, withResourceT)
 import           Hedgehog.Internal.Range (Range, Size(..))
 import           Hedgehog.Internal.Runner (check, recheck, checkSequential, checkParallel)
 import           Hedgehog.Internal.Seed (Seed(..))
-import           Hedgehog.Internal.State (Command(..), Callback(..), Action)
-import           Hedgehog.Internal.State (executeSequential)
-import           Hedgehog.Internal.State (Var(..), Symbolic(..), Concrete(..))
+import           Hedgehog.Internal.State (Command(..), Callback(..))
+import           Hedgehog.Internal.State (Action, Sequential(..), Parallel(..))
+import           Hedgehog.Internal.State (executeSequential, executeParallel)
+import           Hedgehog.Internal.State (Var(..), Symbolic, Concrete(..), concrete, opaque)
 import           Hedgehog.Internal.TH (discover)
 import           Hedgehog.Internal.Tripping (tripping)
diff --git a/src/Hedgehog/Gen.hs b/src/Hedgehog/Gen.hs
--- a/src/Hedgehog/Gen.hs
+++ b/src/Hedgehog/Gen.hs
@@ -1,8 +1,7 @@
 module Hedgehog.Gen (
-  -- * Transformer
-    Gen
-
   -- * Combinators
+    lift
+
   -- ** Shrinking
   , shrink
   , prune
@@ -82,6 +81,7 @@
   , map
 
   -- ** Subterms
+  , freeze
   , subterm
   , subtermM
   , subterm2
@@ -94,7 +94,8 @@
   , shuffle
 
   -- ** Abstract State Machine
-  , actions
+  , sequential
+  , parallel
 
   -- * Sampling Generators
   , sample
@@ -105,6 +106,6 @@
   ) where
 
 import           Hedgehog.Internal.Gen
-import           Hedgehog.Internal.State (actions)
+import           Hedgehog.Internal.State (sequential, parallel)
 
 import           Prelude hiding (filter, print, maybe, map, seq)
diff --git a/src/Hedgehog/Internal/Exception.hs b/src/Hedgehog/Internal/Exception.hs
--- a/src/Hedgehog/Internal/Exception.hs
+++ b/src/Hedgehog/Internal/Exception.hs
@@ -1,42 +1,23 @@
 module Hedgehog.Internal.Exception (
-    TypedException(..)
-  , tryAll
+    tryAll
+  , tryEvaluate
   ) where
 
-import           Control.Exception (Exception(..), AsyncException, SomeException(..))
+import           Control.Exception (Exception(..), AsyncException, SomeException(..), evaluate)
 import           Control.Monad.Catch (MonadCatch(..), throwM)
 
-import           Data.Typeable (typeOf)
+import           System.IO.Unsafe (unsafePerformIO)
 
 
--- | Newtype for 'SomeException' with a 'Show' instance that only contains
---   valid Haskell 98 tokens and also includes the type of the exception.
---
---   For example, when catching the exception thrown by @fail "foo" :: IO ()@
---   and calling show:
---
--- @
---   IOException "user error (foo)"
--- @
---
---   Having access to the type can be useful when trying to track down the
---   source of an exception.
---
-newtype TypedException =
-  TypedException SomeException
-
-instance Show TypedException where
-  showsPrec p (TypedException (SomeException x)) =
-    showParen (p > 10) $
-      showsPrec 11 (typeOf x) .
-      showChar ' ' .
-      showsPrec 11 (displayException x)
-
-tryAll :: MonadCatch m => m a -> m (Either TypedException a)
+tryAll :: MonadCatch m => m a -> m (Either SomeException a)
 tryAll m =
   catch (fmap Right m) $ \exception ->
     case fromException exception :: Maybe AsyncException of
       Nothing ->
-        pure . Left $ TypedException exception
+        pure $ Left exception
       Just async ->
         throwM async
+
+tryEvaluate :: a -> Either SomeException a
+tryEvaluate x =
+  unsafePerformIO (tryAll (evaluate x))
diff --git a/src/Hedgehog/Internal/Gen.hs b/src/Hedgehog/Internal/Gen.hs
--- a/src/Hedgehog/Internal/Gen.hs
+++ b/src/Hedgehog/Internal/Gen.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -15,9 +17,13 @@
 {-# LANGUAGE UndecidableInstances #-} -- MonadBase
 module Hedgehog.Internal.Gen (
   -- * Transformer
-    Gen(..)
+    Gen
+  , GenT(..)
+  , MonadGen(..)
 
   -- * Combinators
+  , lift
+
   -- ** Shrinking
   , shrink
   , prune
@@ -85,6 +91,7 @@
 
   -- ** Conditional
   , discard
+  , ensure
   , filter
   , just
 
@@ -120,8 +127,8 @@
   -- $internal
 
   -- ** Transfomer
-  , runGen
-  , mapGen
+  , runGenT
+  , mapGenT
   , generate
   , liftTree
   , runDiscardEffect
@@ -145,25 +152,36 @@
   ) where
 
 import           Control.Applicative (Alternative(..))
-import           Control.Monad (MonadPlus(..), mfilter, filterM, replicateM, ap, join)
+import           Control.Monad (MonadPlus(..), filterM, replicateM, ap, join)
 import           Control.Monad.Base (MonadBase(..))
 import           Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
 import           Control.Monad.Error.Class (MonadError(..))
 import           Control.Monad.IO.Class (MonadIO(..))
-import           Control.Monad.Morph (MFunctor(..), MMonad(..))
+import           Control.Monad.Morph (MFunctor(..), MMonad(..), generalize)
 import           Control.Monad.Primitive (PrimMonad(..))
 import           Control.Monad.Reader.Class (MonadReader(..))
 import           Control.Monad.State.Class (MonadState(..))
-import           Control.Monad.Trans.Class (MonadTrans(..))
-import           Control.Monad.Trans.Maybe (MaybeT(..))
+import           Control.Monad.Trans.Class (MonadTrans)
+import qualified Control.Monad.Trans.Class as Trans
+import           Control.Monad.Trans.Except (ExceptT(..), mapExceptT)
+import           Control.Monad.Trans.Identity (IdentityT(..), mapIdentityT)
+import           Control.Monad.Trans.Maybe (MaybeT(..), mapMaybeT)
+import qualified Control.Monad.Trans.RWS.Lazy as Lazy
+import qualified Control.Monad.Trans.RWS.Strict as Strict
+import           Control.Monad.Trans.Reader (ReaderT(..), mapReaderT)
 import           Control.Monad.Trans.Resource (MonadResource(..))
+import qualified Control.Monad.Trans.State.Lazy as Lazy
+import qualified Control.Monad.Trans.State.Strict as Strict
+import qualified Control.Monad.Trans.Writer.Lazy as Lazy
+import qualified Control.Monad.Trans.Writer.Strict as Strict
 import           Control.Monad.Writer.Class (MonadWriter(..))
 
-import           Data.Bifunctor (first)
+import           Data.Bifunctor (first, second)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as ByteString
 import qualified Data.Char as Char
 import           Data.Foldable (for_, toList)
+import           Data.Functor.Identity (Identity(..))
 import           Data.Int (Int8, Int16, Int32, Int64)
 import           Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as NonEmpty
@@ -195,53 +213,35 @@
 
 -- | Generator for random values of @a@.
 --
-newtype Gen m a =
-  Gen {
+type Gen =
+  GenT Identity
+
+-- | Monad transformer which can generate random values of @a@.
+--
+newtype GenT m a =
+  GenT {
       unGen :: Size -> Seed -> Tree (MaybeT m) a
     }
 
 -- | Runs a generator, producing its shrink tree.
 --
-runGen :: Size -> Seed -> Gen m a -> Tree (MaybeT m) a
-runGen size seed (Gen m) =
+runGenT :: Size -> Seed -> GenT m a -> Tree (MaybeT m) a
+runGenT size seed (GenT m) =
   m size seed
 
 -- | Map over a generator's shrink tree.
 --
-mapGen :: (Tree (MaybeT m) a -> Tree (MaybeT n) b) -> Gen m a -> Gen n b
-mapGen f gen =
-  Gen $ \size seed ->
-    f (runGen size seed gen)
-
--- | Generate a value with no shrinks from a 'Size' and a 'Seed'.
---
-generate :: Monad m => (Size -> Seed -> a) -> Gen m a
-generate f =
-  Gen $ \size seed ->
-    pure (f size seed)
-
--- | Freeze the size and seed used by a generator, so we can inspect the value
---   which it will produce.
---
---   This is used for implementing `list` and `subtermMVec`. It allows us to
---   shrink the list itself before trying to shrink the values inside the list.
---
-freeze :: Monad m => Gen m a -> Gen m (a, Gen m a)
-freeze gen =
-  Gen $ \size seed -> do
-    mx <- lift . lift . runMaybeT . runTree $ runGen size seed gen
-    case mx of
-      Nothing ->
-        mzero
-      Just (Node x xs) ->
-        pure (x, liftTree . Tree.fromNode $ Node x xs)
+mapGenT :: (Tree (MaybeT m) a -> Tree (MaybeT n) b) -> GenT m a -> GenT n b
+mapGenT f gen =
+  GenT $ \size seed ->
+    f (runGenT size seed gen)
 
 -- | Lift a predefined shrink tree in to a generator, ignoring the seed and the
 --   size.
 --
-liftTree :: Tree (MaybeT m) a -> Gen m a
+liftTree :: Tree (MaybeT m) a -> GenT m a
 liftTree x =
-  Gen (\_ _ -> x)
+  GenT (\_ _ -> x)
 
 -- | Run the discard effects through the tree and reify them as 'Maybe' values
 --   at the nodes. 'Nothing' means discarded, 'Just' means we have a value.
@@ -251,54 +251,321 @@
   runMaybeT . distribute
 
 ------------------------------------------------------------------------
--- Gen instances
+-- MonadGen
 
-instance Functor m => Functor (Gen m) where
+-- | Class of monads which can generate input data for tests.
+--
+--   /The functions on this class can, and should, be used without their @Gen@/
+--   /suffix by importing "Hedgehog.Gen" qualified./
+--
+class Monad m => MonadGen m where
+  -- | See @Gen.@'Hedgehog.Gen.lift'
+  --
+  liftGen :: Gen a -> m a
+
+  -- | See @Gen.@'Hedgehog.Gen.shrink'
+  --
+  shrinkGen :: (a -> [a]) -> m a -> m a
+
+  -- | See @Gen.@'Hedgehog.Gen.prune'
+  --
+  pruneGen :: m a -> m a
+
+  -- | See @Gen.@'Hedgehog.Gen.scale'
+  --
+  scaleGen :: (Size -> Size) -> m a -> m a
+
+  -- | See @Gen.@'Hedgehog.Gen.freeze'
+  --
+  freezeGen :: m a -> m (a, m a)
+
+instance Monad m => MonadGen (GenT m) where
+  liftGen gen =
+    hoist generalize gen
+
+  shrinkGen =
+    mapGenT . Tree.expand
+
+  pruneGen =
+    mapGenT Tree.prune
+
+  scaleGen f gen =
+    GenT $ \size0 seed ->
+      let
+        size =
+          f size0
+      in
+        if size < 0 then
+          error "Hedgehog.Gen.scale: negative size"
+        else
+          runGenT size seed gen
+
+  freezeGen gen =
+    GenT $ \size seed -> do
+      mx <- Trans.lift . Trans.lift . runMaybeT . runTree $ runGenT size seed gen
+      case mx of
+        Nothing ->
+          mzero
+        Just (Node x xs) ->
+          pure (x, liftTree . Tree.fromNode $ Node x xs)
+
+instance MonadGen m => MonadGen (IdentityT m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    mapIdentityT (shrink f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen =
+    mapIdentityT $
+      fmap (second Trans.lift) . freeze
+
+shrinkMaybe :: (a -> [a]) -> Maybe a -> [Maybe a]
+shrinkMaybe f = \case
+  Nothing ->
+    pure Nothing
+  Just x ->
+    fmap Just (f x)
+
+shrinkEither :: (a -> [a]) -> Either x a -> [Either x a]
+shrinkEither f = \case
+  Left x ->
+    pure $ Left x
+  Right x ->
+    fmap Right (f x)
+
+shrink2 :: (a -> [a]) -> (a, b) -> [(a, b)]
+shrink2 f (x, y) =
+  fmap (, y) (f x)
+
+shrink3 :: (a -> [a]) -> (a, b, c) -> [(a, b, c)]
+shrink3 f (x, y, z) =
+  fmap (, y, z) (f x)
+
+instance MonadGen m => MonadGen (MaybeT m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    mapMaybeT $
+      shrink (shrinkMaybe f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen =
+    mapMaybeT $ \m0 -> do
+      (mx, m) <- freeze m0
+      pure $ fmap (, MaybeT m) mx
+
+instance MonadGen m => MonadGen (ExceptT x m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    mapExceptT $
+      shrink (shrinkEither f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen =
+    mapExceptT $ \m0 -> do
+      (mx, m) <- freeze m0
+      pure $ fmap (, ExceptT m) mx
+
+instance MonadGen m => MonadGen (ReaderT r m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    mapReaderT (shrink f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen =
+    mapReaderT $
+      fmap (second Trans.lift) . freeze
+
+instance MonadGen m => MonadGen (Lazy.StateT s m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    Lazy.mapStateT $
+      shrink (shrink2 f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen m0 =
+    Lazy.StateT $ \s0 -> do
+      ((x, s), m) <- freeze (Lazy.runStateT m0 s0)
+      pure ((x, Lazy.StateT (const m)), s)
+
+instance MonadGen m => MonadGen (Strict.StateT s m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    Strict.mapStateT $
+      shrink (shrink2 f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen m0 =
+    Strict.StateT $ \s0 -> do
+      ((x, s), m) <- freeze (Strict.runStateT m0 s0)
+      pure ((x, Strict.StateT (const m)), s)
+
+instance (MonadGen m, Monoid w) => MonadGen (Lazy.WriterT w m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    Lazy.mapWriterT $
+      shrink (shrink2 f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen m0 =
+    Lazy.WriterT $ do
+      ((x, w), m) <- freeze (Lazy.runWriterT m0)
+      pure ((x, Lazy.WriterT m), w)
+
+instance (MonadGen m, Monoid w) => MonadGen (Strict.WriterT w m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    Strict.mapWriterT $
+      shrink (shrink2 f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen m0 =
+    Strict.WriterT $ do
+      ((x, w), m) <- freeze (Strict.runWriterT m0)
+      pure ((x, Strict.WriterT m), w)
+
+instance (MonadGen m, Monoid w) => MonadGen (Lazy.RWST r w s m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    Lazy.mapRWST $
+      shrink (shrink3 f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen m0 =
+    Lazy.RWST $ \r s0 -> do
+      ((x, s, w), m) <- freeze (Lazy.runRWST m0 r s0)
+      pure ((x, Lazy.RWST (\_ _ -> m)), s, w)
+
+instance (MonadGen m, Monoid w) => MonadGen (Strict.RWST r w s m) where
+  liftGen =
+    Trans.lift . liftGen
+
+  shrinkGen f =
+    Strict.mapRWST $
+      shrink (shrink3 f)
+
+  pruneGen =
+    hoist prune
+
+  scaleGen f =
+    hoist (scale f)
+
+  freezeGen m0 =
+    Strict.RWST $ \r s0 -> do
+      ((x, s, w), m) <- freeze (Strict.runRWST m0 r s0)
+      pure ((x, Strict.RWST (\_ _ -> m)), s, w)
+
+------------------------------------------------------------------------
+-- GenT instances
+
+instance Functor m => Functor (GenT m) where
   fmap f gen =
-    Gen $ \seed size ->
-      fmap f (runGen seed size gen)
+    GenT $ \seed size ->
+      fmap f (runGenT seed size gen)
 
-instance Monad m => Applicative (Gen m) where
+instance Monad m => Applicative (GenT m) where
   pure =
     return
   (<*>) =
     ap
 
-instance Monad m => Monad (Gen m) where
+instance Monad m => Monad (GenT m) where
   return =
     liftTree . pure
 
   (>>=) m k =
-    Gen $ \size seed ->
+    GenT $ \size seed ->
       case Seed.split seed of
         (sk, sm) ->
-          runGen size sk . k =<<
-          runGen size sm m
+          runGenT size sk . k =<<
+          runGenT size sm m
 
-instance Monad m => Alternative (Gen m) where
+instance Monad m => Alternative (GenT m) where
   empty =
     mzero
   (<|>) =
     mplus
 
-instance Monad m => MonadPlus (Gen m) where
+instance Monad m => MonadPlus (GenT m) where
   mzero =
     liftTree mzero
 
   mplus x y =
-    Gen $ \size seed ->
+    GenT $ \size seed ->
       case Seed.split seed of
         (sx, sy) ->
-          runGen size sx x `mplus`
-          runGen size sy y
+          runGenT size sx x `mplus`
+          runGenT size sy y
 
-instance MonadTrans Gen where
+instance MonadTrans GenT where
   lift =
-    liftTree . lift . lift
+    liftTree . Trans.lift . Trans.lift
 
-instance MFunctor Gen where
+instance MFunctor GenT where
   hoist f =
-    mapGen (hoist (hoist f))
+    mapGenT (hoist (hoist f))
 
 embedMaybe ::
      MonadTrans t
@@ -308,32 +575,32 @@
   -> MaybeT m b
   -> t (MaybeT n) b
 embedMaybe f m =
-  lift . MaybeT . pure =<< f (runMaybeT m)
+  Trans.lift . MaybeT . pure =<< f (runMaybeT m)
 
 embedTree :: Monad n => (forall a. m a -> Tree (MaybeT n) a) -> Tree (MaybeT m) b -> Tree (MaybeT n) b
 embedTree f tree =
   embed (embedMaybe f) tree
 
-embedGen :: Monad n => (forall a. m a -> Gen n a) -> Gen m b -> Gen n b
+embedGen :: Monad n => (forall a. m a -> GenT n a) -> GenT m b -> GenT n b
 embedGen f gen =
-  Gen $ \size seed ->
+  GenT $ \size seed ->
     case Seed.split seed of
       (sf, sg) ->
-        (runGen size sf . f) `embedTree`
-        (runGen size sg gen)
+        (runGenT size sf . f) `embedTree`
+        (runGenT size sg gen)
 
-instance MMonad Gen where
+instance MMonad GenT where
   embed =
     embedGen
 
-distributeGen :: Transformer t Gen m => Gen (t m) a -> t (Gen m) a
+distributeGen :: Transformer t GenT m => GenT (t m) a -> t (GenT m) a
 distributeGen x =
-  join . lift . Gen $ \size seed ->
-    pure . hoist liftTree . distribute . hoist distribute $ runGen size seed x
+  join . Trans.lift . GenT $ \size seed ->
+    pure . hoist liftTree . distribute . hoist distribute $ runGenT size seed x
 
-instance Distributive Gen where
-  type Transformer t Gen m = (
-      Monad (t (Gen m))
+instance Distributive GenT where
+  type Transformer t GenT m = (
+      Monad (t (GenT m))
     , Transformer t MaybeT m
     , Transformer t Tree (MaybeT m)
     )
@@ -341,119 +608,129 @@
   distribute =
     distributeGen
 
-instance PrimMonad m => PrimMonad (Gen m) where
-  type PrimState (Gen m) =
+instance PrimMonad m => PrimMonad (GenT m) where
+  type PrimState (GenT m) =
     PrimState m
   primitive =
-    lift . primitive
+    Trans.lift . primitive
 
-instance MonadIO m => MonadIO (Gen m) where
+instance MonadIO m => MonadIO (GenT m) where
   liftIO =
-    lift . liftIO
+    Trans.lift . liftIO
 
-instance MonadBase b m => MonadBase b (Gen m) where
+instance MonadBase b m => MonadBase b (GenT m) where
   liftBase =
-    lift . liftBase
+    Trans.lift . liftBase
 
-instance MonadThrow m => MonadThrow (Gen m) where
+instance MonadThrow m => MonadThrow (GenT m) where
   throwM =
-    lift . throwM
+    Trans.lift . throwM
 
-instance MonadCatch m => MonadCatch (Gen m) where
+instance MonadCatch m => MonadCatch (GenT m) where
   catch m onErr =
-    Gen $ \size seed ->
+    GenT $ \size seed ->
       case Seed.split seed of
         (sm, se) ->
-          (runGen size sm m) `catch`
-          (runGen size se . onErr)
+          (runGenT size sm m) `catch`
+          (runGenT size se . onErr)
 
-instance MonadReader r m => MonadReader r (Gen m) where
+instance MonadReader r m => MonadReader r (GenT m) where
   ask =
-    lift ask
+    Trans.lift ask
   local f m =
-    mapGen (local f) m
+    mapGenT (local f) m
 
-instance MonadState s m => MonadState s (Gen m) where
+instance MonadState s m => MonadState s (GenT m) where
   get =
-    lift get
+    Trans.lift get
   put =
-    lift . put
+    Trans.lift . put
   state =
-    lift . state
+    Trans.lift . state
 
-instance MonadWriter w m => MonadWriter w (Gen m) where
+instance MonadWriter w m => MonadWriter w (GenT m) where
   writer =
-    lift . writer
+    Trans.lift . writer
   tell =
-    lift . tell
+    Trans.lift . tell
   listen =
-    mapGen listen
+    mapGenT listen
   pass =
-    mapGen pass
+    mapGenT pass
 
-instance MonadError e m => MonadError e (Gen m) where
+instance MonadError e m => MonadError e (GenT m) where
   throwError =
-    lift . throwError
+    Trans.lift . throwError
   catchError m onErr =
-    Gen $ \size seed ->
+    GenT $ \size seed ->
       case Seed.split seed of
         (sm, se) ->
-          (runGen size sm m) `catchError`
-          (runGen size se . onErr)
+          (runGenT size sm m) `catchError`
+          (runGenT size se . onErr)
 
-instance MonadResource m => MonadResource (Gen m) where
+instance MonadResource m => MonadResource (GenT m) where
   liftResourceT =
-    lift . liftResourceT
+    Trans.lift . liftResourceT
 
 ------------------------------------------------------------------------
--- Shrinking
+-- Combinators
 
+-- | Lift a vanilla 'Gen' in to a 'MonadGen'.
+--
+lift :: MonadGen m => Gen a -> m a
+lift =
+  liftGen
+
+-- | Generate a value with no shrinks from a 'Size' and a 'Seed'.
+--
+generate :: MonadGen m => (Size -> Seed -> a) -> m a
+generate f =
+  liftGen . GenT $ \size seed ->
+    pure (f size seed)
+
+------------------------------------------------------------------------
+-- Combinators - Shrinking
+
 -- | Apply a shrinking function to a generator.
 --
 --   This will give the generator additional shrinking options, while keeping
 --   the existing shrinks intact.
 --
-shrink :: Monad m => (a -> [a]) -> Gen m a -> Gen m a
+shrink :: MonadGen m => (a -> [a]) -> m a -> m a
 shrink =
-  mapGen . Tree.expand
+  shrinkGen
 
 -- | Throw away a generator's shrink tree.
 --
-prune :: Monad m => Gen m a -> Gen m a
+prune :: MonadGen m => m a -> m a
 prune =
-  mapGen Tree.prune
+  pruneGen
 
 ------------------------------------------------------------------------
 -- Combinators - Size
 
 -- | Construct a generator that depends on the size parameter.
 --
-sized :: (Size -> Gen m a) -> Gen m a
-sized f =
-  Gen $ \size seed ->
-    runGen size seed (f size)
+sized :: MonadGen m => (Size -> m a) -> m a
+sized f = do
+  f =<< generate (\size _ -> size)
 
 -- | Override the size parameter. Returns a generator which uses the given size
 --   instead of the runtime-size parameter.
 --
-resize :: Size -> Gen m a -> Gen m a
+resize :: MonadGen m => Size -> m a -> m a
 resize size gen =
-  if size < 0 then
-    error "Hedgehog.Random.resize: negative size"
-  else
-    Gen $ \_ seed ->
-      runGen size seed gen
+  scale (const size) gen
 
 -- | Adjust the size parameter by transforming it with the given function.
 --
-scale :: (Size -> Size) -> Gen m a -> Gen m a
-scale f gen =
-  sized $ \n ->
-    resize (f n) gen
+scale :: MonadGen m => (Size -> Size) -> m a -> m a
+scale =
+  scaleGen
 
 -- | Make a generator smaller by scaling its size parameter.
 --
-small :: Gen m a -> Gen m a
+small :: MonadGen m => m a -> m a
 small =
   scale golden
 
@@ -502,7 +779,7 @@
 --   > 2058
 --   > 2060
 --
-integral :: (Monad m, Integral a) => Range a -> Gen m a
+integral :: (MonadGen m, Integral a) => Range a -> m a
 integral range =
   shrink (Shrink.towards $ Range.origin range) (integral_ range)
 
@@ -510,7 +787,7 @@
 --
 --   /This generator does not shrink./
 --
-integral_ :: (Monad m, Integral a) => Range a -> Gen m a
+integral_ :: (MonadGen m, Integral a) => Range a -> m a
 integral_ range =
   generate $ \size seed ->
     let
@@ -524,7 +801,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-int :: Monad m => Range Int -> Gen m Int
+int :: MonadGen m => Range Int -> m Int
 int =
   integral
 
@@ -532,7 +809,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-int8 :: Monad m => Range Int8 -> Gen m Int8
+int8 :: MonadGen m => Range Int8 -> m Int8
 int8 =
   integral
 
@@ -540,7 +817,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-int16 :: Monad m => Range Int16 -> Gen m Int16
+int16 :: MonadGen m => Range Int16 -> m Int16
 int16 =
   integral
 
@@ -548,7 +825,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-int32 :: Monad m => Range Int32 -> Gen m Int32
+int32 :: MonadGen m => Range Int32 -> m Int32
 int32 =
   integral
 
@@ -556,7 +833,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-int64 :: Monad m => Range Int64 -> Gen m Int64
+int64 :: MonadGen m => Range Int64 -> m Int64
 int64 =
   integral
 
@@ -564,7 +841,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-word :: Monad m => Range Word -> Gen m Word
+word :: MonadGen m => Range Word -> m Word
 word =
   integral
 
@@ -572,7 +849,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-word8 :: Monad m => Range Word8 -> Gen m Word8
+word8 :: MonadGen m => Range Word8 -> m Word8
 word8 =
   integral
 
@@ -580,7 +857,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-word16 :: Monad m => Range Word16 -> Gen m Word16
+word16 :: MonadGen m => Range Word16 -> m Word16
 word16 =
   integral
 
@@ -588,7 +865,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-word32 :: Monad m => Range Word32 -> Gen m Word32
+word32 :: MonadGen m => Range Word32 -> m Word32
 word32 =
   integral
 
@@ -596,7 +873,7 @@
 --
 --   /This is a specialization of 'integral', offered for convenience./
 --
-word64 :: Monad m => Range Word64 -> Gen m Word64
+word64 :: MonadGen m => Range Word64 -> m Word64
 word64 =
   integral
 
@@ -607,7 +884,7 @@
 --
 --   This generator works the same as 'integral', but for floating point numbers.
 --
-realFloat :: (Monad m, RealFloat a) => Range a -> Gen m a
+realFloat :: (MonadGen m, RealFloat a) => Range a -> m a
 realFloat range =
   shrink (Shrink.towardsFloat $ Range.origin range) (realFrac_ range)
 
@@ -615,7 +892,7 @@
 --
 --   /This generator does not shrink./
 --
-realFrac_ :: (Monad m, RealFrac a) => Range a -> Gen m a
+realFrac_ :: (MonadGen m, RealFrac a) => Range a -> m a
 realFrac_ range =
   generate $ \size seed ->
     let
@@ -629,7 +906,7 @@
 --
 --   /This is a specialization of 'realFloat', offered for convenience./
 --
-float :: Monad m => Range Float -> Gen m Float
+float :: MonadGen m => Range Float -> m Float
 float =
  realFloat
 
@@ -637,7 +914,7 @@
 --
 --   /This is a specialization of 'realFloat', offered for convenience./
 --
-double :: Monad m => Range Double -> Gen m Double
+double :: MonadGen m => Range Double -> m Double
 double =
  realFloat
 
@@ -654,7 +931,7 @@
 -- enum \'a' \'z' :: 'Gen' 'Char'
 -- @
 --
-enum :: (Monad m, Enum a) => a -> a -> Gen m a
+enum :: (MonadGen m, Enum a) => a -> a -> m a
 enum lo hi =
   fmap toEnum . integral $
     Range.constant (fromEnum lo) (fromEnum hi)
@@ -669,7 +946,7 @@
 -- enumBounded :: 'Gen' 'Bool'
 -- @
 --
-enumBounded :: (Monad m, Enum a, Bounded a) => Gen m a
+enumBounded :: (MonadGen m, Enum a, Bounded a) => m a
 enumBounded =
   enum minBound maxBound
 
@@ -679,7 +956,7 @@
 --
 --   /This is a specialization of 'enumBounded', offered for convenience./
 --
-bool :: Monad m => Gen m Bool
+bool :: MonadGen m => m Bool
 bool =
   enumBounded
 
@@ -687,7 +964,7 @@
 --
 --   /This generator does not shrink./
 --
-bool_ :: Monad m => Gen m Bool
+bool_ :: MonadGen m => m Bool
 bool_ =
   generate $ \_ seed ->
     (/= 0) . fst $ Seed.nextInteger 0 1 seed
@@ -697,78 +974,78 @@
 
 -- | Generates an ASCII binit: @'0'..'1'@
 --
-binit :: Monad m => Gen m Char
+binit :: MonadGen m => m Char
 binit =
   enum '0' '1'
 
 -- | Generates an ASCII octit: @'0'..'7'@
 --
-octit :: Monad m => Gen m Char
+octit :: MonadGen m => m Char
 octit =
   enum '0' '7'
 
 -- | Generates an ASCII digit: @'0'..'9'@
 --
-digit :: Monad m => Gen m Char
+digit :: MonadGen m => m Char
 digit =
   enum '0' '9'
 
 -- | Generates an ASCII hexit: @'0'..'9', \'a\'..\'f\', \'A\'..\'F\'@
 --
-hexit :: Monad m => Gen m Char
+hexit :: MonadGen m => m Char
 hexit =
   -- FIXME optimize lookup, use a SmallArray or something.
   element "0123456789aAbBcCdDeEfF"
 
 -- | Generates an ASCII lowercase letter: @\'a\'..\'z\'@
 --
-lower :: Monad m => Gen m Char
+lower :: MonadGen m => m Char
 lower =
   enum 'a' 'z'
 
 -- | Generates an ASCII uppercase letter: @\'A\'..\'Z\'@
 --
-upper :: Monad m => Gen m Char
+upper :: MonadGen m => m Char
 upper =
   enum 'A' 'Z'
 
 -- | Generates an ASCII letter: @\'a\'..\'z\', \'A\'..\'Z\'@
 --
-alpha :: Monad m => Gen m Char
+alpha :: MonadGen m => m Char
 alpha =
   -- FIXME optimize lookup, use a SmallArray or something.
   element "abcdefghiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
 
 -- | Generates an ASCII letter or digit: @\'a\'..\'z\', \'A\'..\'Z\', \'0\'..\'9\'@
 --
-alphaNum :: Monad m => Gen m Char
+alphaNum :: MonadGen m => m Char
 alphaNum =
   -- FIXME optimize lookup, use a SmallArray or something.
   element "abcdefghiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
 
 -- | Generates an ASCII character: @'\0'..'\127'@
 --
-ascii :: Monad m => Gen m Char
+ascii :: MonadGen m => m Char
 ascii =
   enum '\0' '\127'
 
 -- | Generates a Latin-1 character: @'\0'..'\255'@
 --
-latin1 :: Monad m => Gen m Char
+latin1 :: MonadGen m => m Char
 latin1 =
   enum '\0' '\255'
 
 -- | Generates a Unicode character, excluding invalid standalone surrogates:
 --   @'\0'..'\1114111' (excluding '\55296'..'\57343')@
 --
-unicode :: Monad m => Gen m Char
+unicode :: MonadGen m => m Char
 unicode =
   filter (not . isSurrogate) unicodeAll
 
 -- | Generates a Unicode character, including invalid standalone surrogates:
 --   @'\0'..'\1114111'@
 --
-unicodeAll :: Monad m => Gen m Char
+unicodeAll :: MonadGen m => m Char
 unicodeAll =
   enumBounded
 
@@ -785,26 +1062,26 @@
 --
 --   /This is a specialization of 'list', offered for convenience./
 --
-string :: Monad m => Range Int -> Gen m Char -> Gen m String
+string :: MonadGen m => Range Int -> m Char -> m String
 string =
   list
 
 -- | Generates a string using 'Range' to determine the length.
 --
-text :: Monad m => Range Int -> Gen m Char -> Gen m Text
+text :: MonadGen m => Range Int -> m Char -> m Text
 text range =
   fmap Text.pack . string range
 
 -- | Generates a UTF-8 encoded string, using 'Range' to determine the length.
 --
-utf8 :: Monad m => Range Int -> Gen m Char -> Gen m ByteString
+utf8 :: MonadGen m => Range Int -> m Char -> m ByteString
 utf8 range =
   fmap Text.encodeUtf8 . text range
 
 -- | Generates a random 'ByteString', using 'Range' to determine the
 --   length.
 --
-bytes :: Monad m => Range Int -> Gen m ByteString
+bytes :: MonadGen m => Range Int -> m ByteString
 bytes range =
   fmap ByteString.pack $
   choice [
@@ -823,7 +1100,7 @@
 -- | Trivial generator that always produces the same element.
 --
 --   /This is another name for 'pure' \/ 'return'./
-constant :: Monad m => a -> Gen m a
+constant :: MonadGen m => a -> m a
 constant =
   pure
 
@@ -833,7 +1110,7 @@
 --
 --   /The input list must be non-empty./
 --
-element :: Monad m => [a] -> Gen m a
+element :: MonadGen m => [a] -> m a
 element = \case
   [] ->
     error "Hedgehog.Gen.element: used with empty list"
@@ -847,7 +1124,7 @@
 --
 --   /The input list must be non-empty./
 --
-choice :: Monad m => [Gen m a] -> Gen m a
+choice :: MonadGen m => [m a] -> m a
 choice = \case
   [] ->
     error "Hedgehog.Gen.choice: used with empty list"
@@ -862,7 +1139,7 @@
 --
 --   /The input list must be non-empty./
 --
-frequency :: Monad m => [(Int, Gen m a)] -> Gen m a
+frequency :: MonadGen m => [(Int, m a)] -> m a
 frequency = \case
   [] ->
     error "Hedgehog.Gen.frequency: used with empty list"
@@ -901,10 +1178,10 @@
 --   | App Expr Expr
 --
 -- -- Assuming we have a name generator
--- genName :: 'Monad' m => 'Gen' m String
+-- genName :: 'MonadGen' m => m String
 --
 -- -- We can write a generator for expressions
--- genExpr :: 'Monad' m => 'Gen' m Expr
+-- genExpr :: 'MonadGen' m => m Expr
 -- genExpr =
 --   Gen.'recursive' Gen.'choice' [
 --       -- non-recursive generators
@@ -920,7 +1197,7 @@
 --   would fail to terminate. This is because for every call to @genExpr@,
 --   there is a 2 in 3 chance that we will recurse again.
 --
-recursive :: ([Gen m a] -> Gen m a) -> [Gen m a] -> [Gen m a] -> Gen m a
+recursive :: MonadGen m => ([m a] -> m a) -> [m a] -> [m a] -> m a
 recursive f nonrec rec =
   sized $ \n ->
     if n <= 1 then
@@ -933,12 +1210,21 @@
 
 -- | Discards the whole generator.
 --
---   /This is another name for 'empty' \/ 'mzero'./
---
-discard :: Monad m => Gen m a
+discard :: MonadGen m => m a
 discard =
-  mzero
+  liftGen mzero
 
+-- | Discards the generator if the generated value does not satisfy the
+--   predicate.
+--
+ensure :: MonadGen m => (a -> Bool) -> m a -> m a
+ensure p gen = do
+  x <- gen
+  if p x then
+    pure x
+  else
+    discard
+
 -- | Generates a value that satisfies a predicate.
 --
 --   This is essentially:
@@ -950,14 +1236,18 @@
 --   It differs from the above in that we keep some state to avoid looping
 --   forever. If we trigger these limits then the whole generator is discarded.
 --
-filter :: Monad m => (a -> Bool) -> Gen m a -> Gen m a
+filter :: MonadGen m => (a -> Bool) -> m a -> m a
 filter p gen =
   let
     try k =
       if k > 100 then
-        empty
-      else
-        mfilter p (scale (2 * k +) gen) <|> try (k + 1)
+        discard
+      else do
+        x <- scale (2 * k +) gen
+        if p x then
+          pure x
+        else
+          try (k + 1)
   in
     try 0
 
@@ -965,7 +1255,7 @@
 --
 --   This is implemented using 'filter' and has the same caveats.
 --
-just :: Monad m => Gen m (Maybe a) -> Gen m a
+just :: MonadGen m => m (Maybe a) -> m a
 just g = do
   mx <- filter Maybe.isJust g
   case mx of
@@ -979,7 +1269,7 @@
 
 -- | Generates a 'Nothing' some of the time.
 --
-maybe :: Monad m => Gen m a -> Gen m (Maybe a)
+maybe :: MonadGen m => m a -> m (Maybe a)
 maybe gen =
   sized $ \n ->
     frequency [
@@ -989,24 +1279,24 @@
 
 -- | Generates a list using a 'Range' to determine the length.
 --
-list :: Monad m => Range Int -> Gen m a -> Gen m [a]
+list :: MonadGen m => Range Int -> m a -> m [a]
 list range gen =
   sized $ \size ->
     (traverse snd =<<) .
-    mfilter (atLeast $ Range.lowerBound size range) .
+    ensure (atLeast $ Range.lowerBound size range) .
     shrink Shrink.list $ do
       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 :: MonadGen m => Range Int -> m a -> 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)
+nonEmpty :: MonadGen m => Range Int -> m a -> m (NonEmpty a)
 nonEmpty range gen = do
   xs <- list (fmap (max 1) range) gen
   case xs of
@@ -1021,7 +1311,7 @@
 --   /cannot produce a large enough number of unique items to satify/
 --   /the required set size./
 --
-set :: (Monad m, Ord a) => Range Int -> Gen m a -> Gen m (Set a)
+set :: (MonadGen m, Ord a) => Range Int -> m a -> m (Set a)
 set range gen =
   fmap Map.keysSet . map range $ fmap (, ()) gen
 
@@ -1031,10 +1321,10 @@
 --   /generator do not account for a large enough number of unique/
 --   /items to satify the required map size./
 --
-map :: (Monad m, Ord k) => Range Int -> Gen m (k, v) -> Gen m (Map k v)
+map :: (MonadGen m, Ord k) => Range Int -> m (k, v) -> m (Map k v)
 map range gen =
   sized $ \size ->
-    mfilter ((>= Range.lowerBound size range) . Map.size) .
+    ensure ((>= Range.lowerBound size range) . Map.size) .
     fmap Map.fromList .
     (sequence =<<) .
     shrink Shrink.list $ do
@@ -1043,12 +1333,12 @@
 
 -- | Generate exactly 'n' unique generators.
 --
-uniqueByKey :: (Monad m, Ord k) => Int -> Gen m (k, v) -> Gen m [Gen m (k, v)]
+uniqueByKey :: (MonadGen m, Ord k) => Int -> m (k, v) -> m [m (k, v)]
 uniqueByKey n gen =
   let
     try k xs0 =
       if k > 100 then
-        mzero
+        discard
       else
         replicateM n (freeze gen) >>= \kvs ->
         case uniqueInsert n xs0 (fmap (first fst) kvs) of
@@ -1101,6 +1391,16 @@
 deriving instance Foldable (Vec n)
 deriving instance Traversable (Vec n)
 
+-- | Freeze the size and seed used by a generator, so we can inspect the value
+--   which it will produce.
+--
+--   This is used for implementing `list` and `subtermMVec`. It allows us to
+--   shrink the list itself before trying to shrink the values inside the list.
+--
+freeze :: MonadGen m => m a -> m (a, m a)
+freeze =
+  freezeGen
+
 shrinkSubterms :: Subterms n a -> [Subterms n a]
 shrinkSubterms = \case
   One _ ->
@@ -1108,7 +1408,7 @@
   All xs ->
     fmap One $ toList xs
 
-genSubterms :: Monad m => Vec n (Gen m a) -> Gen m (Subterms n a)
+genSubterms :: MonadGen m => Vec n (m a) -> m (Subterms n a)
 genSubterms =
   (sequence =<<) .
   shrink shrinkSubterms .
@@ -1126,7 +1426,7 @@
 --
 --   /Shrinks to one of the sub-terms if possible./
 --
-subtermMVec :: Monad m => Vec n (Gen m a) -> (Vec n a -> Gen m a) -> Gen m a
+subtermMVec :: MonadGen m => Vec n (m a) -> (Vec n a -> m a) -> m a
 subtermMVec gs f =
   fromSubterms f =<< genSubterms gs
 
@@ -1134,7 +1434,7 @@
 --
 --   /Shrinks to the sub-term if possible./
 --
-subtermM :: Monad m => Gen m a -> (a -> Gen m a) -> Gen m a
+subtermM :: MonadGen m => m a -> (a -> m a) -> m a
 subtermM gx f =
   subtermMVec (gx :. Nil) $ \(x :. Nil) ->
     f x
@@ -1143,7 +1443,7 @@
 --
 --   /Shrinks to the sub-term if possible./
 --
-subterm :: Monad m => Gen m a -> (a -> a) -> Gen m a
+subterm :: MonadGen m => m a -> (a -> a) -> m a
 subterm gx f =
   subtermM gx $ \x ->
     pure (f x)
@@ -1152,7 +1452,7 @@
 --
 --   /Shrinks to one of the sub-terms if possible./
 --
-subtermM2 :: Monad m => Gen m a -> Gen m a -> (a -> a -> Gen m a) -> Gen m a
+subtermM2 :: MonadGen m => m a -> m a -> (a -> a -> m a) -> m a
 subtermM2 gx gy f =
   subtermMVec (gx :. gy :. Nil) $ \(x :. y :. Nil) ->
     f x y
@@ -1161,7 +1461,7 @@
 --
 --   /Shrinks to one of the sub-terms if possible./
 --
-subterm2 :: Monad m => Gen m a -> Gen m a -> (a -> a -> a) -> Gen m a
+subterm2 :: MonadGen m => m a -> m a -> (a -> a -> a) -> m a
 subterm2 gx gy f =
   subtermM2 gx gy $ \x y ->
     pure (f x y)
@@ -1170,7 +1470,7 @@
 --
 --   /Shrinks to one of the sub-terms if possible./
 --
-subtermM3 :: Monad m => Gen m a -> Gen m a -> Gen m a -> (a -> a -> a -> Gen m a) -> Gen m a
+subtermM3 :: MonadGen m => m a -> m a -> m a -> (a -> a -> a -> m a) -> m a
 subtermM3 gx gy gz f =
   subtermMVec (gx :. gy :. gz :. Nil) $ \(x :. y :. z :. Nil) ->
     f x y z
@@ -1179,7 +1479,7 @@
 --
 --   /Shrinks to one of the sub-terms if possible./
 --
-subterm3 :: Monad m => Gen m a -> Gen m a -> Gen m a -> (a -> a -> a -> a) -> Gen m a
+subterm3 :: MonadGen m => m a -> m a -> m a -> (a -> a -> a -> a) -> m a
 subterm3 gx gy gz f =
   subtermM3 gx gy gz $ \x y z ->
     pure (f x y z)
@@ -1189,7 +1489,7 @@
 
 -- | Generates a random subsequence of a list.
 --
-subsequence :: Monad m => [a] -> Gen m [a]
+subsequence :: MonadGen m => [a] -> m [a]
 subsequence xs =
   shrink Shrink.list $ filterM (const bool_) xs
 
@@ -1198,7 +1498,7 @@
 --   This shrinks towards the order of the list being identical to the input
 --   list.
 --
-shuffle :: Monad m => [a] -> Gen m [a]
+shuffle :: MonadGen m => [a] -> m [a]
 shuffle = \case
   [] ->
     pure []
@@ -1208,44 +1508,61 @@
       (xs, y : ys) ->
         (y :) <$> shuffle (xs ++ ys)
       (_, []) ->
-        error "Hedgehog.shuffle: internal error, split generated empty list"
+        error "Hedgehog.Gen.shuffle: internal error, split generated empty list"
 
 ------------------------------------------------------------------------
 -- Sampling
 
--- | Generate a random sample of data from the a generator.
+-- | Generate a sample from a generator.
 --
-sample :: MonadIO m => Gen m a -> m [a]
+sample :: MonadIO m => Gen a -> m a
 sample gen =
-  fmap (fmap nodeValue . Maybe.catMaybes) .
-  replicateM 10 $ do
-    seed <- liftIO Seed.random
-    runMaybeT . runTree $ runGen 30 seed gen
+  liftIO $
+    let
+      loop n =
+        if n <= 0 then
+          error "Hedgehog.Gen.sample: too many discards, could not generate a sample"
+        else do
+          seed <- Seed.random
+          case runIdentity . runMaybeT . runTree $ runGenT 30 seed gen of
+            Nothing ->
+              loop (n - 1)
+            Just x ->
+              pure $ nodeValue x
+    in
+      loop (100 :: Int)
 
 -- | Print the value produced by a generator, and the first level of shrinks,
 --   for the given size and seed.
 --
 --   Use 'print' to generate a value from a random seed.
 --
-printWith :: (MonadIO m, Show a) => Size -> Seed -> Gen m a -> m ()
-printWith size seed gen = do
-  Node x ss <- runTree $ renderNodes size seed gen
-  liftIO $ putStrLn "=== Outcome ==="
-  liftIO $ putStrLn x
-  liftIO $ putStrLn "=== Shrinks ==="
-  for_ ss $ \s -> do
-    Node y _ <- runTree s
-    liftIO $ putStrLn y
+printWith :: (MonadIO m, Show a) => Size -> Seed -> Gen a -> m ()
+printWith size seed gen =
+  liftIO $ do
+    let
+      Node x ss =
+        runIdentity . runTree $ renderNodes size seed gen
 
+    putStrLn "=== Outcome ==="
+    putStrLn x
+    putStrLn "=== Shrinks ==="
+
+    for_ ss $ \s ->
+      let
+        Node y _ =
+          runIdentity $ runTree s
+      in
+        putStrLn y
+
 -- | Print the shrink tree produced by a generator, for the given size and
 --   seed.
 --
 --   Use 'printTree' to generate a value from a random seed.
 --
-printTreeWith :: (MonadIO m, Show a) => Size -> Seed -> Gen m a -> m ()
+printTreeWith :: (MonadIO m, Show a) => Size -> Seed -> Gen a -> m ()
 printTreeWith size seed gen = do
-  s <- Tree.render $ renderNodes size seed gen
-  liftIO $ putStr s
+  liftIO . putStr . runIdentity . Tree.render $ renderNodes size seed gen
 
 -- | Run a generator with a random seed and print the outcome, and the first
 --   level of shrinks.
@@ -1261,7 +1578,7 @@
 --   > 'b'
 --   > 'c'
 --
-print :: (MonadIO m, Show a) => Gen m a -> m ()
+print :: (MonadIO m, Show a) => Gen a -> m ()
 print gen = do
   seed <- liftIO Seed.random
   printWith 30 seed gen
@@ -1283,16 +1600,16 @@
 --
 --   /This may not terminate when the tree is very large./
 --
-printTree :: (MonadIO m, Show a) => Gen m a -> m ()
+printTree :: (MonadIO m, Show a) => Gen a -> m ()
 printTree gen = do
   seed <- liftIO Seed.random
   printTreeWith 30 seed gen
 
 -- | Render a generator as a tree of strings.
 --
-renderNodes :: (Monad m, Show a) => Size -> Seed -> Gen m a -> Tree m String
+renderNodes :: (Monad m, Show a) => Size -> Seed -> Gen a -> Tree m String
 renderNodes size seed =
-  fmap (Maybe.maybe "<discard>" show) . runDiscardEffect . runGen size seed
+  fmap (Maybe.maybe "<discard>" show) . runDiscardEffect . runGenT size seed . lift
 
 ------------------------------------------------------------------------
 -- Internal
diff --git a/src/Hedgehog/Internal/Opaque.hs b/src/Hedgehog/Internal/Opaque.hs
--- a/src/Hedgehog/Internal/Opaque.hs
+++ b/src/Hedgehog/Internal/Opaque.hs
@@ -11,8 +11,10 @@
 --   For example:
 --
 -- @
---   data Ref v =
---     Ref (v (Opaque (IORef Int)))
+--   data State v =
+--     State {
+--         stateRefs :: [Var (Opaque (IORef Int)) v]
+--       } deriving (Eq, Show)
 -- @
 --
 newtype Opaque a =
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
@@ -8,66 +8,79 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-} -- MonadBase
+{-# LANGUAGE UndecidableInstances #-} -- Distributive
 module Hedgehog.Internal.Property (
   -- * Property
     Property(..)
+  , PropertyT(..)
   , PropertyName(..)
   , PropertyConfig(..)
   , TestLimit(..)
   , DiscardLimit(..)
   , ShrinkLimit(..)
-  , property
+  , ShrinkRetries(..)
   , withTests
   , withDiscards
   , withShrinks
+  , withRetries
+  , property
+  , test
+  , forAll
+  , forAllT
+  , forAllWith
+  , forAllWithT
+  , discard
 
   -- * Group
   , Group(..)
   , GroupName(..)
 
-  -- * Test
-  , Test(..)
+  -- * TestT
+  , MonadTest(..)
+  , Test
+  , TestT(..)
   , Log(..)
   , Failure(..)
   , Diff(..)
-  , forAll
-  , forAllWith
   , annotate
   , annotateShow
   , footnote
   , footnoteShow
-  , discard
   , failure
   , success
   , assert
   , (===)
 
-  , liftCatch
-  , liftCatchIO
-  , liftEither
-  , liftExceptT
-
-  , withCatch
-  , withExceptT
-  , withResourceT
+  , eval
+  , evalM
+  , evalIO
+  , evalEither
+  , evalExceptT
 
   -- * Internal
   -- $internal
   , defaultConfig
   , mapConfig
+  , failDiff
+  , failException
   , failWith
   , writeLog
+
+  , mkTest
+  , mkTestT
   , runTest
+  , runTestT
   ) where
 
 import           Control.Applicative (Alternative(..))
 import           Control.Monad (MonadPlus(..))
 import           Control.Monad.Base (MonadBase(..))
 import           Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
+import           Control.Monad.Catch (SomeException(..), displayException)
 import           Control.Monad.Error.Class (MonadError(..))
 import           Control.Monad.IO.Class (MonadIO(..))
 import           Control.Monad.Morph (MFunctor(..))
@@ -75,18 +88,32 @@
 import           Control.Monad.Reader.Class (MonadReader(..))
 import           Control.Monad.State.Class (MonadState(..))
 import           Control.Monad.Trans.Class (MonadTrans(..))
+import           Control.Monad.Trans.Cont (ContT)
+import           Control.Monad.Trans.Control (ComposeSt, defaultLiftBaseWith, defaultRestoreM)
+import           Control.Monad.Trans.Control (MonadBaseControl(..), MonadTransControl(..))
 import           Control.Monad.Trans.Except (ExceptT(..), runExceptT)
-import           Control.Monad.Trans.Resource (MonadResource(..), MonadResourceBase)
-import           Control.Monad.Trans.Resource (ResourceT, runResourceT)
-import           Control.Monad.Trans.Writer.Lazy (WriterT(..))
-import           Control.Monad.Writer.Class (MonadWriter(..))
+import           Control.Monad.Trans.Identity (IdentityT)
+import           Control.Monad.Trans.Maybe (MaybeT)
+import qualified Control.Monad.Trans.RWS.Lazy as Lazy
+import qualified Control.Monad.Trans.RWS.Strict as Strict
+import           Control.Monad.Trans.Reader (ReaderT)
+import           Control.Monad.Trans.Resource (MonadResource(..))
+import           Control.Monad.Trans.Resource (ResourceT)
+import qualified Control.Monad.Trans.State.Lazy as Lazy
+import qualified Control.Monad.Trans.State.Strict as Strict
+import qualified Control.Monad.Trans.Writer.Lazy as Lazy
+import qualified Control.Monad.Trans.Writer.Strict as Strict
 
+import qualified Data.Char as Char
+import           Data.Functor.Identity (Identity(..))
+import qualified Data.List as List
 import           Data.Semigroup (Semigroup)
 import           Data.String (IsString)
+import           Data.Typeable (typeOf)
 
 import           Hedgehog.Internal.Distributive
 import           Hedgehog.Internal.Exception
-import           Hedgehog.Internal.Gen (Gen)
+import           Hedgehog.Internal.Gen (Gen, GenT)
 import qualified Hedgehog.Internal.Gen as Gen
 import           Hedgehog.Internal.Show
 import           Hedgehog.Internal.Source
@@ -95,24 +122,63 @@
 
 ------------------------------------------------------------------------
 
--- | A property test to check, along with some configurable limits like how
---   many times to run the test.
+-- | A property test, along with some configurable limits like how many times
+--   to run the test.
 --
 data Property =
   Property {
       propertyConfig :: !PropertyConfig
-    , propertyTest :: Test IO ()
+    , propertyTest :: PropertyT IO ()
     }
 
--- | A property test.
+-- | The property monad transformer allows both the generation of test inputs
+--   and the assertion of expectations.
 --
-newtype Test m a =
-  Test {
-      unTest :: ExceptT Failure (WriterT [Log] (Gen m)) a
-    } deriving (Functor, Applicative)
+newtype PropertyT m a =
+  PropertyT {
+      unPropertyT :: TestT (GenT m) a
+    } deriving (
+      Functor
+    , Applicative
+    , Monad
+    , MonadIO
+    , MonadBase b
+    , MonadThrow
+    , MonadCatch
+    , MonadReader r
+    , MonadState s
+    , MonadError e
+    )
 
+-- | A test monad allows the assertion of expectations.
+--
+type Test =
+  TestT Identity
+
+-- | A test monad transformer allows the assertion of expectations.
+--
+newtype TestT m a =
+  TestT {
+      unTest :: ExceptT Failure (Lazy.WriterT [Log] m) a
+    } deriving (
+      Functor
+    , Applicative
+    , MonadIO
+    , MonadBase b
+    , MonadThrow
+    , MonadCatch
+    , MonadReader r
+    , MonadState s
+    )
+
 -- | The name of a property.
 --
+--   Can be constructed using `OverloadedStrings`:
+--
+-- @
+--   "apples" :: PropertyName
+-- @
+--
 newtype PropertyName =
   PropertyName {
       unPropertyName :: String
@@ -125,25 +191,64 @@
       propertyTestLimit :: !TestLimit
     , propertyDiscardLimit :: !DiscardLimit
     , propertyShrinkLimit :: !ShrinkLimit
+    , propertyShrinkRetries :: !ShrinkRetries
     } deriving (Eq, Ord, Show)
 
 -- | The number of successful tests that need to be run before a property test
 --   is considered successful.
 --
+--   Can be constructed using numeric literals:
+--
+-- @
+--   200 :: TestLimit
+-- @
+--
 newtype TestLimit =
   TestLimit Int
   deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
 
+-- | The number of discards to allow before giving up.
+--
+--   Can be constructed using numeric literals:
+--
+-- @
+--   10000 :: DiscardLimit
+-- @
+--
+--
+newtype DiscardLimit =
+  DiscardLimit Int
+  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
+
 -- | The number of shrinks to try before giving up on shrinking.
 --
+--   Can be constructed using numeric literals:
+--
+-- @
+--   1000 :: ShrinkLimit
+-- @
+--
 newtype ShrinkLimit =
   ShrinkLimit Int
   deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
 
--- | The number of discards to allow before giving up.
+-- | The number of times to re-run a test during shrinking. This is useful if
+--   you are testing something which fails non-deterministically and you want to
+--   increase the change of getting a good shrink.
 --
-newtype DiscardLimit =
-  DiscardLimit Int
+--   If you are doing parallel state machine testing, you should probably set
+--   shrink retries to something like @10@. This will mean that during
+--   shrinking, a parallel test case requires 10 successful runs before it is
+--   passes and we try a different shrink.
+--
+--   Can be constructed using numeric literals:
+--
+-- @
+--   0 :: ShrinkRetries
+-- @
+--
+newtype ShrinkRetries =
+  ShrinkRetries Int
   deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
 
 -- | A named collection of property tests.
@@ -156,6 +261,12 @@
 
 -- | The name of a group of properties.
 --
+--   Can be constructed using `OverloadedStrings`:
+--
+-- @
+--   "fruit" :: GroupName
+-- @
+--
 newtype GroupName =
   GroupName {
       unGroupName :: String
@@ -192,246 +303,238 @@
     , diffValue :: ValueDiff
     } deriving (Eq, Show)
 
-instance Monad m => Monad (Test m) where
+------------------------------------------------------------------------
+-- TestT
+
+instance Monad m => Monad (TestT m) where
   return =
-    Test . return
+    TestT . return
 
   (>>=) m k =
-    Test $
+    TestT $
       unTest m >>=
       unTest . k
 
   fail err =
-    Test . ExceptT . pure . Left $ Failure Nothing err Nothing
-
-instance Monad m => MonadPlus (Test m) where
-  mzero =
-    discard
-
-  mplus x y =
-    Test . ExceptT . WriterT $
-      mplus (runTest x) (runTest y)
-
-instance Monad m => Alternative (Test m) where
-  empty =
-    mzero
-  (<|>) =
-    mplus
+    TestT . ExceptT . pure . Left $ Failure Nothing err Nothing
 
-instance MonadTrans Test where
+instance MonadTrans TestT where
   lift =
-    Test . lift . lift . lift
+    TestT . lift . lift
 
-instance MFunctor Test where
+instance MFunctor TestT where
   hoist f =
-    Test . hoist (hoist (hoist f)) . unTest
-
-distributeTest :: Transformer t Test m => Test (t m) a -> t (Test m) a
-distributeTest =
-  hoist Test .
-  distribute .
-  hoist distribute .
-  hoist (hoist distribute) .
-  unTest
+    TestT . hoist (hoist f) . unTest
 
-instance Distributive Test where
-  type Transformer t Test m = (
-      Transformer t Gen m
-    , Transformer t (WriterT [Log]) (Gen m)
-    , Transformer t (ExceptT Failure) (WriterT [Log] (Gen m))
+instance Distributive TestT where
+  type Transformer t TestT m = (
+      Transformer t (Lazy.WriterT [Log]) m
+    , Transformer t (ExceptT Failure) (Lazy.WriterT [Log] m)
     )
 
   distribute =
-    distributeTest
+    hoist TestT .
+    distribute .
+    hoist distribute .
+    unTest
 
-instance PrimMonad m => PrimMonad (Test m) where
-  type PrimState (Test m) =
+instance PrimMonad m => PrimMonad (TestT m) where
+  type PrimState (TestT m) =
     PrimState m
   primitive =
     lift . primitive
 
-instance MonadIO m => MonadIO (Test m) where
-  liftIO =
-    lift . liftIO
-
-instance MonadBase b m => MonadBase b (Test m) where
-  liftBase =
-    lift . liftBase
-
-instance MonadThrow m => MonadThrow (Test m) where
-  throwM =
-    lift . throwM
-
-instance MonadCatch m => MonadCatch (Test m) where
-  catch m onErr =
-    Test $
-      (unTest m) `catch`
-      (unTest . onErr)
-
-instance MonadReader r m => MonadReader r (Test m) where
-  ask =
-    lift ask
-  local f m =
-    Test $
-      local f (unTest m)
-
-instance MonadState s m => MonadState s (Test m) where
-  get =
-    lift get
-  put =
-    lift . put
-  state =
-    lift . state
-
--- FIXME instance MonadWriter Test
+-- FIXME instance MonadWriter w m => MonadWriter w (TestT m)
 
-instance MonadError e m => MonadError e (Test m) where
+instance MonadError e m => MonadError e (TestT m) where
   throwError =
     lift . throwError
   catchError m onErr =
-    Test . ExceptT $
+    TestT . ExceptT $
       (runExceptT $ unTest m) `catchError`
       (runExceptT . unTest . onErr)
 
-instance MonadResource m => MonadResource (Test m) where
+instance MonadResource m => MonadResource (TestT m) where
   liftResourceT =
     lift . liftResourceT
 
-------------------------------------------------------------------------
--- Property
+instance MonadTransControl TestT where
+  type StT TestT a =
+    (Either Failure a, [Log])
 
--- | The default configuration for a property test.
---
-defaultConfig :: PropertyConfig
-defaultConfig =
-  PropertyConfig {
-      propertyTestLimit =
-        100
-    , propertyDiscardLimit =
-        100
-    , propertyShrinkLimit =
-        1000
-    }
+  liftWith f =
+    mkTestT . fmap (, []) . fmap Right $ f $ runTestT
 
--- | Map a config modification function over a property.
---
-mapConfig :: (PropertyConfig -> PropertyConfig) -> Property -> Property
-mapConfig f (Property cfg t) =
-  Property (f cfg) t
+  restoreT =
+    mkTestT
 
--- | Set the number times a property should be executed before it is considered
---   successful.
---
-withTests :: TestLimit -> Property -> Property
-withTests n =
-  mapConfig $ \config -> config { propertyTestLimit = n }
+instance MonadBaseControl b m => MonadBaseControl b (TestT m) where
+  type StM (TestT m) a =
+    ComposeSt TestT m a
 
--- | Set the number times a property is allowed to discard before the test
---   runner gives up.
---
-withDiscards :: DiscardLimit -> Property -> Property
-withDiscards n =
-  mapConfig $ \config -> config { propertyDiscardLimit = n }
+  liftBaseWith =
+    defaultLiftBaseWith
 
--- | Set the number times a property is allowed to shrink before the test
---   runner gives up and prints the counterexample.
---
-withShrinks :: ShrinkLimit -> Property -> Property
-withShrinks n =
-  mapConfig $ \config -> config { propertyShrinkLimit = n }
+  restoreM =
+    defaultRestoreM
 
--- | Creates a property to check.
---
-property :: Test IO () -> Property
-property =
-  Property defaultConfig
+class Monad m => MonadTest m where
+  liftTest :: Test a -> m a
 
-------------------------------------------------------------------------
--- Test
+instance Monad m => MonadTest (TestT m) where
+  liftTest =
+    hoist (pure . runIdentity)
 
-runTest :: Test m a -> Gen m (Either Failure a, [Log])
-runTest =
-  runWriterT . runExceptT . unTest
+instance MonadTest m => MonadTest (IdentityT m) where
+  liftTest =
+    lift . liftTest
 
-writeLog :: Monad m => Log -> Test m ()
-writeLog =
-  Test . lift . tell . pure
+instance MonadTest m => MonadTest (MaybeT m) where
+  liftTest =
+    lift . liftTest
 
--- | Generates a random input for the test by running the provided generator.
---
-forAll :: (Monad m, Show a, HasCallStack) => Gen m a -> Test m a
-forAll gen =
-  withFrozenCallStack $ forAllWith showPretty gen
+instance MonadTest m => MonadTest (ExceptT x m) where
+  liftTest =
+    lift . liftTest
 
--- | Generates a random input for the test by running the provided generator.
+instance MonadTest m => MonadTest (ReaderT r m) where
+  liftTest =
+    lift . liftTest
+
+instance MonadTest m => MonadTest (Lazy.StateT s m) where
+  liftTest =
+    lift . liftTest
+
+instance MonadTest m => MonadTest (Strict.StateT s m) where
+  liftTest =
+    lift . liftTest
+
+instance (MonadTest m, Monoid w) => MonadTest (Lazy.WriterT w m) where
+  liftTest =
+    lift . liftTest
+
+instance (MonadTest m, Monoid w) => MonadTest (Strict.WriterT w m) where
+  liftTest =
+    lift . liftTest
+
+instance (MonadTest m, Monoid w) => MonadTest (Lazy.RWST r w s m) where
+  liftTest =
+    lift . liftTest
+
+instance (MonadTest m, Monoid w) => MonadTest (Strict.RWST r w s m) where
+  liftTest =
+    lift . liftTest
+
+instance MonadTest m => MonadTest (ContT r m) where
+  liftTest =
+    lift . liftTest
+
+instance MonadTest m => MonadTest (ResourceT m) where
+  liftTest =
+    lift . liftTest
+
+mkTestT :: m (Either Failure a, [Log]) -> TestT m a
+mkTestT =
+  TestT . ExceptT . Lazy.WriterT
+
+mkTest :: (Either Failure a, [Log]) -> Test a
+mkTest =
+  mkTestT . Identity
+
+runTestT :: TestT m a -> m (Either Failure a, [Log])
+runTestT =
+  Lazy.runWriterT . runExceptT . unTest
+
+runTest :: Test a -> (Either Failure a, [Log])
+runTest =
+  runIdentity . runTestT
+
+-- | Log some information which might be relevant to a potential test failure.
 --
---   /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./
+writeLog :: MonadTest m => Log -> m ()
+writeLog x =
+  liftTest $ mkTest (pure (), [x])
+
+-- | Fail the test with an error message, useful for building other failure
+--   combinators.
 --
-forAllWith :: (Monad m, HasCallStack) => (a -> String) -> Gen m a -> Test m a
-forAllWith render gen = do
-  x <- Test . lift $ lift gen
-  withFrozenCallStack $ annotate (render x)
-  return x
+failWith :: (MonadTest m, HasCallStack) => Maybe Diff -> String -> m a
+failWith diff msg =
+  liftTest $ mkTest (Left $ Failure (getCaller callStack) msg diff, [])
 
 -- | Annotates the source code with a message that might be useful for
 --   debugging a test failure.
 --
-annotate :: (Monad m, HasCallStack) => String -> Test m ()
+annotate :: (MonadTest m, HasCallStack) => String -> 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 :: (MonadTest m, Show a, HasCallStack) => a -> 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 :: MonadTest m => String -> 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 :: (MonadTest m, Show a) => a -> m ()
 footnoteShow =
   writeLog . Footnote . showPretty
 
--- | Discards a test entirely.
+-- | Fails with an error which shows the difference between two values.
 --
-discard :: Monad m => Test m a
-discard =
-  Test . lift $ lift Gen.discard
+failDiff :: (MonadTest m, Show a, Show b, HasCallStack) => a -> b -> m ()
+failDiff x y =
+  case valueDiff <$> mkValue x <*> mkValue y of
+    Nothing ->
+      withFrozenCallStack $
+        failWith Nothing $ unlines [
+            "━━━ Not Equal ━━━"
+          , showPretty x
+          , showPretty y
+          ]
+    Just diff ->
+      withFrozenCallStack $
+        failWith (Just $ Diff "Failed (" "- lhs" "=/=" "+ rhs" ")" diff) ""
 
--- | Fail with an error message, useful for building other failure combinators.
+-- | Fails with an error which renders the type of an exception and its error
+--   message.
 --
-failWith :: (Monad m, HasCallStack) => Maybe Diff -> String -> Test m a
-failWith diff msg =
-  Test . ExceptT . pure . Left $ Failure (getCaller callStack) msg diff
+failException :: (MonadTest m, HasCallStack) => SomeException -> m a
+failException (SomeException x) =
+  withFrozenCallStack $
+    failWith Nothing $ unlines [
+        "━━━ Exception: " ++ show (typeOf x) ++ " ━━━"
+      , List.dropWhileEnd Char.isSpace (displayException x)
+      ]
 
 -- | Causes a test to fail.
 --
-failure :: (Monad m, HasCallStack) => Test m a
+failure :: (MonadTest m, HasCallStack) => m a
 failure =
   withFrozenCallStack $ failWith Nothing ""
 
 -- | Another name for @pure ()@.
 --
-success :: Monad m => Test m ()
+success :: MonadTest m => m ()
 success =
-  Test $ pure ()
+  pure ()
 
 -- | Fails the test if the condition provided is 'False'.
 --
-assert :: (Monad m, HasCallStack) => Bool -> Test m ()
-assert b =
-  if b then
+assert :: (MonadTest m, HasCallStack) => Bool -> m ()
+assert b = do
+  ok <- withFrozenCallStack $ eval b
+  if ok then
     success
   else
     withFrozenCallStack failure
@@ -440,28 +543,44 @@
 
 -- | Fails the test if the two arguments provided are not equal.
 --
-(===) :: (Monad m, Eq a, Show a, HasCallStack) => a -> a -> Test m ()
-(===) x y =
-  if x == y then
+(===) :: (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m ()
+(===) x y = do
+  ok <- withFrozenCallStack $ eval (x == y)
+  if ok then
     success
   else
-    case valueDiff <$> mkValue x <*> mkValue y of
-      Nothing ->
-        withFrozenCallStack $
-          failWith Nothing $ unlines [
-              "━━━ Not Equal ━━━"
-            , showPretty x
-            , showPretty y
-            ]
-      Just diff ->
-        withFrozenCallStack $
-          failWith (Just $ Diff "Failed (" "- lhs" "=/=" "+ rhs" ")" diff) ""
+    withFrozenCallStack $ failDiff x y
 
+-- | Fails the test if the value throws an exception when evaluated to weak
+--   head normal form (WHNF).
+--
+eval :: (MonadTest m, HasCallStack) => a -> m a
+eval x =
+  either (withFrozenCallStack failException) pure (tryEvaluate x)
+
+-- | Fails the test if the action throws an exception.
+--
+--   /The benefit of using this over simply letting the exception bubble up is/
+--   /that the location of the closest 'evalM' will be shown in the output./
+--
+evalM :: (MonadTest m, MonadCatch m, HasCallStack) => m a -> m a
+evalM m =
+  either (withFrozenCallStack failException) pure =<< tryAll m
+
+-- | Fails the test if the 'IO' action throws an exception.
+--
+--   /The benefit of using this over 'liftIO' is that the location of the/
+--   /exception will be shown in the output./
+--
+evalIO :: (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a
+evalIO m =
+  either (withFrozenCallStack failException) pure =<< liftIO (tryAll m)
+
 -- | Fails the test if the 'Either' is 'Left', otherwise returns the value in
 --   the 'Right'.
 --
-liftEither :: (Monad m, Show x, HasCallStack) => Either x a -> Test m a
-liftEither = \case
+evalEither :: (MonadTest m, Show x, HasCallStack) => Either x a -> m a
+evalEither = \case
   Left x ->
     withFrozenCallStack $ failWith Nothing $ showPretty x
   Right x ->
@@ -470,63 +589,190 @@
 -- | Fails the test if the 'ExceptT' is 'Left', otherwise returns the value in
 --   the 'Right'.
 --
-liftExceptT :: (Monad m, Show x, HasCallStack) => ExceptT x m a -> Test m a
-liftExceptT m =
-  withFrozenCallStack liftEither =<< lift (runExceptT m)
+evalExceptT :: (MonadTest m, Show x, HasCallStack) => ExceptT x m a -> m a
+evalExceptT m =
+  withFrozenCallStack evalEither =<< runExceptT m
 
--- | Fails the test if the action throws an exception.
+------------------------------------------------------------------------
+-- PropertyT
+
+instance MonadTrans PropertyT where
+  lift =
+    PropertyT . lift . lift
+
+instance MFunctor PropertyT where
+  hoist f =
+    PropertyT . hoist (hoist f) . unPropertyT
+
+instance Distributive PropertyT where
+  type Transformer t PropertyT m = (
+      Transformer t GenT m
+    , Transformer t TestT (GenT m)
+    )
+
+  distribute =
+    hoist PropertyT .
+    distribute .
+    hoist distribute .
+    unPropertyT
+
+instance PrimMonad m => PrimMonad (PropertyT m) where
+  type PrimState (PropertyT m) =
+    PrimState m
+  primitive =
+    lift . primitive
+
+---- FIXME instance MonadWriter w m => MonadWriter w (PropertyT m)
+
+instance Monad m => MonadTest (PropertyT m) where
+  liftTest =
+    PropertyT . hoist (pure . runIdentity)
+
+instance MonadPlus m => MonadPlus (PropertyT m) where
+  mzero =
+    discard
+
+  mplus (PropertyT x) (PropertyT y) =
+    PropertyT . mkTestT $
+      mplus (runTestT x) (runTestT y)
+
+instance MonadPlus m => Alternative (PropertyT m) where
+  empty =
+    mzero
+  (<|>) =
+    mplus
+
+-- | Generates a random input for the test by running the provided generator.
 --
---   /The benefit of using this over 'lift' is that the location of the
---   exception will be shown in the output./
+--   /This is a the same as 'forAllT' but allows the user to provide a custom/
+--   /rendering function. This is useful for values which don't have a/
+--   /'Show' instance./
 --
-liftCatch :: (MonadCatch m, HasCallStack) => m a -> Test m a
-liftCatch m =
-  withFrozenCallStack liftEither =<< lift (tryAll m)
+forAllWithT :: (Monad m, HasCallStack) => (a -> String) -> GenT m a -> PropertyT m a
+forAllWithT render gen = do
+  x <- PropertyT $ lift gen
+  withFrozenCallStack $ annotate (render x)
+  return x
 
--- | Fails the test if the action throws an exception.
+-- | Generates a random input for the test by running the provided generator.
 --
---   /The benefit of using this over 'liftIO' is that the location of the
---   exception will be shown in the output./
+--   /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./
 --
-liftCatchIO :: (MonadIO m, HasCallStack) => IO a -> Test m a
-liftCatchIO m =
-  withFrozenCallStack liftEither =<< liftIO (tryAll m)
+forAllWith :: (Monad m, HasCallStack) => (a -> String) -> Gen a -> PropertyT m a
+forAllWith render gen =
+  withFrozenCallStack $ forAllWithT render $ Gen.lift gen
 
--- | Fails the test if the 'ExceptT' is 'Left', otherwise returns the value in
---   the 'Right'.
+-- | Generates a random input for the test by running the provided generator.
 --
-withExceptT :: (Monad m, Show x, HasCallStack) => Test (ExceptT x m) a -> Test m a
-withExceptT m =
-  withFrozenCallStack liftEither =<< runExceptT (distribute m)
+forAllT :: (Monad m, Show a, HasCallStack) => GenT m a -> PropertyT m a
+forAllT gen =
+  withFrozenCallStack $ forAllWithT showPretty gen
 
--- | Fails the test if the action throws an exception.
+-- | Generates a random input for the test by running the provided generator.
 --
---   /The benefit of using this over simply letting the exception bubble up is
---   that the location of the closest 'withCatch' will be shown in the output./
+forAll :: (Monad m, Show a, HasCallStack) => Gen a -> PropertyT m a
+forAll gen =
+  withFrozenCallStack $ forAllWith showPretty gen
+
+-- | Discards the current test entirely.
 --
-withCatch :: (MonadCatch m, HasCallStack) => Test m a -> Test m a
-withCatch m =
-  withFrozenCallStack liftEither =<< tryAll m
+discard :: Monad m => PropertyT m a
+discard =
+  PropertyT $ lift Gen.discard
 
--- | Run a computation which requires resource acquisition / release.
+-- | Lift a test in to a property.
 --
---   /Note that if you 'Control.Monad.Trans.Resource.allocate' anything before/
---   /a 'forAll' you will likely encounter unexpected behaviour, due to the way/
---   /'ResourceT' interacts with the control flow introduced by shrinking./
+--   Because both 'TestT' and 'PropertyT' have 'MonadTest' instances, this
+--   function is not often required. It can however be useful for writing
+--   functions directly in 'TestT' and thus gaining a 'MonadTransControl'
+--   instance at the expense of not being able to generate additional inputs
+--   using 'forAll'.
 --
-withResourceT :: MonadResourceBase m => Test (ResourceT m) a -> Test m a
-withResourceT =
-  hoist runResourceT
+--   One use case for this is writing tests which use 'ResourceT':
+--
+-- @
+--   property $ do
+--     n <- forAll $ Gen.int64 Range.linearBounded
+--     test . runResourceT $ do
+--       -- test with resource usage here
+-- @
+--
+test :: Monad m => TestT m a -> PropertyT m a
+test =
+  PropertyT . hoist lift
 
 ------------------------------------------------------------------------
+-- Property
+
+-- | The default configuration for a property test.
+--
+defaultConfig :: PropertyConfig
+defaultConfig =
+  PropertyConfig {
+      propertyTestLimit =
+        100
+    , propertyDiscardLimit =
+        100
+    , propertyShrinkLimit =
+        1000
+    , propertyShrinkRetries =
+        0
+    }
+
+-- | Map a config modification function over a property.
+--
+mapConfig :: (PropertyConfig -> PropertyConfig) -> Property -> Property
+mapConfig f (Property cfg t) =
+  Property (f cfg) t
+
+-- | Set the number times a property should be executed before it is considered
+--   successful.
+--
+withTests :: TestLimit -> Property -> Property
+withTests n =
+  mapConfig $ \config -> config { propertyTestLimit = n }
+
+-- | Set the number times a property is allowed to discard before the test
+--   runner gives up.
+--
+withDiscards :: DiscardLimit -> Property -> Property
+withDiscards n =
+  mapConfig $ \config -> config { propertyDiscardLimit = n }
+
+-- | Set the number times a property is allowed to shrink before the test
+--   runner gives up and prints the counterexample.
+--
+withShrinks :: ShrinkLimit -> Property -> Property
+withShrinks n =
+  mapConfig $ \config -> config { propertyShrinkLimit = n }
+
+-- | Set the number times a property will be executed for each shrink before
+--   the test runner gives up and tries a different shrink. See 'ShrinkRetries'
+--   for more information.
+--
+withRetries :: ShrinkRetries -> Property -> Property
+withRetries n =
+  mapConfig $ \config -> config { propertyShrinkRetries = n }
+
+-- | Creates a property with the default configuration.
+--
+property :: HasCallStack => PropertyT IO () -> Property
+property m =
+  Property defaultConfig $
+    withFrozenCallStack (evalM m)
+
+------------------------------------------------------------------------
 -- FIXME Replace with DeriveLift when we drop 7.10 support.
 
 $(deriveLift ''GroupName)
 $(deriveLift ''PropertyName)
 $(deriveLift ''PropertyConfig)
 $(deriveLift ''TestLimit)
-$(deriveLift ''ShrinkLimit)
 $(deriveLift ''DiscardLimit)
+$(deriveLift ''ShrinkLimit)
+$(deriveLift ''ShrinkRetries)
 
 ------------------------------------------------------------------------
 -- Internal
diff --git a/src/Hedgehog/Internal/Queue.hs b/src/Hedgehog/Internal/Queue.hs
--- a/src/Hedgehog/Internal/Queue.hs
+++ b/src/Hedgehog/Internal/Queue.hs
@@ -6,7 +6,7 @@
 
   , runTasks
   , finalizeTask
- 
+
   , runActiveFinalizers
   , dequeueMVar
 
diff --git a/src/Hedgehog/Internal/Region.hs b/src/Hedgehog/Internal/Region.hs
--- a/src/Hedgehog/Internal/Region.hs
+++ b/src/Hedgehog/Internal/Region.hs
@@ -1,8 +1,8 @@
 module Hedgehog.Internal.Region (
     Region(..)
   , newEmptyRegion
-  , newRegion
-  , forceRegion
+  , newOpenRegion
+  , openRegion
   , setRegion
   , displayRegions
   , displayRegion
@@ -10,7 +10,7 @@
   , finishRegion
   ) where
 
-import           Control.Concurrent.STM (STM, TVar, atomically)
+import           Control.Concurrent.STM (STM, TVar)
 import qualified Control.Concurrent.STM.TMVar as TMVar
 import qualified Control.Concurrent.STM.TVar as TVar
 import           Control.Monad.Catch (MonadMask(..), bracket)
@@ -20,59 +20,61 @@
 import qualified System.Console.Regions as Console
 
 
+data Body =
+    Empty
+  | Open ConsoleRegion
+  | Closed
+
 newtype Region =
   Region {
-      unRegion :: TVar (Maybe ConsoleRegion)
+      unRegion :: TVar Body
     }
 
 newEmptyRegion :: LiftRegion m => m Region
 newEmptyRegion =
   liftRegion $ do
-    ref <- TVar.newTVar Nothing
+    ref <- TVar.newTVar Empty
     pure $ Region ref
 
-newRegion :: LiftRegion m => m Region
-newRegion =
+newOpenRegion :: LiftRegion m => m Region
+newOpenRegion =
   liftRegion $ do
     region <- Console.openConsoleRegion Linear
-    ref <- TVar.newTVar $ Just region
+    ref <- TVar.newTVar $ Open region
     pure $ Region ref
 
-forceRegion :: LiftRegion m => Region -> String -> m ()
-forceRegion (Region var) content =
+openRegion :: LiftRegion m => Region -> String -> m ()
+openRegion (Region var) content =
   liftRegion $ do
-    mregion <- TVar.readTVar var
-    case mregion of
-      Nothing -> do
+    body <- TVar.readTVar var
+    case body of
+      Empty -> do
         region <- Console.openConsoleRegion Linear
-        TVar.writeTVar var $ Just region
+        TVar.writeTVar var $ Open region
         Console.setConsoleRegion region content
 
-      Just region ->
+      Open region ->
         Console.setConsoleRegion region content
 
+      Closed ->
+        pure ()
+
 setRegion :: LiftRegion m => Region -> String -> m ()
 setRegion (Region var) content =
   liftRegion $ do
-    mregion <- TVar.readTVar var
-    case mregion of
-      Nothing -> do
+    body <- TVar.readTVar var
+    case body of
+      Empty ->
         pure ()
 
-      Just region ->
+      Open 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 ->
+      Closed ->
         pure ()
-      Just _xs ->
-        TMVar.putTMVar Console.regionList []
 
+displayRegions :: (MonadIO m, MonadMask m) => m a -> m a
+displayRegions io =
   Console.displayConsoleRegions io
 
 displayRegion ::
@@ -82,29 +84,44 @@
   => (Region -> m a)
   -> m a
 displayRegion =
-  displayRegions . bracket newRegion finishRegion
+  displayRegions . bracket newOpenRegion 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)
+moveToBottom :: Region -> STM ()
+moveToBottom (Region var) =
+  liftRegion $ do
+    body <- TVar.readTVar var
+    case body of
+      Empty ->
+        pure ()
 
+      Open 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)
+
+      Closed ->
+        pure ()
+
 finishRegion :: LiftRegion m => Region -> m ()
 finishRegion (Region var) =
   liftRegion $ do
-    mregion <- TVar.readTVar var
-    case mregion of
-      Nothing ->
-        pure ()
+    body <- TVar.readTVar var
+    case body of
+      Empty -> do
+        TVar.writeTVar var Closed
 
-      Just region -> do
+      Open region -> do
         content <- Console.getConsoleRegion region
         Console.finishConsoleRegion region content
+        TVar.writeTVar var Closed
+
+      Closed ->
+        pure ()
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
@@ -29,11 +29,11 @@
 import           Data.Semigroup ((<>))
 
 import           Hedgehog.Internal.Config
-import           Hedgehog.Internal.Gen (runGen, runDiscardEffect)
+import           Hedgehog.Internal.Gen (runGenT, runDiscardEffect)
 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.Property (ShrinkLimit, ShrinkRetries, withTests)
+import           Hedgehog.Internal.Property (PropertyT(..), Log(..), Failure(..), runTestT)
 import           Hedgehog.Internal.Queue
 import           Hedgehog.Internal.Region
 import           Hedgehog.Internal.Report
@@ -44,10 +44,7 @@
 
 import           Language.Haskell.TH.Lift (deriveLift)
 
-import           System.Console.Regions (ConsoleRegion, RegionLayout(..))
-import qualified System.Console.Regions as Console
 
-
 -- | Configuration for a property test run.
 --
 data RunnerConfig =
@@ -85,16 +82,33 @@
   _ ->
     False
 
+isSuccess :: Node m (Maybe (Either x a, b)) -> Bool
+isSuccess =
+  not . isFailure
+
+runTreeN ::
+     Monad m
+  => ShrinkRetries
+  -> Tree m (Maybe (Either x a, b))
+  -> m (Node m (Maybe (Either x a, b)))
+runTreeN n m = do
+  o <- runTree m
+  if n > 0 && isSuccess o then
+    runTreeN (n - 1) m
+  else
+    pure o
+
 takeSmallest ::
      MonadIO m
   => Size
   -> Seed
   -> ShrinkCount
   -> ShrinkLimit
+  -> ShrinkRetries
   -> (Progress -> m ())
   -> Node m (Maybe (Either Failure (), [Log]))
   -> m Result
-takeSmallest size seed shrinks slimit updateUI = \case
+takeSmallest size seed shrinks slimit retries updateUI = \case
   Node Nothing _ ->
     pure GaveUp
 
@@ -112,9 +126,9 @@
           pure $ Failed failure
         else
           findM xs (Failed failure) $ \m -> do
-            o <- runTree m
+            o <- runTreeN retries m
             if isFailure o then
-              Just <$> takeSmallest size seed (shrinks + 1) slimit updateUI o
+              Just <$> takeSmallest size seed (shrinks + 1) slimit retries updateUI o
             else
               return Nothing
 
@@ -128,7 +142,7 @@
   => PropertyConfig
   -> Size
   -> Seed
-  -> Test m ()
+  -> PropertyT m ()
   -> (Report Progress -> m ())
   -> m (Report Result)
 checkReport cfg size0 seed0 test0 updateUI =
@@ -156,7 +170,7 @@
         case Seed.split seed of
           (s0, s1) -> do
             node@(Node x _) <-
-              runTree . runDiscardEffect $ runGen size s0 (runTest test)
+              runTree . runDiscardEffect $ runGenT size s0 . runTestT $ unPropertyT test
             case x of
               Nothing ->
                 loop tests (discards + 1) (size + 1) s1
@@ -172,6 +186,7 @@
                       seed
                       0
                       (propertyShrinkLimit cfg)
+                      (propertyShrinkRetries cfg)
                       (updateUI . mkReport)
                       node
 
@@ -198,14 +213,14 @@
           Running ->
             setRegion region ppprogress
           Shrinking _ ->
-            forceRegion region ppprogress
+            openRegion region ppprogress
 
     ppresult <- renderResult mcolor name result
     case reportStatus result of
       Failed _ ->
-        forceRegion region ppresult
+        openRegion region ppresult
       GaveUp ->
-        forceRegion region ppresult
+        openRegion region ppresult
       OK ->
         setRegion region ppresult
 
@@ -258,10 +273,10 @@
       summaryFailed summary == 0 &&
       summaryGaveUp summary == 0
 
-updateSummary :: ConsoleRegion -> TVar Summary -> Maybe UseColor -> (Summary -> Summary) -> IO ()
+updateSummary :: Region -> 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
+  setRegion sregion =<< renderSummary mcolor summary
 
 checkGroupWith ::
      WorkerCount
@@ -270,8 +285,7 @@
   -> [(PropertyName, Property)]
   -> IO Summary
 checkGroupWith n verbosity mcolor props =
-  displayRegions $ do
-    sregion <- Console.openConsoleRegion Linear
+  displayRegion $ \sregion -> do
     svar <- atomically . TVar.newTVar $ mempty { summaryWaiting = PropertyCount (length props) }
 
     let
@@ -290,7 +304,7 @@
                 Quiet ->
                   newEmptyRegion
                 Normal ->
-                  newRegion
+                  newOpenRegion
 
             moveToBottom sregion
 
@@ -314,8 +328,6 @@
           pure result
 
     updateSummary sregion svar mcolor (const summary)
-    Console.finishConsoleRegion sregion =<< Console.getConsoleRegion sregion
-
     pure summary
 
 -- | Check a group of properties sequentially.
diff --git a/src/Hedgehog/Internal/State.hs b/src/Hedgehog/Internal/State.hs
--- a/src/Hedgehog/Internal/State.hs
+++ b/src/Hedgehog/Internal/State.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DoAndIfThenElse #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
@@ -14,8 +15,12 @@
 module Hedgehog.Internal.State (
   -- * Variables
     Var(..)
-  , Symbolic(..)
+  , concrete
+  , opaque
+
   , Concrete(..)
+  , Symbolic(..)
+  , Name(..)
 
   -- * Environment
   , Environment(..)
@@ -33,49 +38,60 @@
 
   -- * Actions
   , Action(..)
+  , Sequential(..)
+  , Parallel(..)
   , takeVariables
   , variablesOK
   , dropInvalid
   , action
-  , actions
-  , execute
+  , sequential
+  , parallel
   , executeSequential
+  , executeParallel
   ) where
 
-import           Control.Monad (when, foldM_)
+import qualified Control.Concurrent.Async.Lifted as Async
+import           Control.Monad (foldM, foldM_)
 import           Control.Monad.Catch (MonadCatch)
-import           Control.Monad.Morph (hoist)
-import           Control.Monad.State.Class (get, put, modify)
+import           Control.Monad.State.Class (MonadState, get, put, modify)
 import           Control.Monad.Trans.Class (lift)
-import           Control.Monad.Trans.State (StateT, execState, evalStateT)
+import           Control.Monad.Trans.Control (MonadBaseControl)
+import           Control.Monad.Trans.State (State, runState, execState)
+import           Control.Monad.Trans.State (StateT(..), evalStateT)
 
 import           Data.Dynamic (Dynamic, toDyn, fromDynamic, dynTypeRep)
 import           Data.Foldable (traverse_)
-import           Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), showsPrec1)
+import           Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..))
+import           Data.Functor.Classes (eq1, compare1, showsPrec1)
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.Maybe as Maybe
 import           Data.Typeable (Typeable, TypeRep, Proxy(..), typeRep)
 
-import           Hedgehog.Internal.Gen (Gen)
+import           Hedgehog.Internal.Gen (MonadGen)
 import qualified Hedgehog.Internal.Gen as Gen
 import           Hedgehog.Internal.HTraversable (HTraversable(..))
-import           Hedgehog.Internal.Property (Test, liftEither, withCatch, success)
-import qualified Hedgehog.Internal.Shrink as Shrink
-import           Hedgehog.Internal.Source (HasCallStack, withFrozenCallStack)
+import           Hedgehog.Internal.Opaque (Opaque(..))
+import           Hedgehog.Internal.Property (MonadTest(..), Test, evalEither, evalM, success, runTest, failWith)
 import           Hedgehog.Internal.Range (Range)
+import           Hedgehog.Internal.Show (showPretty)
+import           Hedgehog.Internal.Source (HasCallStack, withFrozenCallStack)
 
 
 -- | Symbolic variable names.
 --
-newtype Var =
-  Var Int
-  deriving (Eq, Ord, Show, Num)
+newtype Name =
+  Name Int
+  deriving (Eq, Ord, Num)
 
+instance Show Name where
+  showsPrec p (Name x) =
+    showsPrec p x
+
 -- | Symbolic values.
 --
 data Symbolic a where
-  Symbolic :: Typeable a => Var -> Symbolic a
+  Symbolic :: Typeable a => Name -> Symbolic a
 
 deriving instance Eq (Symbolic a)
 deriving instance Ord (Symbolic a)
@@ -119,19 +135,71 @@
     comp x y
 
 ------------------------------------------------------------------------
+
+-- | Variables are the potential or actual result of executing an action. They
+--   are parameterised by either `Symbolic` or `Concrete` depending on the
+--   phase of the test.
+--
+--   `Symbolic` variables are the potential results of actions. These are used
+--   when generating the sequence of actions to execute. They allow actions
+--   which occur later in the sequence to make use of the result of an action
+--   which came earlier in the sequence.
+--
+--   `Concrete` variables are the actual results of actions. These are used
+--   during test execution. They provide access to the actual runtime value of
+--   a variable.
+--
+--   The state update `Callback` for a command needs to be polymorphic in the
+--   type of variable because it is used in both the generation and the
+--   execution phase.
+--
+data Var a v =
+  Var (v a)
+
+-- | Take the value from a concrete variable.
+--
+concrete :: Var a Concrete -> a
+concrete (Var (Concrete x)) =
+  x
+
+-- | Take the value from an opaque concrete variable.
+--
+opaque :: Var (Opaque a) Concrete -> a
+opaque (Var (Concrete (Opaque x))) =
+  x
+
+instance (Eq a, Eq1 v) => Eq (Var a v) where
+  (==) (Var x) (Var y) =
+    eq1 x y
+
+instance (Ord a, Ord1 v) => Ord (Var a v) where
+  compare (Var x) (Var y) =
+    compare1 x y
+
+instance (Show a, Show1 v) => Show (Var a v) where
+  showsPrec p (Var x) =
+    showParen (p >= 11) $
+      showString "Var " .
+      showsPrec1 11 x
+
+instance HTraversable (Var a) where
+  htraverse f (Var v) =
+    fmap Var (f v)
+
+------------------------------------------------------------------------
 -- Symbolic Environment
 
 -- | A mapping of symbolic values to concrete values.
 --
 newtype Environment =
   Environment {
-      unEnvironment :: Map Var Dynamic
+      unEnvironment :: Map Name Dynamic
     } deriving (Show)
 
 -- | Environment errors.
 --
 data EnvironmentError =
-    EnvironmentValueNotFound !Var
+    EnvironmentValueNotFound !Name
   | EnvironmentTypeError !TypeRep !TypeRep
     deriving (Eq, Ord, Show)
 
@@ -179,7 +247,7 @@
 
 -- | Optional command configuration.
 --
-data Callback input output m state =
+data Callback input output state =
   -- | A pre-condition for a command that must be verified before the command
   --   can be executed. This is mainly used during shrinking to ensure that it
   --   is still OK to run a command despite the fact that some previously
@@ -192,17 +260,20 @@
   --   it must work over 'Symbolic' values when we are generating actions, and
   --   'Concrete' values when we are executing them.
   --
-  | Update (forall v. Ord1 v => state v -> input v -> v output -> state v)
+  | Update (forall v. Ord1 v => state v -> input v -> Var output v -> state v)
 
   -- | A post-condition for a command that must be verified for the command to
   --   be considered a success.
   --
-  | Ensure (state Concrete -> input Concrete -> output -> Test m ())
+  --   This callback receives the state prior to execution as the first
+  --   argument, and the state after execution as the second argument.
+  --
+  | Ensure (state Concrete -> state Concrete -> input Concrete -> output -> Test ())
 
 callbackRequire1 ::
      state Symbolic
   -> input Symbolic
-  -> Callback input output m state
+  -> Callback input output state
   -> Bool
 callbackRequire1 s i = \case
   Require f ->
@@ -216,8 +287,8 @@
      Ord1 v
   => state v
   -> input v
-  -> v output
-  -> Callback input output m state
+  -> Var output v
+  -> Callback input output state
   -> state v
 callbackUpdate1 s i o = \case
   Require _ ->
@@ -228,22 +299,22 @@
     s
 
 callbackEnsure1 ::
-     Monad m
-  => state Concrete
+     state Concrete
+  -> state Concrete
   -> input Concrete
   -> output
-  -> Callback input output m state
-  -> Test m ()
-callbackEnsure1 s i o = \case
+  -> Callback input output state
+  -> Test ()
+callbackEnsure1 s0 s i o = \case
   Require _ ->
     success
   Update _ ->
     success
   Ensure f ->
-    f s i o
+    f s0 s i o
 
 callbackRequire ::
-     [Callback input output m state]
+     [Callback input output state]
   -> state Symbolic
   -> input Symbolic
   -> Bool
@@ -252,23 +323,23 @@
 
 callbackUpdate ::
      Ord1 v
-  => [Callback input output m state]
+  => [Callback input output state]
   -> state v
   -> input v
-  -> v output
+  -> Var output v
   -> state v
 callbackUpdate callbacks s0 i o =
   foldl (\s -> callbackUpdate1 s i o) s0 callbacks
 
 callbackEnsure ::
-     Monad m
-  => [Callback input output m state]
+     [Callback input output state]
   -> state Concrete
+  -> state Concrete
   -> input Concrete
   -> output
-  -> Test m ()
-callbackEnsure callbacks s i o =
-  traverse_ (callbackEnsure1 s i o) callbacks
+  -> Test ()
+callbackEnsure callbacks s0 s i o =
+  traverse_ (callbackEnsure1 s0 s i o) callbacks
 
 ------------------------------------------------------------------------
 
@@ -283,18 +354,18 @@
     --   'Nothing'.
     --
       commandGen ::
-        state Symbolic -> Maybe (Gen n (input Symbolic))
+        state Symbolic -> Maybe (n (input Symbolic))
 
     -- | Executes a command using the arguments generated by 'commandGen'.
     --
     , commandExecute ::
-        input Concrete -> Test m output
+        input Concrete -> m output
 
     -- | A set of callbacks which provide optional command configuration such
     --   as pre-condtions, post-conditions and state updates.
     --
     , commandCallbacks ::
-        [Callback input output m state]
+        [Callback input output state]
     }
 
 -- | Checks that input for a command can be executed in the given state.
@@ -317,45 +388,46 @@
         Symbolic output
 
     , actionExecute ::
-        input Concrete -> Test m output
+        input Concrete -> m output
 
     , actionRequire ::
         state Symbolic -> input Symbolic -> Bool
 
     , actionUpdate ::
-        forall v. Ord1 v => state v -> input v -> v output -> state v
+        forall v. Ord1 v => state v -> input v -> Var output v -> state v
 
     , actionEnsure ::
-        state Concrete -> input Concrete -> output -> Test m ()
+        state Concrete -> state Concrete -> input Concrete -> output -> Test ()
     }
 
 instance Show (Action m state) where
-  showsPrec p (Action input output _ _ _ _) =
+  showsPrec p (Action input (Symbolic (Name output)) _ _ _ _) =
     showParen (p > 10) $
+      showString "Var " .
       showsPrec 11 output .
       showString " :<- " .
       showsPrec 11 input
 
 -- | Extract the variable name and the type from a symbolic value.
 --
-takeSymbolic :: forall a. Symbolic a -> (Var, TypeRep)
-takeSymbolic (Symbolic var) =
-  (var, typeRep (Proxy :: Proxy a))
+takeSymbolic :: forall a. Symbolic a -> (Name, TypeRep)
+takeSymbolic (Symbolic name) =
+  (name, typeRep (Proxy :: Proxy a))
 
 -- | Insert a symbolic variable in to a map of variables to types.
 --
-insertSymbolic :: Symbolic a -> Map Var TypeRep -> Map Var TypeRep
+insertSymbolic :: Symbolic a -> Map Name TypeRep -> Map Name TypeRep
 insertSymbolic s =
   let
-    (var, typ) =
+    (name, typ) =
       takeSymbolic s
   in
-    Map.insert var typ
+    Map.insert name typ
 
 -- | Collects all the symbolic values in a data structure and produces a set of
 --   all the variables they refer to.
 --
-takeVariables :: forall t. HTraversable t => t Symbolic -> Map Var TypeRep
+takeVariables :: forall t. HTraversable t => t Symbolic -> Map Name TypeRep
 takeVariables xs =
   let
     go x = do
@@ -367,7 +439,7 @@
 -- | Checks that the symbolic values in the data structure refer only to the
 --   variables in the provided set, and that they are of the correct type.
 --
-variablesOK :: HTraversable t => t Symbolic -> Map Var TypeRep -> Bool
+variablesOK :: HTraversable t => t Symbolic -> Map Name TypeRep -> Bool
 variablesOK xs allowed =
   let
     vars =
@@ -376,58 +448,87 @@
     Map.null (vars `Map.difference` allowed) &&
     and (Map.intersectionWith (==) vars allowed)
 
+data Context state =
+  Context {
+      contextState :: state Symbolic
+    , _contextVars :: Map Name TypeRep
+    }
+
+mkContext :: state Symbolic -> Context state
+mkContext initial =
+  Context initial Map.empty
+
+contextUpdate :: MonadState (Context state) m => state Symbolic -> m ()
+contextUpdate state = do
+  Context _ vars <- get
+  put $ Context state vars
+
+contextNewVar :: (MonadState (Context state) m, Typeable a) => m (Symbolic a)
+contextNewVar = do
+  Context state vars <- get
+
+  let
+    var =
+      case Map.maxViewWithKey vars of
+        Nothing ->
+          Symbolic 0
+        Just ((name, _), _) ->
+          Symbolic (name + 1)
+
+  put $ Context state (insertSymbolic var vars)
+  pure var
+
 -- | Drops invalid actions from the sequence.
 --
-dropInvalid :: (forall v. state v) -> [Action m state] -> [Action m state]
-dropInvalid initial =
+dropInvalid :: [Action m state] -> State (Context state) [Action m state]
+dropInvalid =
   let
     loop step@(Action input output _execute require update _ensure) = do
-      ((state0, vars0), steps0) <- get
+      Context state0 vars0 <- get
 
-      when (require state0 input && variablesOK input vars0) $
+      if require state0 input && variablesOK input vars0 then do
         let
           state =
-            update state0 input output
+            update state0 input (Var output)
 
           vars =
             insertSymbolic output vars0
 
-          steps =
-            steps0 ++ [step]
-        in
-          put ((state, vars), steps)
+        put $ Context state vars
+        pure $ Just step
+      else
+        pure Nothing
   in
-    snd . flip execState ((initial, Map.empty), []) . traverse_ loop
+    fmap Maybe.catMaybes . traverse loop
 
 -- | Generates a single action from a set of possible commands.
 --
 action ::
-     (Monad n, Monad m)
+     (MonadGen n, MonadTest m)
   => [Command n m state]
-  -> Gen (StateT (state Symbolic, Var) n) (Action m state)
+  -> StateT (Context state) n (Action m state)
 action commands =
   Gen.just $ do
-    (state, var) <- get
+    Context state0 _ <- get
 
     Command mgenInput exec callbacks <-
-      Gen.element $ filter (\c -> commandGenOK c state) commands
+      Gen.element $ filter (\c -> commandGenOK c state0) commands
 
     input <-
-      case mgenInput state of
+      case mgenInput state0 of
         Nothing ->
           error "genCommand: internal error, tried to use generator with invalid state."
         Just g ->
-          hoist lift g
+          lift g
 
-    if not $ callbackRequire callbacks state input then
+    if not $ callbackRequire callbacks state0 input then
       pure Nothing
 
     else do
-      let
-        output =
-          Symbolic var
+      output <- contextNewVar
 
-      put (callbackUpdate callbacks state input output, var + 1)
+      contextUpdate $
+        callbackUpdate callbacks state0 input (Var output)
 
       pure . Just $
         Action input output exec
@@ -435,31 +536,139 @@
           (callbackUpdate callbacks)
           (callbackEnsure callbacks)
 
+genActions ::
+     (MonadGen n, MonadTest m)
+  => Range Int
+  -> [Command n m state]
+  -> Context state
+  -> n ([Action m state], Context state)
+genActions range commands ctx = do
+  xs <- Gen.list range (action commands) `evalStateT` ctx
+  pure $
+    dropInvalid xs `runState` ctx
+
+-- | A sequence of actions to execute.
+--
+data Sequential m state =
+  Sequential {
+      -- | The sequence of actions.
+      sequentialActions :: [Action m state]
+    }
+
+renderAction :: Action m state -> [String]
+renderAction (Action input (Symbolic (Name output)) _ _ _ _) =
+  let
+    prefix0 =
+      "Var " ++ show output ++ " = "
+
+    prefix =
+      replicate (length prefix0) ' '
+  in
+    case lines (showPretty input) of
+      [] ->
+        [prefix0 ++ "?"]
+      x : xs ->
+        (prefix0 ++ x) :
+        fmap (prefix ++) xs
+
+-- FIXME we should not abuse Show to get nice output for actions
+instance Show (Sequential m state) where
+  show (Sequential xs) =
+    unlines $ concatMap renderAction xs
+
 -- | Generates a sequence of actions from an initial model state and set of commands.
 --
-actions ::
-     (Monad n, Monad m)
+sequential ::
+     (MonadGen n, MonadTest m)
   => Range Int
   -> (forall v. state v)
   -> [Command n m state]
-  -> Gen n [Action m state]
-actions range initial =
-  fmap (dropInvalid initial) .
-  Gen.shrink Shrink.list .
-  hoist (flip evalStateT (initial, 0)) .
-  Gen.list range .
-  action
+  -> n (Sequential m state)
+sequential range initial commands =
+  fmap (Sequential . fst) $
+    genActions range commands (mkContext initial)
 
+-- | A sequential prefix of actions to execute, with two branches to execute in parallel.
+--
+data Parallel m state =
+  Parallel {
+      -- | The sequential prefix.
+      parallelPrefix :: [Action m state]
+
+      -- | The first branch.
+    , parallelBranch1 :: [Action m state]
+
+      -- | The second branch.
+    , parallelBranch2 :: [Action m state]
+    }
+
+-- FIXME we should not abuse Show to get nice output for actions
+instance Show (Parallel m state) where
+  show (Parallel pre xs ys) =
+    unlines $ concat [
+        ["━━━ Prefix ━━━"]
+      ,  (concatMap renderAction pre)
+      , ["", "━━━ Branch 1 ━━━"]
+      ,  (concatMap renderAction xs)
+      , ["", "━━━ Branch 2 ━━━"]
+      ,  (concatMap renderAction ys)
+      ]
+
+-- | Given the initial model state and set of commands, generates prefix
+--   actions to be run sequentially, followed by two branches to be run in
+--   parallel.
+--
+parallel ::
+     (MonadGen n, MonadTest m)
+  => Range Int
+  -> Range Int
+  -> (forall v. state v)
+  -> [Command n m state]
+  -> n (Parallel m state)
+parallel prefixN parallelN initial commands = do
+  (prefix, ctx0) <- genActions prefixN commands (mkContext initial)
+  (branch1, ctx1) <- genActions parallelN commands ctx0
+  (branch2, _ctx2) <- genActions parallelN commands ctx1 { contextState = contextState ctx0 }
+
+  pure $ Parallel prefix branch1 branch2
+
+data ActionCheck state =
+  ActionCheck {
+      checkUpdate :: state Concrete -> state Concrete
+    , checkEnsure :: state Concrete -> state Concrete -> Test ()
+    }
+
+execute :: (MonadTest m, HasCallStack) => Action m state -> StateT Environment m (ActionCheck state)
+execute (Action sinput soutput exec _require update ensure) =
+  withFrozenCallStack $ do
+    env0 <- get
+    input <- evalEither $ reify env0 sinput
+    output <- lift $ exec input
+
+    let
+      coutput =
+        Concrete output
+
+      env =
+        insertConcrete soutput coutput env0
+
+    put env
+
+    pure $
+      ActionCheck
+        (\s0 -> update s0 input (Var coutput))
+        (\s0 s -> ensure s0 s input output)
+
 -- | Executes a single action in the given evironment.
 --
-execute ::
-     (HasCallStack, Monad m)
+executeUpdateEnsure ::
+     (MonadTest m, HasCallStack)
   => (state Concrete, Environment)
   -> Action m state
-  -> Test m (state Concrete, Environment)
-execute (state0, env0) (Action sinput soutput exec _require update ensure) =
+  -> m (state Concrete, Environment)
+executeUpdateEnsure (state0, env0) (Action sinput soutput exec _require update ensure) =
   withFrozenCallStack $ do
-    input <- liftEither $ reify env0 sinput
+    input <- evalEither $ reify env0 sinput
     output <- exec input
 
     let
@@ -467,12 +676,12 @@
         Concrete output
 
       state =
-        update state0 input coutput
+        update state0 input (Var coutput)
 
       env =
         insertConcrete soutput coutput env0
 
-    ensure state input output
+    liftTest $ ensure state0 state input output
 
     pure (state, env)
 
@@ -480,14 +689,84 @@
 --   post-conditions are met and no exceptions are thrown.
 --
 --   To generate a sequence of actions to execute, see the
---   'Hedgehog.Gen.actions' combinator in the "Hedgehog.Gen" module.
+--   'Hedgehog.Gen.sequential' combinator in the "Hedgehog.Gen" module.
 --
 executeSequential ::
-     forall m state.
-     (HasCallStack, MonadCatch m)
+     (MonadTest m, MonadCatch m, HasCallStack)
   => (forall v. state v)
-  -> [Action m state]
-  -> Test m ()
-executeSequential initial commands =
+  -> Sequential m state
+  -> m ()
+executeSequential initial (Sequential xs) =
+  withFrozenCallStack $ evalM $
+    foldM_ executeUpdateEnsure (initial, emptyEnvironment) xs
+
+successful :: Test () -> Bool
+successful x =
+  case runTest x of
+    (Left _, _) ->
+      False
+    (Right _, _) ->
+      True
+
+interleave :: [a] -> [a] -> [[a]]
+interleave xs00 ys00 =
+  case (xs00, ys00) of
+    ([], []) ->
+      []
+    (xs, []) ->
+      [xs]
+    ([], ys) ->
+      [ys]
+    (xs0@(x:xs), ys0@(y:ys)) ->
+      [ x : zs | zs <- interleave xs ys0 ] ++
+      [ y : zs | zs <- interleave xs0 ys ]
+
+checkActions :: state Concrete -> [ActionCheck state] -> Test ()
+checkActions s0 = \case
+  [] ->
+    pure ()
+  x : xs -> do
+    let
+      s =
+        checkUpdate x s0
+
+    checkEnsure x s0 s
+    checkActions s xs
+
+linearize :: MonadTest m => state Concrete -> [ActionCheck state] -> [ActionCheck state] -> m ()
+linearize initial branch1 branch2 =
   withFrozenCallStack $
-    withCatch (foldM_ execute (initial, emptyEnvironment) commands)
+    let
+      ok =
+        any successful .
+        fmap (checkActions initial) $
+        interleave branch1 branch2
+    in
+      if ok then
+        pure ()
+      else
+        failWith Nothing "no valid interleaving"
+
+
+-- | Executes the prefix actions sequentially, then executes the two branches
+--   in parallel, verifying that no exceptions are thrown and that there is at
+--   least one sequential interleaving where all the post-conditions are met.
+--
+--   To generate parallel actions to execute, see the 'Hedgehog.Gen.parallel'
+--   combinator in the "Hedgehog.Gen" module.
+--
+executeParallel ::
+     (MonadTest m, MonadCatch m, MonadBaseControl IO m, HasCallStack)
+  => (forall v. state v)
+  -> Parallel m state
+  -> m ()
+executeParallel initial (Parallel prefix branch1 branch2) =
+  withFrozenCallStack $ evalM $ do
+    (s0, env0) <- foldM executeUpdateEnsure (initial, emptyEnvironment) prefix
+
+    (xs, ys) <-
+      Async.concurrently
+        (evalStateT (traverse execute branch1) env0)
+        (evalStateT (traverse execute branch2) env0)
+
+    linearize s0 xs ys
diff --git a/src/Hedgehog/Internal/Tripping.hs b/src/Hedgehog/Internal/Tripping.hs
--- a/src/Hedgehog/Internal/Tripping.hs
+++ b/src/Hedgehog/Internal/Tripping.hs
@@ -10,16 +10,11 @@
 -- | Test that a pair of encode / decode functions are compatible.
 --
 tripping ::
-     HasCallStack
-  => Applicative f
-  => Monad m
-  => Show b
-  => Show (f a)
-  => Eq (f a)
+     (MonadTest m, Applicative f, Show b, Show (f a), Eq (f a), HasCallStack)
   => a
   -> (a -> b)
   -> (b -> f a)
-  -> Test m ()
+  -> m ()
 tripping x encode decode =
   let
     mx =
diff --git a/test/Test/Hedgehog/Text.hs b/test/Test/Hedgehog/Text.hs
--- a/test/Test/Hedgehog/Text.hs
+++ b/test/Test/Hedgehog/Text.hs
@@ -12,11 +12,11 @@
 import           Text.Read (readEither)
 
 
-genSize :: Monad m => Gen m Size
+genSize :: Gen Size
 genSize =
   Size <$> Gen.enumBounded
 
-genOdd :: Monad m => Gen m Int64
+genOdd :: Gen Int64
 genOdd =
   let
     mkOdd x =
@@ -27,19 +27,19 @@
   in
     mkOdd <$> Gen.int64 (Range.constant 1 maxBound)
 
-genSeed :: Monad m => Gen m Seed
+genSeed :: Gen Seed
 genSeed =
   Seed <$> Gen.enumBounded <*> genOdd
 
-genPrecedence :: Monad m => Gen m Int
+genPrecedence :: Gen Int
 genPrecedence =
   Gen.int (Range.constant 0 11)
 
-genString :: Monad m => Gen m String
+genString :: Gen String
 genString =
   Gen.string (Range.constant 0 100) Gen.alpha
 
-checkShowAppend :: (Typeable a, Show a) => Gen IO a -> Property
+checkShowAppend :: (Typeable a, Show a) => Gen a -> Property
 checkShowAppend gen =
   property $ do
     prec <- forAll genPrecedence
@@ -48,7 +48,7 @@
     ysuffix <- forAll genString
     showsPrec prec x xsuffix ++ ysuffix  === showsPrec prec x (xsuffix ++ ysuffix)
 
-trippingReadShow :: (Eq a, Typeable a, Show a, Read a) => Gen IO a -> Property
+trippingReadShow :: (Eq a, Typeable a, Show a, Read a) => Gen a -> Property
 trippingReadShow gen =
   property $ do
     prec <- forAll genPrecedence