diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,6 +1,6 @@
-Copyright (c) 2000-2014, Koen Claessen
+Copyright (c) 2000-2015, Koen Claessen
 Copyright (c) 2006-2008, Björn Bringert
-Copyright (c) 2009-2014, Nick Smallbone
+Copyright (c) 2009-2015, Nick Smallbone
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
diff --git a/QuickCheck.cabal b/QuickCheck.cabal
--- a/QuickCheck.cabal
+++ b/QuickCheck.cabal
@@ -1,15 +1,15 @@
 Name: QuickCheck
-Version: 2.7.6
+Version: 2.8
 Cabal-Version: >= 1.8
 Build-type: Simple
 License: BSD3
 License-file: LICENSE
 Extra-source-files: README changelog
-Copyright: 2000-2014 Koen Claessen, 2006-2008 Björn Bringert, 2009-2014 Nick Smallbone
+Copyright: 2000-2015 Koen Claessen, 2006-2008 Björn Bringert, 2009-2015 Nick Smallbone
 Author: Koen Claessen <koen@chalmers.se>
 Maintainer: QuickCheck developers <quickcheck@projects.haskell.org>
 Bug-reports: mailto:quickcheck@projects.haskell.org
-Tested-with: GHC >=6.8, Hugs, UHC
+Tested-with: GHC >=6.10, Hugs, UHC
 Homepage: https://github.com/nick8325/quickcheck
 Category:       Testing
 Synopsis:       Automatic testing of Haskell programs
@@ -26,6 +26,9 @@
   QuickCheck provides combinators to define properties, observe
   the distribution of test data, and define test
   data generators.
+  .
+  You can find a (slightly out-of-date but useful) manual at
+  <http://www.cse.chalmers.se/~rjmh/QuickCheck/manual.html>.
 
 source-repository head
   type:     git
@@ -34,7 +37,7 @@
 source-repository this
   type:     git
   location: https://github.com/nick8325/quickcheck
-  tag:      2.7.6
+  tag:      2.8
 
 flag base3
   Description: Choose the new smaller, split-up base package.
@@ -42,18 +45,27 @@
 flag base4
   Description: Choose the even newer base package with extensible exceptions.
 
+flag base4point8
+  Description: Choose the even more newer base package with natural numbers.
+
 flag templateHaskell
   Description: Build Test.QuickCheck.All, which uses Template Haskell.
 
 library
   -- Choose which library versions to use.
-  if flag(base4)
-    Build-depends: base >= 4 && < 5, random
+  if flag(base4point8)
+    Build-depends: base >= 4.8 && < 5
   else
-    if flag(base3)
-      Build-depends: base >= 3 && < 4, random
+    if flag(base4)
+      Build-depends: base >= 4 && < 4.8
     else
-      Build-depends: base < 3
+      if flag(base3)
+        Build-depends: base >= 3 && < 4
+      else
+        Build-depends: base < 3
+  if flag(base4point8) || flag(base4) || flag(base3)
+    Build-depends: random
+  Build-depends: containers
 
   -- Modules that are always built.
   Exposed-Modules:
@@ -110,11 +122,15 @@
     cpp-options: -DNO_SAFE_HASKELL
 
   -- Use tf-random on newer GHCs.
-  if impl(ghc >= 7) && flag(base4)
+  if impl(ghc >= 7) && (flag(base4point8) || flag(base4))
     Build-depends: tf-random >= 0.4
   else
     cpp-options: -DNO_TF_RANDOM
 
+  -- Natural numbers.
+  if !flag(base4point8)
+    cpp-options: -DNO_NATURALS
+
   -- Switch off most optional features on non-GHC systems.
   if !impl(ghc)
     -- If your Haskell compiler can cope without some of these, please
@@ -141,6 +157,12 @@
     main-is: Heap.hs
     build-depends:
       base,
-      QuickCheck == 2.7.6,
+      containers,
+      QuickCheck == 2.8,
       template-haskell >= 2.4,
       test-framework >= 0.4 && < 0.9
