diff --git a/hedgehog/hedgehog.cabal b/hedgehog/hedgehog.cabal
index 4bb66eef..b330def2 100644
--- a/hedgehog/hedgehog.cabal
+++ b/hedgehog/hedgehog.cabal
@@ -137,6 +137,7 @@ test-suite test
     Test.Hedgehog.Filter
     Test.Hedgehog.Maybe
     Test.Hedgehog.Seed
+    Test.Hedgehog.Shrink
     Test.Hedgehog.Skip
     Test.Hedgehog.Text
     Test.Hedgehog.Zip
diff --git a/hedgehog/src/Hedgehog.hs b/hedgehog/src/Hedgehog.hs
index 989e797b..817e8682 100644
--- a/hedgehog/src/Hedgehog.hs
+++ b/hedgehog/src/Hedgehog.hs
@@ -80,6 +80,9 @@ module Hedgehog (
   , withShrinks
   , ShrinkLimit
 
+  , withShrinkTime
+  , ShrinkTimeLimit
+
   , withRetries
   , ShrinkRetries
 
@@ -188,6 +191,7 @@ import           Hedgehog.Internal.Property (Property, PropertyT, PropertyName)
 import           Hedgehog.Internal.Property (Group(..), GroupName)
 import           Hedgehog.Internal.Property (Confidence, verifiedTermination, withConfidence)
 import           Hedgehog.Internal.Property (ShrinkLimit, withShrinks)
+import           Hedgehog.Internal.Property (ShrinkTimeLimit, withShrinkTime)
 import           Hedgehog.Internal.Property (ShrinkRetries, withRetries)
 import           Hedgehog.Internal.Property (Skip, withSkip)
 import           Hedgehog.Internal.Property (Test, TestT, property, test)
diff --git a/hedgehog/src/Hedgehog/Internal/Property.hs b/hedgehog/src/Hedgehog/Internal/Property.hs
index c901550d..1c0ef657 100644
--- a/hedgehog/src/Hedgehog/Internal/Property.hs
+++ b/hedgehog/src/Hedgehog/Internal/Property.hs
@@ -33,6 +33,7 @@ module Hedgehog.Internal.Property (
   , DiscardLimit(..)
   , DiscardCount(..)
   , ShrinkLimit(..)
+  , ShrinkTimeLimit (..)
   , ShrinkCount(..)
   , Skip(..)
   , ShrinkPath(..)
@@ -40,6 +41,7 @@ module Hedgehog.Internal.Property (
   , withTests
   , withDiscards
   , withShrinks
+  , withShrinkTime
   , withRetries
   , withSkip
   , property
@@ -281,6 +283,7 @@ data PropertyConfig =
   PropertyConfig {
       propertyDiscardLimit :: !DiscardLimit
     , propertyShrinkLimit :: !ShrinkLimit
+    , propertyShrinkTimeLimit :: !(Maybe ShrinkTimeLimit)
     , propertyShrinkRetries :: !ShrinkRetries
     , propertyTerminationCriteria :: !TerminationCriteria
 
@@ -339,6 +342,19 @@ newtype ShrinkLimit =
   ShrinkLimit Int
   deriving (Eq, Ord, Show, Num, Enum, Real, Integral, Lift)
 
+-- | The time limit before giving up on shrinking, in microseconds.
+--
+--   Can be constructed using numeric literals:
+--
+-- @
+--   -- 1_000_000 microseconds == 1 second
+--   1_000_000 :: ShrinkTimeLimit
+-- @
+--
+newtype ShrinkTimeLimit =
+  ShrinkTimeLimit Int
+  deriving (Eq, Ord, Show, Num, Enum, Real, Integral, Lift)
+
 -- | The numbers of times a property was able to shrink after a failing test.
 --
 newtype ShrinkCount =
@@ -1164,6 +1180,8 @@ defaultConfig =
         100
     , propertyShrinkLimit =
         1000
+    , propertyShrinkTimeLimit =
+        Nothing
     , propertyShrinkRetries =
         0
     , propertyTerminationCriteria =
@@ -1248,6 +1266,13 @@ withShrinks :: ShrinkLimit -> Property -> Property
 withShrinks n =
   mapConfig $ \config -> config { propertyShrinkLimit = n }
 
+-- | Set the time -- in microseconds -- a property is allowed to shrink before
+--   the test runner gives up and prints the counterexample.
+--
+withShrinkTime :: ShrinkTimeLimit -> Property -> Property
+withShrinkTime n =
+  mapConfig $ \config -> config { propertyShrinkTimeLimit = Just n }
+
 -- | Set the number of 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.
diff --git a/hedgehog/src/Hedgehog/Internal/Runner.hs b/hedgehog/src/Hedgehog/Internal/Runner.hs
index c4b883c3..dc19b2cf 100644
--- a/hedgehog/src/Hedgehog/Internal/Runner.hs
+++ b/hedgehog/src/Hedgehog/Internal/Runner.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NoImplicitPrelude #-}
@@ -31,7 +32,10 @@ import           Control.Concurrent.STM (TVar, atomically)
 import qualified Control.Concurrent.STM.TVar as TVar
 import           Control.Exception.Safe (MonadCatch, catchAny)
 import           Control.Monad.IO.Class (MonadIO(..))
+import           Control.Monad.Trans.Control (MonadBaseControl (..))
+import           Data.IORef (newIORef, readIORef, writeIORef)
 import           Data.Maybe (isJust)
+import qualified System.Timeout as T
 
 import           Hedgehog.Internal.Config
 import           Hedgehog.Internal.Gen (evalGenT)
@@ -42,6 +46,7 @@ import           Hedgehog.Internal.Property (Journal(..), Coverage(..), CoverCou
 import           Hedgehog.Internal.Property (Property(..), PropertyConfig(..), PropertyName(..))
 import           Hedgehog.Internal.Property (PropertyT(..), Failure(..), runTestT)
 import           Hedgehog.Internal.Property (ShrinkLimit, ShrinkRetries, withTests, withSkip)
+import           Hedgehog.Internal.Property (ShrinkTimeLimit (..))
 import           Hedgehog.Internal.Property (TerminationCriteria(..))
 import           Hedgehog.Internal.Property (TestCount(..), PropertyCount(..))
 import           Hedgehog.Internal.Property (confidenceSuccess, confidenceFailure)
@@ -118,17 +123,27 @@ runTreeN n m = do
     pure o
 
 takeSmallest ::
-     MonadIO m
+     forall m.
+   ( MonadBaseControl IO m
+   , MonadIO m
+   )
   => ShrinkCount
   -> ShrinkPath
   -> ShrinkLimit
+  -> Maybe ShrinkTimeLimit
   -> ShrinkRetries
   -> (Progress -> m ())
   -> NodeT m (Maybe (Either Failure (), Journal))
   -> m Result
-takeSmallest shrinks0 (ShrinkPath shrinkPath0) slimit retries updateUI =
+takeSmallest shrinks0 (ShrinkPath shrinkPath0) slimit mstimeLimit retries updateUI =
   let
-    loop shrinks revShrinkPath = \case
+    loop ::
+         ShrinkCount
+      -> [Int]
+      -> (Result -> m ())
+      -> NodeT m (Maybe (Either Failure (), Journal))
+      -> m Result
+    loop shrinks revShrinkPath updateResultSoFar = \case
       NodeT Nothing _ ->
         pure GaveUp
 
@@ -141,6 +156,7 @@ takeSmallest shrinks0 (ShrinkPath shrinkPath0) slimit retries updateUI =
               failure =
                 mkFailure shrinks shrinkPath Nothing loc err mdiff (reverse logs)
 
+            updateResultSoFar (Failed failure)
             updateUI $ Shrinking failure
 
             if shrinks >= fromIntegral slimit then
@@ -150,14 +166,27 @@ takeSmallest shrinks0 (ShrinkPath shrinkPath0) slimit retries updateUI =
               findM (zip [0..] xs) (Failed failure) $ \(n, m) -> do
                 o <- runTreeN retries m
                 if isFailure o then
-                  Just <$> loop (shrinks + 1) (n : revShrinkPath) o
+                  Just <$> loop (shrinks + 1) (n : revShrinkPath) updateResultSoFar o
                 else
                   return Nothing
 
           Right () ->
             return OK
-  in
-    loop shrinks0 (reverse shrinkPath0)
+    runLoop = loop shrinks0 (reverse shrinkPath0)
+  in case mstimeLimit of
+       -- no time limit, shrink normally
+       Nothing -> runLoop (const (pure ()))
+       -- run the loop in the timeout
+       Just (ShrinkTimeLimit timeLimit) -> \nodeT -> do
+          resultSoFar <- liftIO $ newIORef Nothing
+          let updateResultSoFar = liftIO . writeIORef resultSoFar . Just
+          timeout timeLimit (runLoop updateResultSoFar nodeT) >>= \case
+            -- timed out, return preliminary result if it exists
+            Nothing -> liftIO (readIORef resultSoFar) <&> \case
+              Nothing -> GaveUp
+              Just r -> r
+            -- did not time out, return result
+            Just r -> pure r
 
 -- | Follow a given shrink path, instead of searching exhaustively. Assume that
 -- the end of the path is minimal, and don't try to shrink any further than
@@ -204,7 +233,9 @@ skipToShrink (ShrinkPath shrinkPath) updateUI =
 
 checkReport ::
      forall m.
-     MonadIO m
+   ( MonadBaseControl IO m
+   , MonadIO m
+   )
   => MonadCatch m
   => PropertyConfig
   -> Size
@@ -361,6 +392,7 @@ checkReport cfg size0 seed0 test0 updateUI = do
                         0
                         (ShrinkPath [])
                         (propertyShrinkLimit cfg)
+                        (propertyShrinkTimeLimit cfg)
                         (propertyShrinkRetries cfg)
                         (updateUI . mkReport)
                         node
@@ -594,3 +626,16 @@ checkParallel =
       , runnerVerbosity =
           Nothing
       }
+
+-- vendored from lifted-base
+timeout :: MonadBaseControl IO m => Int -> m a -> m (Maybe a)
+timeout t m =
+  liftBaseWith (\runInIO -> T.timeout t (runInIO m)) >>=
+    maybe (pure Nothing) (fmap Just . restoreM)
+
+-- vendored from base's Data.Functor until base < 4.11.0.0 is dropped
+-- (ghc 8.4.1)
+(<&>) :: Functor f => f a -> (a -> b) -> f b
+as <&> f = f <$> as
+
+infixl 1 <&>
\ No newline at end of file
diff --git a/hedgehog/test/Test/Hedgehog/Shrink.hs b/hedgehog/test/Test/Hedgehog/Shrink.hs
new file mode 100644
index 00000000..b955a9d0
--- /dev/null
+++ b/hedgehog/test/Test/Hedgehog/Shrink.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Test.Hedgehog.Shrink where
+
+import qualified Control.Concurrent as CC
+import           Control.Monad (when)
+import           Control.Monad.IO.Class (MonadIO(..))
+import           Data.IORef (IORef)
+import qualified Data.IORef as IORef
+
+import           Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Hedgehog.Internal.Config as Config
+import qualified Hedgehog.Internal.Property as Property
+import qualified Hedgehog.Internal.Runner as Runner
+import           Hedgehog.Internal.Report (FailureReport(..), FailedAnnotation (..))
+import           Hedgehog.Internal.Report (Report(..), Result(..))
+
+-- No limit fully shrinks (18)
+prop_ShrinkNoLimit :: Property
+prop_ShrinkNoLimit =
+  withTests 1 . property $ do
+    (report, gens) <- checkModProp id
+    [50, 0, 25, 13, 7, 4, 6, 5] === gens
+    case reportStatus report of
+      Failed f -> failureShrinks f === 5
+      _ -> failure
+
+-- Shrinks 3 times
+prop_ShrinkLimit :: Property
+prop_ShrinkLimit =
+  withTests 1 . property $ do
+    (report, gens) <- checkModProp (withShrinks 3)
+    [50, 0, 25, 13, 7] === gens
+    case reportStatus report of
+      Failed f -> failureShrinks f === 3
+      _ -> failure
+
+-- Time limit of 0 i.e. does not shrink at all
+prop_ShrinkTimeLimitZero :: Property
+prop_ShrinkTimeLimitZero =
+  withTests 1 . property $ do
+    (report, gens) <- checkModProp (withShrinkTime 0)
+    [50] === gens
+    case reportStatus report of
+      GaveUp -> pure ()
+      _ -> failure
+
+-- Time limit of 1,000,000 microseconds = 1 s. Verifies that we get a
+-- "partial" shrink.
+--
+-- There is tension in the shrinkTime. On the one hand, we want it long enough
+-- so that we generate the four values [50, 0, 25, 13] before it gets stuck
+-- on 13. We don't want it too long, though, because that makes the test
+-- slower.
+--
+-- Experience shows that values under 1 second would cause an occasional CI
+-- failure (the machine would not generate all four values before the timeout).
+-- A timeout of 1 second, on the other hand, passed CI with 10,000 tests
+-- (and took 7 hours!). Thus we use the 1 second timeout as it seems robust
+-- enough to not cause CI failures, and we cap the tests at 1 to keep the
+-- running time fast.
+prop_ShrinkTimeLimit :: Property
+prop_ShrinkTimeLimit =
+  withTests 1 . property $ do
+    -- Test generates [ 50 , 0 , 25 , 13 , 7 , 4 , 6 , 5 ]
+    -- The 1 s timeout combined with the 10 s delay on 13 means
+    -- shrinking will get stuck on 13, hence:
+    --   - only generate [50 , 0 , 25 , 13]
+    --   - final shrink value is 25
+    (report, gens) <- checkModPropGen delay (withShrinkTime shrinkTime)
+    [50 , 0 , 25 , 13] === gens
+    case reportStatus report of
+      Failed f -> do
+        1 === failureShrinks f
+        case failureAnnotations f of
+          [ann] -> "25" === failedValue ann
+          _ -> failure
+      _ -> failure
+  where
+    delay x = when (x == 13) (liftIO $ CC.threadDelay delayTime)
+    shrinkTime = 1000000 --  1 sec
+    -- Does not matter what this is, as long as it is longer than shrinkTime
+    delayTime = 10000000 -- 10 sec
+
+-- Given a property modifier, returns the property's report and generated
+-- values.
+checkModProp ::
+  ( MonadIO m
+  , MonadTest m
+  )
+  => -- property modifier
+     (Property -> Property)
+  -> m (Report Result, [Int])
+checkModProp = checkModPropGen (const (pure ()))
+
+-- checkModProp with function to run on the generated values
+checkModPropGen ::
+  ( MonadIO m
+  , MonadTest m
+  )
+  => -- function to run on generated values
+     (Int -> PropertyT IO ())
+     -- property modifier
+  -> (Property -> Property)
+  -> m (Report Result, [Int])
+checkModPropGen onGen md = do
+  gensRef <- liftIO $ IORef.newIORef []
+  report <- checkProp $ modProp onGen gensRef md
+  gens <- liftIO $ reverse <$> IORef.readIORef gensRef
+  annotateShow report
+  annotateShow gens
+  pure (report, gens)
+
+modProp ::
+     -- function to run on generated values
+     (Int -> PropertyT IO ())
+     -- reference to hold generated values
+  -> IORef [Int]
+     -- property modifier
+  -> (Property -> Property)
+  -> Property
+modProp onGen gensRef md = withTests 1 . md . property $ do
+  -- [ 50 , 0 , 25 , 13 , 7 , 4 , 6 , 5 ]
+  x :: Int <- forAll $ Gen.integral (Range.linearFrom 0 50 100)
+  liftIO $ IORef.modifyIORef' gensRef (x :)
+  onGen x
+  diff x (<) 5
+
+checkProp :: MonadIO m => Property -> m (Report Result)
+checkProp prop = do
+  seed <- Config.resolveSeed Nothing
+  liftIO $ Runner.checkReport
+    (Property.propertyConfig prop)
+    0
+    seed
+    (Property.propertyTest prop)
+    (const $ pure ())
+
+tests :: IO Bool
+tests = checkParallel $$(discover)
\ No newline at end of file
diff --git a/hedgehog/test/test.hs b/hedgehog/test/test.hs
index 43ee3bff..a1ebadb0 100644
--- a/hedgehog/test/test.hs
+++ b/hedgehog/test/test.hs
@@ -5,6 +5,7 @@ import qualified Test.Hedgehog.Confidence
 import qualified Test.Hedgehog.Filter
 import qualified Test.Hedgehog.Maybe
 import qualified Test.Hedgehog.Seed
+import qualified Test.Hedgehog.Shrink
 import qualified Test.Hedgehog.Skip
 import qualified Test.Hedgehog.Text
 import qualified Test.Hedgehog.Zip
@@ -18,6 +19,7 @@ main =
     , Test.Hedgehog.Filter.tests
     , Test.Hedgehog.Maybe.tests
     , Test.Hedgehog.Seed.tests
+    , Test.Hedgehog.Shrink.tests
     , Test.Hedgehog.Skip.tests
     , Test.Hedgehog.Text.tests
     , Test.Hedgehog.Zip.tests