+    if flag(templateHaskell)
+        Buildable: True
+    else
+        Buildable: False
+
diff --git a/Test/QuickCheck.hs b/Test/QuickCheck.hs
--- a/Test/QuickCheck.hs
+++ b/Test/QuickCheck.hs
@@ -1,3 +1,70 @@
+{-| For further information see the <http://www.cse.chalmers.se/~rjmh/QuickCheck/manual.html QuickCheck manual>.
+
+To use QuickCheck to check a property, first define a function
+expressing that property (functions expressing properties under test
+tend to be prefixed with @prop_@). Testing that @n + m = m + n@ holds
+for @Integer@s one might write:
+
+@
+import Test.QuickCheck
+
+prop_commutativeAdd :: Integer -> Integer -> Bool
+prop_commutativeAdd n m = n + m == m + n
+@
+
+and testing:
+
+>>> quickcheck prop_commutativeAdd
++++ OK, passed 100 tests.
+
+which tests @prop_commutativeAdd@ on 100 random @(Integer, Integer)@ pairs.
+
+'verboseCheck' can be used to see the actual values generated:
+
+>>> verboseCheck prop_commutativeAdd
+Passed:
+0
+0
+  …98 tests omitted…
+Passed:
+-68
+6
++++ OK, passed 100 tests.
+
+and if more than 100 tests are needed the number of tests can be
+increased by updating the 'stdArgs' record:
+
+>>> quickCheckWith stdArgs { maxSuccess = 500 } prop_commutativeAdd
++++ OK, passed 500 tests.
+
+To let QuickCheck generate values of your own data type an 'Arbitrary'
+instance must be defined:
+
+@
+data Point = MkPoint Int Int deriving Eq
+
+instance Arbitrary Point where
+  arbitrary = do
+    x <- 'arbitrary'
+    y <- arbitrary
+    return (MkPoint x y)
+
+swapPoint :: Point -> Point
+swapPoint (MkPoint x y) = MkPoint y x
+
+-- swapPoint . swapPoint = id
+prop_swapInvolution point = swapPoint (swapPoint point) == point
+@
+
+>>> quickCheck prop_swapInvolution
++++ OK, passed 100 tests.
+
+See "Test.QuickCheck.Function" for generating random shrinkable,
+showable functions used for testing higher-order functions and
+"Test.QuickCheck.Monadic" for testing impure or monadic code
+(e.g. effectful code in 'IO').
+
+-}
 {-# LANGUAGE CPP #-}
 #ifndef NO_SAFE_HASKELL
 {-# LANGUAGE Safe #-}
@@ -37,12 +104,15 @@
   , growingElements
   , sized
   , resize
+  , scale
   , suchThat
   , suchThatMaybe
   , listOf
   , listOf1
   , vectorOf
   , infiniteListOf
+  , shuffle
+  , sublistOf
     -- ** Generators which use Arbitrary
   , vector
   , orderedList
@@ -59,6 +129,7 @@
 
     -- ** Helper functions for implementing arbitrary
   , arbitrarySizedIntegral
+  , arbitrarySizedNatural
   , arbitrarySizedFractional
   , arbitrarySizedBoundedIntegral
   , arbitraryBoundedIntegral
@@ -66,6 +137,7 @@
   , arbitraryBoundedEnum
     -- ** Helper functions for implementing shrink
 #ifndef NO_GENERICS
+  , genericCoarbitrary
   , genericShrink
   , subterms
   , recursivelyShrink
diff --git a/Test/QuickCheck/All.hs b/Test/QuickCheck/All.hs
--- a/Test/QuickCheck/All.hs
+++ b/Test/QuickCheck/All.hs
@@ -79,8 +79,17 @@
 
 deconstructType :: Error -> Type -> Q ([Name], Cxt, Type)
 deconstructType err ty0@(ForallT xs ctx ty) = do
-  let plain (PlainTV _) = True
-      plain _ = False
+  let plain (PlainTV  _)       = True
+#ifndef MIN_VERSION_template_haskell
+      plain (KindedTV _ StarT) = True
+#else
+#if MIN_VERSION_template_haskell(2,8,0)
+      plain (KindedTV _ StarT) = True
+#else
+      plain (KindedTV _ StarK) = True
+#endif
+#endif
+      plain _                  = False
   unless (all plain xs) $ err "Higher-kinded type variables in type"
   return (map (\(PlainTV x) -> x) xs, ctx, ty)
 deconstructType _ ty = return ([], [], ty)
@@ -177,3 +186,4 @@
       Failure { } -> False
       NoExpectedFailure { } -> False
       GaveUp { } -> False
+      InsufficientCoverage { } -> False
diff --git a/Test/QuickCheck/Arbitrary.hs b/Test/QuickCheck/Arbitrary.hs
--- a/Test/QuickCheck/Arbitrary.hs
+++ b/Test/QuickCheck/Arbitrary.hs
@@ -2,7 +2,12 @@
 {-# LANGUAGE CPP #-}
 #ifndef NO_GENERICS
 {-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators #-}
+{-# LANGUAGE FlexibleInstances, KindSignatures, ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses, OverlappingInstances #-}
 #endif
+#ifndef NO_SAFE_HASKELL
+{-# LANGUAGE Safe #-}
+#endif
 module Test.QuickCheck.Arbitrary
   (
   -- * Arbitrary and CoArbitrary classes
@@ -11,6 +16,7 @@
 
   -- ** Helper functions for implementing arbitrary
   , arbitrarySizedIntegral        -- :: Integral a => Gen a
+  , arbitrarySizedNatural         -- :: Integral a => Gen a
   , arbitraryBoundedIntegral      -- :: (Bounded a, Integral a) => Gen a
   , arbitrarySizedBoundedIntegral -- :: (Bounded a, Integral a) => Gen a
   , arbitrarySizedFractional      -- :: Fractional a => Gen a
@@ -18,9 +24,10 @@
   , arbitraryBoundedEnum          -- :: (Bounded a, Enum a) => Gen a
   -- ** Helper functions for implementing shrink
 #ifndef NO_GENERICS
-  , genericShrink      -- :: (Generic a, Typeable a, RecursivelyShrink (Rep a), Subterms (Rep a)) => a -> [a]
-  , subterms           -- :: (Generic a, Subterms (Rep a)) => a -> [a]
+  , genericShrink      -- :: (Generic a, Arbitrary a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) => a -> [a]
+  , subterms           -- :: (Generic a, Arbitrary a, GSubterms (Rep a) a) => a -> [a]
   , recursivelyShrink  -- :: (Generic a, RecursivelyShrink (Rep a)) => a -> [a]
+  , genericCoarbitrary -- :: (Generic a, GCoArbitrary (Rep a)) => a -> Gen b -> Gen b
 #endif
   , shrinkNothing            -- :: a -> [a]
   , shrinkList               -- :: (a -> [a]) -> [a] -> [[a]]
@@ -44,6 +51,7 @@
 --------------------------------------------------------------------------
 -- imports
 
+import Control.Applicative
 import System.Random(Random)
 import Test.QuickCheck.Gen
 import Test.QuickCheck.Gen.Unsafe
@@ -73,6 +81,10 @@
   )
 #endif
 
+#ifndef NO_NATURALS
+import Numeric.Natural
+#endif
+
 import Data.Ratio
   ( Ratio
   , (%)
@@ -101,7 +113,6 @@
 
 #ifndef NO_GENERICS
 import GHC.Generics
-import Data.Typeable
 #endif
 
 --------------------------------------------------------------------------
@@ -176,7 +187,7 @@
   -- infinite loop.
   --
   -- If all this leaves you bewildered, you might try @'shrink' = 'genericShrink'@ to begin with,
-  -- after deriving @Generic@ and @Typeable@ for your type. However, if your data type has any
+  -- after deriving @Generic@ for your type. However, if your data type has any
   -- special invariants, you will need to check that 'genericShrink' can't break those invariants.
   shrink :: a -> [a]
   shrink _ = []
@@ -184,7 +195,7 @@
 #ifndef NO_GENERICS
 -- | Shrink a term to any of its immediate subterms,
 -- and also recursively shrink all subterms.
-genericShrink :: (Generic a, Typeable a, RecursivelyShrink (Rep a), Subterms (Rep a)) => a -> [a]
+genericShrink :: (Generic a, Arbitrary a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) => a -> [a]
 genericShrink x = subterms x ++ recursivelyShrink x
 
 -- | Recursively shrink all immediate subterms.
@@ -212,33 +223,81 @@
 instance RecursivelyShrink U1 where
   grecursivelyShrink U1 = []
 
+instance RecursivelyShrink V1 where
+  -- The empty type can't be shrunk to anything.
+  grecursivelyShrink _ = []
+
+
 -- | All immediate subterms of a term.
-subterms :: (Generic a, Typeable a, Subterms (Rep a)) => a -> [a]
-subterms = gsubterms . from
+subterms :: (Generic a, Arbitrary a, GSubterms (Rep a) a) => a -> [a]
+subterms = gSubterms . from
 
-class Subterms f where
-  gsubterms :: Typeable b => f a -> [b]
 
-instance (Subterms f, Subterms g) => Subterms (f :*: g) where
-  gsubterms (x :*: y) =
-    gsubterms x ++ gsubterms y
+class GSubterms f a where
+  -- | Provides the immediate subterms of a term that are of the same type
+  -- as the term itself.
+  --
+  -- Requires a constructor to be stripped off; this means it skips through
+  -- @M1@ wrappers and returns @[]@ on everything that's not `(:*:)` or `(:+:)`.
+  --
+  -- Once a `(:*:)` or `(:+:)` constructor has been reached, this function
+  -- delegates to `gSubtermsIncl` to return the immediately next constructor
+  -- available.
+  gSubterms :: f a -> [a]
 
-instance (Subterms f, Subterms g) => Subterms (f :+: g) where
-  gsubterms (L1 x) = gsubterms x
-  gsubterms (R1 x) = gsubterms x
+instance GSubterms V1 a where
+  -- The empty type can't be shrunk to anything.
+  gSubterms _ = []
 
-instance Subterms f => Subterms (M1 i c f) where
-  gsubterms (M1 x) = gsubterms x
+instance GSubterms U1 a where
+  gSubterms U1 = []
 
-instance Typeable a => Subterms (K1 i a) where
-  gsubterms (K1 x) =
-    case cast x of
-      Nothing -> []
-      Just y -> [y]
+instance (GSubtermsIncl f a, GSubtermsIncl g a) => GSubterms (f :*: g) a where
+  gSubterms (l :*: r) = gSubtermsIncl l ++ gSubtermsIncl r
 
-instance Subterms U1 where
-  gsubterms U1 = []
+instance (GSubtermsIncl f a, GSubtermsIncl g a) => GSubterms (f :+: g) a where
+  gSubterms (L1 x) = gSubtermsIncl x
+  gSubterms (R1 x) = gSubtermsIncl x
 
+instance GSubterms f a => GSubterms (M1 i c f) a where
+  gSubterms (M1 x) = gSubterms x
+
+instance GSubterms (K1 i a) b where
+  gSubterms (K1 _) = []
+
+
+class GSubtermsIncl f a where
+  -- | Provides the immediate subterms of a term that are of the same type
+  -- as the term itself.
+  --
+  -- In contrast to `gSubterms`, this returns the immediate next constructor
+  -- available.
+  gSubtermsIncl :: f a -> [a]
+
+instance GSubtermsIncl V1 a where
+  -- The empty type can't be shrunk to anything.
+  gSubtermsIncl _ = []
+
+instance GSubtermsIncl U1 a where
+  gSubtermsIncl U1 = []
+
+instance (GSubtermsIncl f a, GSubtermsIncl g a) => GSubtermsIncl (f :*: g) a where
+  gSubtermsIncl (l :*: r) = gSubtermsIncl l ++ gSubtermsIncl r
+
+instance (GSubtermsIncl f a, GSubtermsIncl g a) => GSubtermsIncl (f :+: g) a where
+  gSubtermsIncl (L1 x) = gSubtermsIncl x
+  gSubtermsIncl (R1 x) = gSubtermsIncl x
+
+instance GSubtermsIncl f a => GSubtermsIncl (M1 i c f) a where
+  gSubtermsIncl (M1 x) = gSubtermsIncl x
+
+-- This is the important case: We've found a term of the same type.
+instance Arbitrary a => GSubtermsIncl (K1 i a) a where
+  gSubtermsIncl (K1 x) = [x]
+
+instance GSubtermsIncl (K1 i a) b where
+  gSubtermsIncl (K1 _) = []
+
 #endif
 
 -- instances
@@ -363,6 +422,12 @@
   arbitrary = arbitrarySizedIntegral
   shrink    = shrinkIntegral
 
+#ifndef NO_NATURALS
+instance Arbitrary Natural where
+  arbitrary = arbitrarySizedNatural
+  shrink    = shrinkIntegral
+#endif
+
 instance Arbitrary Int where
   arbitrary = arbitrarySizedIntegral
   shrink    = shrinkIntegral
@@ -438,6 +503,13 @@
   sized $ \n ->
   inBounds fromInteger (choose (-toInteger n, toInteger n))
 
+-- | Generates a natural number. The number's maximum value depends on
+-- the size parameter.
+arbitrarySizedNatural :: Integral a => Gen a
+arbitrarySizedNatural =
+  sized $ \n ->
+  inBounds fromInteger (choose (0, toInteger n))
+
 inBounds :: Integral a => (Integer -> a) -> Gen Integer -> Gen a
 inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger (fi x) == x))
 
@@ -540,7 +612,25 @@
 --------------------------------------------------------------------------
 -- ** CoArbitrary
 
+#ifndef NO_GENERICS
 -- | Used for random generation of functions.
+--
+-- If you are using a recent GHC, there is a default definition of
+-- 'coarbitrary' using 'genericCoarbitrary', so if your type has a
+-- 'Generic' instance it's enough to say
+--
+-- > instance CoArbitrary MyType
+--
+-- You should only use 'genericCoarbitrary' for data types where
+-- equality is structural, i.e. if you can't have two different
+-- representations of the same value. An example where it's not
+-- safe is sets implemented using binary search trees: the same
+-- set can be represented as several different trees.
+-- Here you would have to explicitly define
+-- @coarbitrary s = coarbitrary (toList s)@.
+#else
+-- | Used for random generation of functions.
+#endif
 class CoArbitrary a where
   -- | Used to generate a function of type @a -> b@.
   -- The first argument is a value, the second a generator.
@@ -553,9 +643,37 @@
   --   coarbitrary []     = 'variant' 0
   --   coarbitrary (x:xs) = 'variant' 1 . coarbitrary (x,xs)
   -- @
-
   coarbitrary :: a -> Gen b -> Gen b
+#ifndef NO_GENERICS
+  default coarbitrary :: (Generic a, GCoArbitrary (Rep a)) => a -> Gen b -> Gen b
+  coarbitrary = genericCoarbitrary
 
+-- | Generic CoArbitrary implementation.
+genericCoarbitrary :: (Generic a, GCoArbitrary (Rep a)) => a -> Gen b -> Gen b
+genericCoarbitrary = gCoarbitrary . from
+
+class GCoArbitrary f where
+  gCoarbitrary :: f a -> Gen b -> Gen b
+
+instance GCoArbitrary U1 where
+  gCoarbitrary U1 = id
+
+instance (GCoArbitrary f, GCoArbitrary g) => GCoArbitrary (f :*: g) where
+  -- Like the instance for tuples.
+  gCoarbitrary (l :*: r) = gCoarbitrary l . gCoarbitrary r
+
+instance (GCoArbitrary f, GCoArbitrary g) => GCoArbitrary (f :+: g) where
+  -- Like the instance for Either.
+  gCoarbitrary (L1 x) = variant 0 . gCoarbitrary x
+  gCoarbitrary (R1 x) = variant 1 . gCoarbitrary x
+
+instance GCoArbitrary f => GCoArbitrary (M1 i c f) where
+  gCoarbitrary (M1 x) = gCoarbitrary x
+
+instance CoArbitrary a => GCoArbitrary (K1 i a) where
+  gCoarbitrary (K1 x) = coarbitrary x
+#endif
+
 {-# DEPRECATED (><) "Use ordinary function composition instead" #-}
 -- | Combine two generator perturbing functions, for example the
 -- results of calls to 'variant' or 'coarbitrary'.
@@ -636,6 +754,11 @@
 
 instance CoArbitrary Integer where
   coarbitrary = coarbitraryIntegral
+
+#ifndef NO_NATURALS
+instance CoArbitrary Natural where
+  coarbitrary = coarbitraryIntegral
+#endif
 
 instance CoArbitrary Int where
   coarbitrary = coarbitraryIntegral
diff --git a/Test/QuickCheck/Exception.hs b/Test/QuickCheck/Exception.hs
--- a/Test/QuickCheck/Exception.hs
+++ b/Test/QuickCheck/Exception.hs
@@ -80,7 +80,7 @@
 tryEvaluateIO m = E.try (m >>= E.evaluate)
 --tryEvaluateIO m = Right `fmap` m
 
--- Test if an exception was a ^C.
+-- | Test if an exception was a @^C@.
 -- QuickCheck won't try to shrink an interrupted test case.
 isInterrupt :: AnException -> Bool
 
diff --git a/Test/QuickCheck/Function.hs b/Test/QuickCheck/Function.hs
--- a/Test/QuickCheck/Function.hs
+++ b/Test/QuickCheck/Function.hs
@@ -1,4 +1,9 @@
-{-# LANGUAGE TypeOperators, GADTs #-}
+{-# LANGUAGE TypeOperators, GADTs, CPP #-}
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE PatternSynonyms #-}
+#endif
+
 -- | Generation of random shrinkable, showable functions.
 -- See the paper \"Shrinking and showing functions\" by Koen Claessen.
 --
@@ -24,6 +29,9 @@
   , Function(..)
   , functionMap
   , functionShow
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
+  , pattern Fn
+#endif
   )
  where
 
@@ -37,11 +45,13 @@
 import Data.Word
 import Data.List( intersperse )
 import Data.Maybe( fromJust )
+import Data.Ratio
+import Control.Arrow( (&&&) )
 
 --------------------------------------------------------------------------
 -- concrete functions
 
--- the type of possibly partial concrete functions
+-- | The type of possibly partial concrete functions
 data a :-> c where
   Pair  :: (a :-> (b :-> c)) -> ((a,b) :-> c)
   (:+:) :: (a :-> c) -> (b :-> c) -> (Either a b :-> c)
@@ -186,6 +196,9 @@
     ord' c = fromIntegral (ord c) :: Word8
     chr' n = chr (fromIntegral n)
 
+instance (Function a, Integral a) => Function (Ratio a) where
+  function = functionMap (numerator &&& denominator) (uncurry (%))
+
 -- poly instances
 
 instance Function A where
@@ -260,6 +273,15 @@
 -- the Fun modifier
 
 data Fun a b = Fun (a :-> b, b) (a -> b)
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
+-- | A pattern for matching against the function only:
+--
+-- > prop :: Fun String Integer -> Bool
+-- > prop (Fn f) = f "banana" == f "monkey"
+--              || f "banana" == f "elephant"
+pattern Fn f <- Fun _ f
+#endif
 
 mkFun :: (a :-> b) -> b -> Fun a b
 mkFun p d = Fun (p,d) (abstract p d)
diff --git a/Test/QuickCheck/Gen.hs b/Test/QuickCheck/Gen.hs
--- a/Test/QuickCheck/Gen.hs
+++ b/Test/QuickCheck/Gen.hs
@@ -19,12 +19,19 @@
 import Control.Monad
   ( liftM
   , ap
+  , replicateM
+  , filterM
   )
 
 import Control.Applicative
   ( Applicative(..)
+  , (<$>)
   )
 
+import Control.Arrow
+  ( second
+  )
+
 import Test.QuickCheck.Random
 
 --------------------------------------------------------------------------
@@ -69,8 +76,14 @@
 -- | Overrides the size parameter. Returns a generator which uses
 -- the given size instead of the runtime-size parameter.
 resize :: Int -> Gen a -> Gen a
-resize n (MkGen m) = MkGen (\r _ -> m r n)
+resize n _ | n < 0 = error "Test.QuickCheck.resize: negative size"
+resize n (MkGen g) = MkGen (\r _ -> g r n)
 
+-- | Adjust the size parameter, by transforming it with the given
+-- function.
+scale :: (Int -> Int) -> Gen a -> Gen a
+scale f g = sized (\n -> resize (f n) g)
+
 -- | Generates a random element in the given inclusive range.
 choose :: Random a => (a,a) -> Gen a
 choose rng = MkGen (\r _ -> let (x,_) = randomR rng r in x)
@@ -135,6 +148,20 @@
 elements [] = error "QuickCheck.elements used with empty list"
 elements xs = (xs !!) `fmap` choose (0, length xs - 1)
 
+-- | Generates a random subsequence of the given list.
+sublistOf :: [a] -> Gen [a]
+sublistOf xs = filterM (\_ -> choose (False, True)) xs
+
+-- | Generates a random permutation of the given list.
+shuffle :: [a] -> Gen [a]
+shuffle [] = return []
+shuffle xs = do
+  (y, ys) <- elements (selectOne xs)
+  (y:) <$> shuffle ys
+  where
+    selectOne [] = []
+    selectOne (y:ys) = (y,ys) : map (second (y:)) (selectOne ys)
+
 -- | Takes a list of elements of increasing size, and chooses
 -- among an initial segment of the list. The size of this initial
 -- segment increases with the size parameter.
@@ -171,7 +198,7 @@
 
 -- | Generates a list of the given length.
 vectorOf :: Int -> Gen a -> Gen [a]
-vectorOf k gen = sequence [ gen | _ <- [1..k] ]
+vectorOf = replicateM
 
 -- | Generates an infinite list.
 infiniteListOf :: Gen a -> Gen [a]
diff --git a/Test/QuickCheck/Gen/Unsafe.hs b/Test/QuickCheck/Gen/Unsafe.hs
--- a/Test/QuickCheck/Gen/Unsafe.hs
+++ b/Test/QuickCheck/Gen/Unsafe.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE Rank2Types #-}
 #endif
 -- | Unsafe combinators for the 'Gen' monad.
--- 
+--
 -- 'Gen' is only morally a monad: two generators that are supposed
 -- to be equal will give the same probability distribution, but they
 -- might be different as functions from random number seeds to values.
diff --git a/Test/QuickCheck/Monadic.hs b/Test/QuickCheck/Monadic.hs
--- a/Test/QuickCheck/Monadic.hs
+++ b/Test/QuickCheck/Monadic.hs
@@ -2,11 +2,70 @@
 #ifndef NO_ST_MONAD
 {-# LANGUAGE Rank2Types #-}
 #endif
--- | Allows testing of monadic values.
--- See the paper \"Testing Monadic Code with QuickCheck\":
--- <http://www.cse.chalmers.se/~rjmh/Papers/QuickCheckST.ps>.
-module Test.QuickCheck.Monadic where
+{-|
+Module   : Test.QuickCheck.Monadic
 
+Allows testing of monadic values. Will generally follow this form:
+
+@
+prop_monadic a b = 'monadicIO' $ do
+  a\' \<- 'run' (f a)
+  b\' \<- 'run' (f b)
+  -- ...
+  'assert' someBoolean
+@
+
+Example using the @FACTOR(1)@ command-line utility:
+
+@
+import System.Process
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
+
+-- $ factor 16
+-- 16: 2 2 2 2
+factor :: Integer -> IO [Integer]
+factor n = parse \`fmap\` 'System.Process.readProcess' \"factor\" [show n] \"\" where
+
+  parse :: String -> [Integer]
+  parse = map read . tail . words
+
+prop_factor :: Positive Integer -> Property
+prop_factor ('Test.QuickCheck.Modifiers.Positive' n) = 'monadicIO' $ do
+  factors \<- 'run' (factor n)
+
+  'assert' (product factors == n)
+@
+
+>>> quickCheck prop_factor
++++ OK, passed 100 tests.
+
+See the paper \"<http://www.cse.chalmers.se/~rjmh/Papers/QuickCheckST.ps Testing Monadic Code with QuickCheck>\".
+-}
+module Test.QuickCheck.Monadic (
+  -- * Property monad
+    PropertyM(..)
+
+  -- * Monadic specification combinators
+  , run
+  , assert
+  , pre
+  , wp
+  , pick
+  , forAllM
+  , monitor
+  , stop
+
+  -- * Run functions
+  , monadic
+  , monadic'
+  , monadicIO
+#ifndef NO_ST_MONAD
+  , monadicST
+  , runSTGen
+#endif
+  ) where
+
 --------------------------------------------------------------------------
 -- imports
 
@@ -27,6 +86,12 @@
 --------------------------------------------------------------------------
 -- type PropertyM
 
+-- | The property monad is really a monad transformer that can contain
+-- monadic computations in the monad @m@ it is parameterized by:
+--
+--   * @m@ - the @m@-computations that may be performed within @PropertyM@
+--
+-- Elements of @PropertyM m a@ may mix property operations and @m@-computations.
 newtype PropertyM m a =
   MkPropertyM { unPropertyM :: (a -> Gen (m Property)) -> Gen (m Property) }
 
@@ -54,20 +119,49 @@
 stop p = MkPropertyM (\_k -> return (return (property p)))
 
 -- should think about strictness/exceptions here
---assert :: Testable prop => prop -> PropertyM m ()
+-- assert :: Testable prop => prop -> PropertyM m ()
+-- | Allows embedding non-monadic properties into monadic ones.
 assert :: Monad m => Bool -> PropertyM m ()
-assert True = return ()
+assert True  = return ()
 assert False = fail "Assertion failed"
 
 -- should think about strictness/exceptions here
+-- | Tests preconditions. Unlike 'assert' this does not cause the
+-- property to fail, rather it discards them just like using the
+-- implication combinator 'Test.QuickCheck.Property.==>'.
+--
+-- This allows representing the <https://en.wikipedia.org/wiki/Hoare_logic Hoare triple>
+--
+-- > {p} x ← e{q}
+--
+-- as
+--
+-- @
+-- pre p
+-- x \<- run e
+-- assert q
+-- @
+--
 pre :: Monad m => Bool -> PropertyM m ()
-pre True = return ()
+pre True  = return ()
 pre False = stop rejected
 
 -- should be called lift?
+-- | The lifting operation of the property monad. Allows embedding
+-- monadic\/'IO'-actions in properties:
+--
+-- @
+-- log :: Int -> IO ()
+--
+-- prop_foo n = monadicIO $ do
+--   run (log n)
+--   -- ...
+-- @
 run :: Monad m => m a -> PropertyM m a
 run m = MkPropertyM (liftM (m >>=) . promote)
 
+-- | Quantification in a monadic property, fits better with
+-- /do-notation/ than 'forAllM'.
 pick :: (Monad m, Show a) => Gen a -> PropertyM m a
 pick gen = MkPropertyM $ \k ->
   do a <- gen
@@ -75,12 +169,33 @@
      return (do p <- mp
                 return (forAll (return a) (const p)))
 
+-- | The <https://en.wikipedia.org/wiki/Predicate_transformer_semantics#Weakest_preconditions weakest precondition>
+--
+-- > wp(x ← e, p)
+--
+-- can be expressed as in code as @wp e (\\x -> p)@.
 wp :: Monad m => m a -> (a -> PropertyM m b) -> PropertyM m b
 wp m k = run m >>= k
 
+-- | An alternative to quantification a monadic properties to 'pick',
+-- with a notation similar to 'forAll'.
+
 forAllM :: (Monad m, Show a) => Gen a -> (a -> PropertyM m b) -> PropertyM m b
 forAllM gen k = pick gen >>= k
 
+-- | Allows making observations about the test data:
+--
+-- @
+-- monitor ('collect' e)
+-- @
+--
+-- collects the distribution of value of @e@.
+--
+-- @
+-- monitor ('counterexample' "Failure!")
+-- @
+--
+-- Adds @"Failure!"@ to the counterexamples.
 monitor :: Monad m => (Property -> Property) -> PropertyM m ()
 monitor f = MkPropertyM (\k -> (f `liftM`) `fmap` (k ()))
 
@@ -92,10 +207,39 @@
 monadic' :: Monad m => PropertyM m a -> Gen (m Property)
 monadic' (MkPropertyM m) = m (const (return (return (property True))))
 
+-- | Runs the property monad for 'IO'-computations.
+--
+-- @
+-- prop_cat msg = monadicIO $ do
+--   (exitCode, stdout, _) \<- run ('System.Process.readProcessWithExitCode' "cat" [] msg)
+--
+--   pre ('System.Exit.ExitSuccess' == exitCode)
+--
+--   assert (stdout == msg)
+-- @
+--
+-- >>> quickCheck prop_cat
+-- +++ OK, passed 100 tests.
+--
 monadicIO :: PropertyM IO a -> Property
 monadicIO = monadic ioProperty
 
 #ifndef NO_ST_MONAD
+-- | Runs the property monad for 'ST'-computations.
+--
+-- @
+-- -- Your mutable sorting algorithm here
+-- sortST :: Ord a => [a] -> 'Control.Monad.ST.ST' s (MVector s a)
+-- sortST = 'Data.Vector.thaw' . 'Data.Vector.fromList' . 'Data.List.sort'
+--
+-- prop_sortST xs = monadicST $ do
+--   sorted  \<- run ('Data.Vector.freeze' =<< sortST xs)
+--   assert ('Data.Vector.toList' sorted == sort xs)
+-- @
+--
+-- >>> quickCheck prop_sortST
+-- +++ OK, passed 100 tests.
+--
 monadicST :: (forall s. PropertyM (ST s) a) -> Property
 monadicST m = property (runSTGen (monadic' m))
 
diff --git a/Test/QuickCheck/Property.hs b/Test/QuickCheck/Property.hs
--- a/Test/QuickCheck/Property.hs
+++ b/Test/QuickCheck/Property.hs
@@ -13,7 +13,7 @@
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck.Text( showErr, isOneLine, putLine )
 import Test.QuickCheck.Exception
-import Test.QuickCheck.State
+import Test.QuickCheck.State hiding (labels)
 
 #ifndef NO_TIMEOUT
 import System.Timeout(timeout)
@@ -21,6 +21,10 @@
 import Data.Maybe
 import Control.Applicative
 import Control.Monad
+import qualified Data.Map as Map
+import Data.Map(Map)
+import qualified Data.Set as Set
+import Data.Set(Set)
 
 --------------------------------------------------------------------------
 -- fixities
@@ -168,23 +172,23 @@
   -- k must be total
   m >>= k  = joinRose (fmap k m)
 
--- Execute the "IORose" bits of a rose tree, returning a tree
+-- | Execute the "IORose" bits of a rose tree, returning a tree
 -- constructed by MkRose.
 reduceRose :: Rose Result -> IO (Rose Result)
 reduceRose r@(MkRose _ _) = return r
 reduceRose (IORose m) = m >>= reduceRose
 
--- Apply a function to the outermost MkRose constructor of a rose tree.
+-- | Apply a function to the outermost MkRose constructor of a rose tree.
 -- The function must be total!
 onRose :: (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
 onRose f (MkRose x rs) = f x rs
 onRose f (IORose m) = IORose (fmap (onRose f) m)
 
--- Wrap a rose tree in an exception handler.
+-- | Wrap a rose tree in an exception handler.
 protectRose :: IO (Rose Result) -> IO (Rose Result)
 protectRose = protect (return . exception "Exception")
 
--- Wrap all the Results in a rose tree in exception handlers.
+-- | Wrap all the Results in a rose tree in exception handlers.
 protectResults :: Rose Result -> Rose Result
 protectResults = onRose $ \x rs ->
   IORose $ do
@@ -208,7 +212,8 @@
   , reason       :: String            -- ^ a message indicating what went wrong
   , theException :: Maybe AnException -- ^ the exception thrown, if any
   , abort        :: Bool              -- ^ if True, the test should not be repeated
-  , stamp        :: [(String,Int)]    -- ^ the collected values for this test case
+  , labels       :: Map String Int    -- ^ all labels used by this property
+  , stamp        :: Set String        -- ^ the collected values for this test case
   , callbacks    :: [Callback]        -- ^ the callbacks for this test case
   }
 
@@ -220,7 +225,8 @@
   , reason       = ""
   , theException = Nothing
   , abort        = False
-  , stamp        = []
+  , labels       = Map.empty
+  , stamp        = Set.empty
   , callbacks    = []
   }
 
@@ -364,17 +370,22 @@
          -> prop -> Property
 classify b s = cover b 0 s
 
--- | Checks that at least the given proportion of the test cases belong
--- to the given class.
+-- | Checks that at least the given proportion of /successful/ test
+-- cases belong to the given class. Discarded tests (i.e. ones
+-- with a false precondition) do not affect coverage.
 cover :: Testable prop =>
          Bool   -- ^ @True@ if the test case belongs to the class.
       -> Int    -- ^ The required percentage (0-100) of test cases.
       -> String -- ^ Label for the test case class.
       -> prop -> Property
-cover True n s = n `seq` s `listSeq` (mapTotalResult $ \res -> res { stamp = (s,n) : stamp res })
+cover x n s =
+  x `seq` n `seq` s `listSeq`
+  mapTotalResult $
+    \res -> res {
+      labels = Map.insertWith max s n (labels res),
+      stamp = if x then Set.insert s (stamp res) else stamp res }
   where [] `listSeq` z = z
         (x:xs) `listSeq` z = x `seq` xs `listSeq` z
-cover False _ _ = property
 
 -- | Implication for properties: The resulting property holds if
 -- the first argument is 'False' (in which case the test case is discarded),
@@ -440,20 +451,20 @@
 conjoin ps =
   MkProperty $
   do roses <- mapM (fmap unProp . unProperty . property) ps
-     return (MkProp (conj [] roses))
+     return (MkProp (conj id roses))
  where
-  conj cbs [] =
-    MkRose succeeded{callbacks = cbs} []
+  conj k [] =
+    MkRose (k succeeded) []
 
-  conj cbs (p : ps) = IORose $ do
+  conj k (p : ps) = IORose $ do
     rose@(MkRose result _) <- reduceRose p
     case ok result of
       _ | not (expect result) ->
         return (return failed { reason = "expectFailure may not occur inside a conjunction" })
-      Just True -> return (conj (cbs ++ callbacks result) ps)
+      Just True -> return (conj (addLabels result . addCallbacks result . k) ps)
       Just False -> return rose
       Nothing -> do
-        rose2@(MkRose result2 _) <- reduceRose (conj (cbs ++ callbacks result) ps)
+        rose2@(MkRose result2 _) <- reduceRose (conj (addCallbacks result . k) ps)
         return $
           -- Nasty work to make sure we use the right callbacks
           case ok result2 of
@@ -461,6 +472,12 @@
             Just False -> rose2
             Nothing -> rose2
 
+  addCallbacks result r =
+    r { callbacks = callbacks result ++ callbacks r }
+  addLabels result r =
+    r { labels = Map.unionWith max (labels result) (labels r),
+        stamp = Set.union (stamp result) (stamp r) }
+
 -- | Disjunction: 'p1' '.||.' 'p2' passes unless 'p1' and 'p2' simultaneously fail.
 (.||.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
 p1 .||. p2 = disjoin [property p1, property p2]
@@ -481,12 +498,25 @@
          Just False -> do
            result2 <- q
            return $
-             if expect result2 then
-               case ok result2 of
-                 Just True -> result2
-                 Just False -> result1 >>> result2
-                 Nothing -> result2
-             else expectFailureError
+             case ok result2 of
+               _ | not (expect result2) -> expectFailureError
+               Just True -> result2
+               Just False ->
+                 MkResult {
+                   ok = Just False,
+                   expect = True,
+                   reason = sep (reason result1) (reason result2),
+                   theException = theException result1 `mplus` theException result2,
+                   -- The following three fields are not important because the
+                   -- test case has failed anyway
+                   abort = False,
+                   labels = Map.empty,
+                   stamp = Set.empty,
+                   callbacks =
+                     callbacks result1 ++
+                     [PostFinalFailure Counterexample $ \st _res -> putLine (terminal st) ""] ++
+                     callbacks result2 }
+               Nothing -> result2
          Nothing -> do
            result2 <- q
            return (case ok result2 of
@@ -495,16 +525,9 @@
                      _ -> result1)
 
   expectFailureError = failed { reason = "expectFailure may not occur inside a disjunction" }
-  result1 >>> result2 | not (expect result1 && expect result2) = expectFailureError
-  result1 >>> result2 =
-    result2
-    { reason       = if null (reason result2) then reason result1 else reason result2
-    , theException = if null (reason result2) then theException result1 else theException result2
-    , stamp        = stamp result1 ++ stamp result2
-    , callbacks    = callbacks result1 ++
-                    [PostFinalFailure Counterexample $ \st _res -> putLine (terminal st) ""] ++
-                    callbacks result2
-    }
+  sep [] s = s
+  sep s [] = s
+  sep s s' = s ++ ", " ++ s'
 
 -- | Like '==', but prints a counterexample when it fails.
 infix 4 ===
diff --git a/Test/QuickCheck/State.hs b/Test/QuickCheck/State.hs
--- a/Test/QuickCheck/State.hs
+++ b/Test/QuickCheck/State.hs
@@ -3,6 +3,9 @@
 
 import Test.QuickCheck.Text
 import Test.QuickCheck.Random
+import qualified Data.Map as Map
+import Data.Map(Map)
+import Data.Set(Set)
 
 --------------------------------------------------------------------------
 -- State
@@ -16,20 +19,21 @@
   , maxSuccessTests           :: Int               -- ^ maximum number of successful tests needed
   , maxDiscardedTests         :: Int               -- ^ maximum number of tests that can be discarded
   , computeSize               :: Int -> Int -> Int -- ^ how to compute the size of test cases from
-                                                   -- #tests and #discarded tests
+                                                   --   #tests and #discarded tests
 
-                                                   -- dynamic
-  , numSuccessTests           :: Int               -- ^ the current number of tests that have succeeded
-  , numDiscardedTests         :: Int               -- ^ the current number of discarded tests
-  , numRecentlyDiscardedTests :: Int               -- ^ the number of discarded tests since the last successful test
-  , collected                 :: [[(String,Int)]]  -- ^ all labels that have been collected so far
-  , expectedFailure           :: Bool              -- ^ indicates if the property is expected to fail
-  , randomSeed                :: QCGen             -- ^ the current random seed
+  -- dynamic
+  , numSuccessTests           :: !Int              -- ^ the current number of tests that have succeeded
+  , numDiscardedTests         :: !Int              -- ^ the current number of discarded tests
+  , numRecentlyDiscardedTests :: !Int              -- ^ the number of discarded tests since the last successful test
+  , labels                    :: !(Map String Int) -- ^ all labels that have been defined so far
+  , collected                 :: ![Set String]     -- ^ all labels that have been collected so far
+  , expectedFailure           :: !Bool             -- ^ indicates if the property is expected to fail
+  , randomSeed                :: !QCGen            -- ^ the current random seed
 
                                                    -- shrinking
-  , numSuccessShrinks         :: Int               -- ^ number of successful shrinking steps so far
-  , numTryShrinks             :: Int               -- ^ number of failed shrinking steps since the last successful shrink
-  , numTotTryShrinks          :: Int               -- ^ total number of failed shrinking steps
+  , numSuccessShrinks         :: !Int              -- ^ number of successful shrinking steps so far
+  , numTryShrinks             :: !Int              -- ^ number of failed shrinking steps since the last successful shrink
+  , numTotTryShrinks          :: !Int              -- ^ total number of failed shrinking steps
   }
 
 --------------------------------------------------------------------------
diff --git a/Test/QuickCheck/Test.hs b/Test/QuickCheck/Test.hs
--- a/Test/QuickCheck/Test.hs
+++ b/Test/QuickCheck/Test.hs
@@ -9,13 +9,16 @@
 -- imports
 
 import Test.QuickCheck.Gen
-import Test.QuickCheck.Property hiding ( Result( reason, theException) )
+import Test.QuickCheck.Property hiding ( Result( reason, theException, labels ) )
 import qualified Test.QuickCheck.Property as P
 import Test.QuickCheck.Text
-import Test.QuickCheck.State
+import Test.QuickCheck.State hiding (labels)
+import qualified Test.QuickCheck.State as S
 import Test.QuickCheck.Exception
 import Test.QuickCheck.Random
 import System.Random(split)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 import Data.Char
   ( isSpace
@@ -76,6 +79,12 @@
     , labels         :: [(String,Int)]    --   Labels and frequencies found during all successful tests
     , output         :: String            --   Printed output
     }
+ -- | The tests passed but a use of 'cover' had insufficient coverage
+ | InsufficientCoverage
+    { numTests       :: Int               --   Number of tests performed
+    , labels         :: [(String,Int)]    --   Labels and frequencies found during all successful tests
+    , output         :: String            --   Printed output
+    }
  deriving ( Show )
 
 -- | Check if the test run result was a success
@@ -121,6 +130,7 @@
                  , numSuccessTests           = 0
                  , numDiscardedTests         = 0
                  , numRecentlyDiscardedTests = 0
+                 , S.labels                  = Map.empty
                  , collected                 = []
                  , expectedFailure           = False
                  , randomSeed                = rnd
@@ -173,31 +183,34 @@
   | otherwise                                    = runATest st f
 
 doneTesting :: State -> (QCGen -> Int -> Prop) -> IO Result
-doneTesting st _f =
-  do -- CALLBACK done_testing?
-     if expectedFailure st then
-       putPart (terminal st)
-         ( "+++ OK, passed "
-        ++ show (numSuccessTests st)
-        ++ " tests"
-         )
-      else
-       putPart (terminal st)
-         ( bold ("*** Failed!")
-        ++ " Passed "
-        ++ show (numSuccessTests st)
-        ++ " tests (expected failure)"
-         )
-     success st
-     theOutput <- terminalOutput (terminal st)
-     if expectedFailure st then
-       return Success{ labels = summary st,
-                       numTests = numSuccessTests st,
-                       output = theOutput }
-      else
-       return NoExpectedFailure{ labels = summary st,
-                                 numTests = numSuccessTests st,
-                                 output = theOutput }
+doneTesting st _f
+  | not (expectedFailure st) = do
+      putPart (terminal st)
+        ( bold ("*** Failed!")
+       ++ " Passed "
+       ++ show (numSuccessTests st)
+       ++ " tests (expected failure)"
+        )
+      finished NoExpectedFailure
+  | insufficientCoverage st = do
+      putPart (terminal st)
+        ( bold ("*** Insufficient coverage after ")
+       ++ show (numSuccessTests st)
+       ++ " tests"
+        )
+      finished InsufficientCoverage
+  | otherwise = do
+      putPart (terminal st)
+        ( "+++ OK, passed "
+       ++ show (numSuccessTests st)
+       ++ " tests"
+        )
+      finished Success
+  where
+    finished k = do
+      success st
+      theOutput <- terminalOutput (terminal st)
+      return (k (numSuccessTests st) (summary st) theOutput)
 
 giveUp :: State -> (QCGen -> Int -> Prop) -> IO Result
 giveUp st _f =
@@ -228,10 +241,13 @@
         )
      let size = computeSize st (numSuccessTests st) (numRecentlyDiscardedTests st)
      MkRose res ts <- protectRose (reduceRose (unProp (f rnd1 size)))
-     callbackPostTest st res
+     res <- callbackPostTest st res
 
      let continue break st' | abort res = break st'
                             | otherwise = test st'
+         cons x xs
+           | Set.null x = xs
+           | otherwise = x:xs
 
      case res of
        MkResult{ok = Just True, stamp = stamp, expect = expect} -> -- successful test
@@ -239,7 +255,8 @@
               st{ numSuccessTests           = numSuccessTests st + 1
                 , numRecentlyDiscardedTests = 0
                 , randomSeed                = rnd2
-                , collected                 = stamp : collected st
+                , S.labels                  = Map.unionWith max (S.labels st) (P.labels res)
+                , collected                 = stamp `cons` collected st
                 , expectedFailure           = expect
                 } f
 
@@ -248,6 +265,7 @@
               st{ numDiscardedTests         = numDiscardedTests st + 1
                 , numRecentlyDiscardedTests = numRecentlyDiscardedTests st + 1
                 , randomSeed                = rnd2
+                , S.labels                  = Map.unionWith max (S.labels st) (P.labels res)
                 , expectedFailure           = expect
                 } f
 
@@ -282,10 +300,9 @@
            . map (\ss -> (head ss, (length ss * 100) `div` numSuccessTests st))
            . group
            . sort
-           $ [ concat (intersperse ", " s')
+           $ [ concat (intersperse ", " (Set.toList s))
              | s <- collected st
-             , let s' = [ t | (t,_) <- s ]
-             , not (null s')
+             , not (Set.null s)
              ]
 
 success :: State -> IO ()
@@ -307,30 +324,28 @@
             . sort
             $ [ concat (intersperse ", " s')
               | s <- collected st
-              , let s' = [ t | (t,0) <- s ]
+              , let s' = [ t | t <- Set.toList s, Map.lookup t (S.labels st) == Just 0 ]
               , not (null s')
               ]
 
-  covers = [ ("only " ++ show occurP ++ "% " ++ fst (head lps) ++ "; not " ++ show reqP ++ "%")
-           | lps <- groupBy first
-                  . sort
-                  $ [ lp
-                    | lps <- collected st
-                    , lp <- maxi lps
-                    , snd lp > 0
-                    ]
-           , let occurP = (100 * length lps) `div` maxSuccessTests st
-                 reqP   = maximum (map snd lps)
-           , occurP < reqP
+  covers = [ ("only " ++ show (labelPercentage l st) ++ "% " ++ l ++ ", not " ++ show reqP ++ "%")
+           | (l, reqP) <- Map.toList (S.labels st)
+           , labelPercentage l st < reqP
            ]
 
-  (x,_) `first` (y,_) = x == y
+  showP p = (if p < 10 then " " else "") ++ show p ++ "% "
 
-  maxi = map (\lps -> (fst (head lps), maximum (map snd lps)))
-       . groupBy first
-       . sort
+labelPercentage :: String -> State -> Int
+labelPercentage l st =
+  -- XXX in case of a disjunction, a label can occur several times,
+  -- need to think what to do there
+  (100 * occur) `div` maxSuccessTests st
+  where
+    occur = length [ l' | l' <- concat (map Set.toList (collected st)), l == l' ]
 
-  showP p = (if p < 10 then " " else "") ++ show p ++ "% "
+insufficientCoverage :: State -> Bool
+insufficientCoverage st =
+  or [ labelPercentage l st < reqP | (l, reqP) <- Map.toList (S.labels st) ]
 
 --------------------------------------------------------------------------
 -- main shrinking loop
@@ -343,33 +358,38 @@
 localMin st MkResult{P.theException = Just e} lastRes _
   | isInterrupt e = localMinFound st lastRes
 localMin st res _ ts = do
-  putTemp (terminal st)
-    ( short 26 (oneLine (P.reason res))
-   ++ " (after " ++ number (numSuccessTests st+1) "test"
-   ++ concat [ " and "
-            ++ show (numSuccessShrinks st)
-            ++ concat [ "." ++ show (numTryShrinks st) | numTryShrinks st > 0 ]
-            ++ " shrink"
-            ++ (if numSuccessShrinks st == 1
-                && numTryShrinks st == 0
-                then "" else "s")
-             | numSuccessShrinks st > 0 || numTryShrinks st > 0
-             ]
-   ++ ")..."
-    )
-  r <- tryEvaluate ts
+  r <- tryEvaluateIO $
+    putTemp (terminal st)
+      ( short 26 (oneLine (P.reason res))
+     ++ " (after " ++ number (numSuccessTests st+1) "test"
+     ++ concat [ " and "
+              ++ show (numSuccessShrinks st)
+              ++ concat [ "." ++ show (numTryShrinks st) | numTryShrinks st > 0 ]
+              ++ " shrink"
+              ++ (if numSuccessShrinks st == 1
+                  && numTryShrinks st == 0
+                  then "" else "s")
+               | numSuccessShrinks st > 0 || numTryShrinks st > 0
+               ]
+     ++ ")..."
+      )
   case r of
     Left err ->
-      localMinFound st
-         (exception "Exception while generating shrink-list" err) { callbacks = callbacks res }
-    Right ts' -> localMin' st res ts'
+      localMinFound st (exception "Exception while printing status message" err) { callbacks = callbacks res }
+    Right () -> do
+      r <- tryEvaluate ts
+      case r of
+        Left err ->
+          localMinFound st
+            (exception "Exception while generating shrink-list" err) { callbacks = callbacks res }
+        Right ts' -> localMin' st res ts'
 
 localMin' :: State -> P.Result -> [Rose P.Result] -> IO (Int, Int, Int)
 localMin' st res [] = localMinFound st res
 localMin' st res (t:ts) =
   do -- CALLBACK before_test
     MkRose res' ts' <- protectRose (reduceRose t)
-    callbackPostTest st res'
+    res' <- callbackPostTest st res'
     if ok res' == Just False
       then localMin st{ numSuccessShrinks = numSuccessShrinks st + 1,
                         numTryShrinks     = 0 } res' res ts'
@@ -394,28 +414,27 @@
            | msg <- lines (P.reason res)
            ]
      callbackPostFinalFailure st res
+     -- NB no need to check if callbacks threw an exception because
+     -- we are about to return to the user anyway
      return (numSuccessShrinks st, numTotTryShrinks st - numTryShrinks st, numTryShrinks st)
 
 --------------------------------------------------------------------------
 -- callbacks
 
-callbackPostTest :: State -> P.Result -> IO ()
-callbackPostTest st res =
-  sequence_ [ safely st (f st res) | PostTest _ f <- callbacks res ]
+callbackPostTest :: State -> P.Result -> IO P.Result
+callbackPostTest st res = protect (exception "Exception running callback") $ do
+  sequence_ [ f st res | PostTest _ f <- callbacks res ]
+  return res
 
 callbackPostFinalFailure :: State -> P.Result -> IO ()
-callbackPostFinalFailure st res =
-  sequence_ [ safely st (f st res) | PostFinalFailure _ f <- callbacks res ]
-
-safely :: State -> IO () -> IO ()
-safely st x = do
-  r <- tryEvaluateIO x
-  case r of
-    Left e ->
-      putLine (terminal st)
-        ("*** Exception in callback: " ++ show e)
-    Right x ->
-      return x
+callbackPostFinalFailure st res = do
+  x <- tryEvaluateIO $ sequence_ [ f st res | PostFinalFailure _ f <- callbacks res ]
+  case x of
+    Left err -> do
+      putLine (terminal st) "*** Exception running callback: "
+      tryEvaluateIO $ putLine (terminal st) (show err)
+      return ()
+    Right () -> return ()
 
 --------------------------------------------------------------------------
 -- the end.
diff --git a/Test/QuickCheck/Text.hs b/Test/QuickCheck/Text.hs
--- a/Test/QuickCheck/Text.hs
+++ b/Test/QuickCheck/Text.hs
@@ -85,15 +85,13 @@
 -- putting strings
 
 data Terminal
-  = MkTerminal (IORef (IO ())) Output Output
-
-data Output
-  = Output (String -> IO ()) (IORef String)
+  = MkTerminal (IORef String) (IORef Int) (String -> IO ()) (String -> IO ())
 
-newTerminal :: Output -> Output -> IO Terminal
+newTerminal :: (String -> IO ()) -> (String -> IO ()) -> IO Terminal
 newTerminal out err =
-  do ref <- newIORef (return ())
-     return (MkTerminal ref out err)
+  do res <- newIORef ""
+     tmp <- newIORef 0
+     return (MkTerminal res tmp out err)
 
 withBuffering :: IO a -> IO a
 withBuffering action = do
@@ -104,65 +102,39 @@
   action `finally` hSetBuffering stderr mode
 
 withStdioTerminal :: (Terminal -> IO a) -> IO a
-withStdioTerminal action = do
-  out <- output (handle stdout)
-  err <- output (handle stderr)
-  withBuffering (newTerminal out err >>= action)
+withStdioTerminal action =
+  withBuffering (newTerminal (handle stdout) (handle stderr) >>= action)
 
 withNullTerminal :: (Terminal -> IO a) -> IO a
-withNullTerminal action = do
-  out <- output (const (return ()))
-  err <- output (const (return ()))
-  newTerminal out err >>= action
+withNullTerminal action =
+  newTerminal (const (return ())) (const (return ())) >>= action
 
 terminalOutput :: Terminal -> IO String
-terminalOutput (MkTerminal _ out _) = get out
+terminalOutput (MkTerminal res _ _ _) = readIORef res
 
 handle :: Handle -> String -> IO ()
 handle h s = do
   hPutStr h s
   hFlush h
 
-output :: (String -> IO ()) -> IO Output
-output f = do
-  r <- newIORef ""
-  return (Output f r)
-
-put :: Output -> String -> IO ()
-put (Output f r) s = do
-  f s
-  modifyIORef r (++ s)
-
-get :: Output -> IO String
-get (Output _ r) = readIORef r
-
 flush :: Terminal -> IO ()
-flush (MkTerminal ref _ _) =
-  do io <- readIORef ref
-     writeIORef ref (return ())
-     io
-
-postpone :: Terminal -> IO () -> IO ()
-postpone (MkTerminal ref _ _) io' =
-  do io <- readIORef ref
-     writeIORef ref (io >> io')
+flush (MkTerminal _ tmp _ err) =
+  do n <- readIORef tmp
+     writeIORef tmp 0
+     err (replicate n ' ' ++ replicate n '\b')
 
 putPart, putTemp, putLine :: Terminal -> String -> IO ()
-putPart tm@(MkTerminal _ out _) s =
+putPart tm@(MkTerminal res _ out _) s =
   do flush tm
-     put out s
+     out s
+     modifyIORef res (++ s)
 
-putTemp tm@(MkTerminal _ _ err) s =
-  do flush tm
-     put err (s ++ [ '\b' | _ <- s ])
-     postpone tm $
-       put err ( [ ' ' | _ <- s ]
-              ++ [ '\b' | _ <- s ]
-               )
+putLine tm s = putPart tm (s ++ "\n")
 
-putLine tm@(MkTerminal _ out _) s =
+putTemp tm@(MkTerminal _ tmp _ err) s =
   do flush tm
-     put out (s ++ "\n")
+     err (s ++ [ '\b' | _ <- s ])
+     modifyIORef tmp (+ length s)
 
 --------------------------------------------------------------------------
 -- the end.
diff --git a/changelog b/changelog
--- a/changelog
+++ b/changelog
@@ -1,3 +1,24 @@
+QuickCheck 2.8 (released 2015-03-18)
+	* New features:
+		* Support for GHC 7.10
+		* Arbitrary instance for Natural
+		* New generators shuffle and sublistOf
+		* Support for generic coarbitrary
+		* When using the cover combinator, insufficient coverage now
+		  causes the property to fail
+
+	* API changes:
+		* Test.QuickCheck.Function: new pattern synonym Fn
+		* genericShrink no longer requires Typeable
+		* Result has a new constructor InsufficientCoverage
+		* resize throws an error if the size is negative
+
+	* Bug fixes:
+		* Fix memory leaks
+		* Exceptions thrown by callbacks now cause the test to fail
+		* Fixed a bug where the cover combinator wouldn't give a
+		  warning if coverage was 0%
+
 QuickCheck 2.7.3 (released 2014-03-24)
 	* Add annotations for Safe Haskell.
 
diff --git a/examples/Heap.hs b/examples/Heap.hs
--- a/examples/Heap.hs
+++ b/examples/Heap.hs
@@ -25,7 +25,7 @@
   = Node a (Heap a) (Heap a)
   | Empty
  deriving ( Eq, Ord, Show )
-  
+
 empty :: Heap a
 empty = Empty
 
@@ -53,13 +53,13 @@
 h1@(Node x h11 h12) `merge` h2@(Node y h21 h22)
   | x <= y    = Node x (h12 `merge` h2) h11
   | otherwise = Node y (h22 `merge` h1) h21
-        
+
 fromList :: Ord a => [a] -> Heap a
 fromList xs = merging [ unit x | x <- xs ]
  where
   merging []  = empty
   merging [h] = h
-  merging hs  = merging (sweep hs) 
+  merging hs  = merging (sweep hs)
 
   sweep []         = []
   sweep [h]        = [h]
@@ -124,7 +124,7 @@
   h ==? xs && xs == sort xs
  where
   xs = toSortedList h
-  
+
 --------------------------------------------------------------------------
 -- generators
 
@@ -141,7 +141,7 @@
                     where arbHeap2 = arbHeap (Just y) (n `div` 2))
         | n > 0
         ]
-        
+
 --------------------------------------------------------------------------
 -- main
 
