diff --git a/hedgehog-example/src/Test/Example/Coverage.hs b/hedgehog-example/src/Test/Example/Coverage.hs
new file mode 100644
index 00000000..7017b2ba
--- /dev/null
+++ b/hedgehog-example/src/Test/Example/Coverage.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Test.Example.Coverage (
+    tests
+  ) where
+
+import           Control.Concurrent (threadDelay)
+
+import           Data.Foldable (for_)
+
+import           Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+
+prop_classify :: Property
+prop_classify =
+  withTests 1 . property $ do
+    for_ [1 :: Int ..100] $ \a -> do
+      classify "small number" $ a < 50
+      classify "big number" $ a >= 50
+
+prop_cover_number :: Property
+prop_cover_number =
+  property $ do
+    number <- forAll (Gen.int $ Range.linear 1 100)
+    evalIO $ threadDelay 20000
+    cover 50 "small number" $ number < 50
+    cover 50 "medium number" $ number >= 20
+    cover 50 "big number" $ number >= 50
+
+prop_cover_bool :: Property
+prop_cover_bool =
+  property $ do
+    match <- forAll Gen.bool
+    cover 30 "True" match
+    cover 30 "False" $ not match
+
+tests :: IO Bool
+tests =
+  checkParallel $$(discover)
diff --git a/hedgehog/src/Hedgehog.hs b/hedgehog/src/Hedgehog.hs
index 732a5a61..0892e641 100644
--- a/hedgehog/src/Hedgehog.hs
+++ b/hedgehog/src/Hedgehog.hs
@@ -56,6 +56,8 @@ module Hedgehog (
 
   , forAll
   , forAllWith
+  , classify
+  , cover
   , discard
 
   , check
@@ -151,8 +153,9 @@ import           Hedgehog.Internal.Distributive (Distributive(..))
 import           Hedgehog.Internal.Gen (Gen, GenT, MonadGen(..))
 import           Hedgehog.Internal.HTraversable (HTraversable(..))
 import           Hedgehog.Internal.Opaque (Opaque(..))
-import           Hedgehog.Internal.Property (assert, diff, annotate, annotateShow)
-import           Hedgehog.Internal.Property ((===), (/==))
+import           Hedgehog.Internal.Property (annotate, annotateShow)
+import           Hedgehog.Internal.Property (assert, diff, (===), (/==))
+import           Hedgehog.Internal.Property (classify, cover)
 import           Hedgehog.Internal.Property (discard, failure, success)
 import           Hedgehog.Internal.Property (DiscardLimit, withDiscards)
 import           Hedgehog.Internal.Property (eval, evalM, evalIO)
diff --git a/hedgehog/src/Hedgehog/Internal/Property.hs b/hedgehog/src/Hedgehog/Internal/Property.hs
index ba5032c9..84f3946b 100644
--- a/hedgehog/src/Hedgehog/Internal/Property.hs
+++ b/hedgehog/src/Hedgehog/Internal/Property.hs
@@ -1,6 +1,8 @@
 {-# OPTIONS_HADDOCK not-home #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DoAndIfThenElse #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -21,8 +23,11 @@ module Hedgehog.Internal.Property (
   , PropertyName(..)
   , PropertyConfig(..)
   , TestLimit(..)
+  , TestCount(..)
   , DiscardLimit(..)
+  , DiscardCount(..)
   , ShrinkLimit(..)
+  , ShrinkCount(..)
   , ShrinkRetries(..)
   , withTests
   , withDiscards
@@ -39,12 +44,14 @@ module Hedgehog.Internal.Property (
   -- * Group
   , Group(..)
   , GroupName(..)
+  , PropertyCount(..)
 
   -- * TestT
   , MonadTest(..)
   , Test
   , TestT(..)
   , Log(..)
+  , Journal(..)
   , Failure(..)
   , Diff(..)
   , annotate
@@ -64,6 +71,22 @@ module Hedgehog.Internal.Property (
   , evalEither
   , evalExceptT
 
+  -- * Coverage
+  , Coverage(..)
+  , Classifier(..)
+  , ClassifierName(..)
+  , classify
+  , cover
+  , coverPercentage
+  , classifierCovered
+  , coverageSuccess
+  , coverageFailures
+
+  , Cover(..)
+  , CoverCount(..)
+  , CoverPercentage(..)
+  , toCoverCount
+
   -- * Internal
   -- $internal
   , defaultConfig
@@ -111,8 +134,10 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict
 
 import qualified Data.Char as Char
 import           Data.Functor.Identity (Identity(..))
+import           Data.Map (Map)
+import qualified Data.Map.Strict as Map
 import qualified Data.List as List
-import           Data.Semigroup (Semigroup)
+import           Data.Semigroup (Semigroup(..))
 import           Data.String (IsString)
 import           Data.Typeable (typeOf)
 
@@ -166,7 +191,7 @@ type Test =
 --
 newtype TestT m a =
   TestT {
-      unTest :: ExceptT Failure (Lazy.WriterT [Log] m) a
+      unTest :: ExceptT Failure (Lazy.WriterT Journal m) a
     } deriving (
       Functor
     , Applicative
@@ -214,6 +239,18 @@ newtype TestLimit =
   TestLimit Int
   deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
 
+-- | The number of tests a property ran successfully.
+--
+newtype TestCount =
+  TestCount Int
+  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
+
+-- | The number of tests a property had to discard.
+--
+newtype DiscardCount =
+  DiscardCount Int
+  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
+
 -- | The number of discards to allow before giving up.
 --
 --   Can be constructed using numeric literals:
@@ -239,6 +276,12 @@ newtype ShrinkLimit =
   ShrinkLimit Int
   deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
 
+-- | The numbers of times a property was able to shrink after a failing test.
+--
+newtype ShrinkCount =
+  ShrinkCount Int
+  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
+
 -- | 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.
@@ -279,10 +322,16 @@ newtype GroupName =
       unGroupName :: String
     } deriving (Eq, Ord, Show, IsString, Semigroup)
 
+-- | The number of properties in a group.
+--
+newtype PropertyCount =
+  PropertyCount Int
+  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
+
 --
 -- FIXME This whole Log/Failure thing could be a lot more structured to allow
 -- FIXME for richer user controlled error messages, think Doc. Ideally we'd
--- FIXME allow user's to create their own diffs anywhere.
+-- FIXME allow user's to crete their own diffs anywhere.
 --
 
 -- | Log messages which are recorded during a test run.
@@ -292,6 +341,13 @@ data Log =
   | Footnote String
     deriving (Eq, Show)
 
+-- | A record containing the details of a test run.
+data Journal =
+  Journal {
+      journalCoverage :: !(Coverage Cover)
+    , journalLogs :: ![Log]
+    } deriving (Eq, Show)
+
 -- | Details on where and why a test failed.
 --
 data Failure =
@@ -310,6 +366,76 @@ data Diff =
     , diffValue :: ValueDiff
     } deriving (Eq, Show)
 
+-- | Whether a test is covered by a classifier, and therefore belongs to a
+--   'Class'.
+--
+data Cover =
+    NoCover
+  | Cover
+    deriving (Eq, Ord, Show)
+
+-- | The total number of tests which are covered by a classifier.
+--
+--   Can be constructed using numeric literals:
+--
+-- @
+--   30 :: CoverCount
+-- @
+--
+newtype CoverCount =
+  CoverCount {
+      unCoverCount :: Int
+    } deriving (Eq, Ord, Show, Num)
+
+-- | The relative number of tests which are covered by a classifier.
+--
+--   Can be constructed using numeric literals:
+--
+-- @
+--   30 :: CoverPercentage
+-- @
+--
+newtype CoverPercentage =
+  CoverPercentage {
+      unCoverPercentage :: Double
+    } deriving (Eq, Ord, Show, Num)
+
+-- | The name of a classifier.
+--
+--   Can be constructed using `OverloadedStrings`:
+--
+-- @
+--   "apples" :: ClassifierName
+-- @
+--
+newtype ClassifierName =
+  ClassifierName {
+      unClassifierName :: String
+    } deriving (Eq, Ord, Show, IsString)
+
+-- | The extent to which a test is covered by a classifier.
+--
+--   /When a classifier's coverage does not exceed the required minimum, the
+--   test will be failed./
+--
+data Classifier a =
+  Classifier {
+      classifierName :: !ClassifierName
+    , classifierLocation :: !(Maybe Span)
+    , classifierMinimum :: !CoverPercentage
+    , classifierExtent :: !a
+    } deriving (Eq, Show, Functor, Foldable, Traversable)
+
+-- | The extent to which all classifiers cover a test.
+--
+--   /When a given classification's coverage does not exceed the required
+--   minimum, the test will be failed./
+--
+newtype Coverage a =
+  Coverage {
+      unCoverage :: Map ClassifierName (Classifier a)
+    } deriving (Eq, Show, Functor, Foldable, Traversable)
+
 ------------------------------------------------------------------------
 -- TestT
 
@@ -336,8 +462,8 @@ instance MFunctor TestT where
 
 instance Distributive TestT where
   type Transformer t TestT m = (
-      Transformer t (Lazy.WriterT [Log]) m
-    , Transformer t (ExceptT Failure) (Lazy.WriterT [Log] m)
+      Transformer t (Lazy.WriterT Journal) m
+    , Transformer t (ExceptT Failure) (Lazy.WriterT Journal m)
     )
 
   distribute =
@@ -368,10 +494,10 @@ instance MonadResource m => MonadResource (TestT m) where
 
 instance MonadTransControl TestT where
   type StT TestT a =
-    (Either Failure a, [Log])
+    (Either Failure a, Journal)
 
   liftWith f =
-    mkTestT . fmap (, []) . fmap Right $ f $ runTestT
+    mkTestT . fmap (, mempty) . fmap Right $ f $ runTestT
 
   restoreT =
     mkTestT
@@ -441,34 +567,50 @@ instance MonadTest m => MonadTest (ResourceT m) where
   liftTest =
     lift . liftTest
 
-mkTestT :: m (Either Failure a, [Log]) -> TestT m a
+instance Semigroup Journal where
+  (<>) (Journal c0 logs0) (Journal c1 logs1) =
+    Journal (c0 <> c1) (logs0 <> logs1)
+
+instance Monoid Journal where
+  mempty =
+    Journal mempty mempty
+  mappend =
+    (<>)
+
+mkTestT :: m (Either Failure a, Journal) -> TestT m a
 mkTestT =
   TestT . ExceptT . Lazy.WriterT
 
-mkTest :: (Either Failure a, [Log]) -> Test a
+mkTest :: (Either Failure a, Journal) -> Test a
 mkTest =
   mkTestT . Identity
 
-runTestT :: TestT m a -> m (Either Failure a, [Log])
+runTestT :: TestT m a -> m (Either Failure a, Journal)
 runTestT =
   Lazy.runWriterT . runExceptT . unTest
 
-runTest :: Test a -> (Either Failure a, [Log])
+runTest :: Test a -> (Either Failure a, Journal)
 runTest =
   runIdentity . runTestT
 
+-- | Write the current coverage information.
+--
+writeCoverage :: MonadTest m => Coverage Cover -> m ()
+writeCoverage c =
+  liftTest $ mkTest (pure (), Journal c [])
+
 -- | Log some information which might be relevant to a potential test failure.
 --
 writeLog :: MonadTest m => Log -> m ()
 writeLog x =
-  liftTest $ mkTest (pure (), [x])
+  liftTest $ mkTest (pure (), (Journal mempty [x]))
 
 -- | Fail the test with an error message, useful for building other failure
 --   combinators.
 --
 failWith :: (MonadTest m, HasCallStack) => Maybe Diff -> String -> m a
 failWith mdiff msg =
-  liftTest $ mkTest (Left $ Failure (getCaller callStack) msg mdiff, [])
+  liftTest $ mkTest (Left $ Failure (getCaller callStack) msg mdiff, (Journal mempty []))
 
 -- | Annotates the source code with a message that might be useful for
 --   debugging a test failure.
@@ -719,6 +861,7 @@ forAllWith render gen =
 
 -- | Generates a random input for the test by running the provided generator.
 --
+--
 forAllT :: (Monad m, Show a, HasCallStack) => GenT m a -> PropertyT m a
 forAllT gen =
   withFrozenCallStack $ forAllWithT showPretty gen
@@ -820,6 +963,129 @@ property m =
   Property defaultConfig $
     withFrozenCallStack (evalM m)
 
+------------------------------------------------------------------------
+-- Classification
+
+instance Semigroup Cover where
+  (<>) NoCover NoCover =
+    NoCover
+  (<>) _ _ =
+    Cover
+
+instance Monoid Cover where
+  mempty =
+    NoCover
+  mappend =
+    (<>)
+
+instance Semigroup CoverCount where
+  (<>) (CoverCount n0) (CoverCount n1) =
+    CoverCount (n0 + n1)
+
+instance Monoid CoverCount where
+  mempty =
+    CoverCount 0
+  mappend =
+    (<>)
+
+toCoverCount :: Cover -> CoverCount
+toCoverCount = \case
+  NoCover ->
+    CoverCount 0
+  Cover ->
+    CoverCount 1
+
+-- | This semigroup is right biased. The name, location and percentage from the
+--   rightmost `Classifier` will be kept. This shouldn't be a problem since the
+--   library doesn't allow setting multiple classes with the same 'ClassifierName'.
+instance Semigroup a => Semigroup (Classifier a) where
+  (<>) (Classifier _ _ _ m0) (Classifier name location percentage m1) =
+    Classifier name location percentage (m0 <> m1)
+
+instance Semigroup a => Semigroup (Coverage a) where
+  (<>) (Coverage c0) (Coverage c1) =
+    Coverage $
+      Map.foldrWithKey (Map.insertWith (<>)) c0 c1
+
+instance (Semigroup a, Monoid a) => Monoid (Coverage a) where
+  mempty =
+    Coverage mempty
+  mappend =
+    (<>)
+
+mkCoverage :: Maybe Span -> ClassifierName -> CoverPercentage -> Cover -> Coverage Cover
+mkCoverage mlocation name minimum_ cover_ =
+  Coverage $
+    Map.singleton name (Classifier name mlocation minimum_ cover_)
+
+coverPercentage :: TestCount -> CoverCount -> CoverPercentage
+coverPercentage (TestCount tests) (CoverCount count) =
+  let
+    percentage :: Double
+    percentage =
+      fromIntegral count / fromIntegral tests * 100
+
+    thousandths :: Int
+    thousandths =
+      round $ percentage * 10
+  in
+    CoverPercentage (fromIntegral thousandths / 10)
+
+classifierCovered :: TestCount -> Classifier CoverCount -> Bool
+classifierCovered tests (Classifier _ _ minimum_ population) =
+  coverPercentage tests population >= minimum_
+
+coverageSuccess :: TestCount -> Coverage CoverCount -> Bool
+coverageSuccess tests =
+  null . coverageFailures tests
+
+coverageFailures :: TestCount -> Coverage CoverCount -> [Classifier CoverCount]
+coverageFailures tests (Coverage kvs) =
+  filter (not . classifierCovered tests) (Map.elems kvs)
+
+-- | Records the proportion of tests which satisfy a given condition.
+--
+-- @
+--    prop_with_classifier :: Property
+--    prop_with_classifier =
+--      property $ do
+--        xs <- forAll $ Gen.list (Range.linear 0 100) Gen.alpha
+--        for_ xs $ \x -> do
+--          classify "newborns" $ x == 0
+--          classify "children" $ x > 0 && x < 13
+--          classify "teens" $ x > 12 && x < 20
+-- @
+classify :: MonadTest m => ClassifierName -> Bool -> m ()
+classify =
+  cover 0
+
+-- | Require a certain percentage of the tests to be covered by the
+--   classifier.
+--
+-- @
+--    prop_with_coverage :: Property
+--    prop_with_coverage =
+--      property $ do
+--        match <- forAll Gen.bool
+--        cover 30 "True" $ match
+--        cover 30 "False" $ not match
+-- @
+--
+--   The example above requires a minimum of 30% coverage for both
+--   classifiers. If these requirements are not met, it will fail the test.
+--
+cover :: (MonadTest m, HasCallStack) => CoverPercentage -> ClassifierName -> Bool -> m ()
+cover minimum_ name covered =
+  let
+    cover_ =
+      if covered then
+        Cover
+      else
+        NoCover
+  in
+    writeCoverage $
+      mkCoverage (getCaller callStack) name minimum_ cover_
+
 ------------------------------------------------------------------------
 -- FIXME Replace with DeriveLift when we drop 7.10 support.
 
diff --git a/hedgehog/src/Hedgehog/Internal/Report.hs b/hedgehog/src/Hedgehog/Internal/Report.hs
index 2ec360dc..87932b19 100644
--- a/hedgehog/src/Hedgehog/Internal/Report.hs
+++ b/hedgehog/src/Hedgehog/Internal/Report.hs
@@ -17,11 +17,6 @@ module Hedgehog.Internal.Report (
   , FailureReport(..)
   , FailedAnnotation(..)
 
-  , ShrinkCount(..)
-  , TestCount(..)
-  , DiscardCount(..)
-  , PropertyCount(..)
-
   , Style(..)
   , Markup(..)
 
@@ -50,11 +45,19 @@ import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Maybe (mapMaybe, catMaybes)
 import           Data.Semigroup (Semigroup(..))
+import           Data.Traversable (for)
 
 import           Hedgehog.Internal.Config
 import           Hedgehog.Internal.Discovery (Pos(..), Position(..))
 import qualified Hedgehog.Internal.Discovery as Discovery
+import           Hedgehog.Internal.Property (Coverage(..), Classifier(..), ClassifierName(..))
+import           Hedgehog.Internal.Property (CoverCount(..), CoverPercentage(..))
 import           Hedgehog.Internal.Property (PropertyName(..), Log(..), Diff(..))
+import           Hedgehog.Internal.Property (ShrinkCount(..), PropertyCount(..))
+import           Hedgehog.Internal.Property (TestCount(..), DiscardCount(..))
+import           Hedgehog.Internal.Property (coverPercentage, coverageFailures)
+import           Hedgehog.Internal.Property (classifierCovered)
+
 import           Hedgehog.Internal.Seed (Seed)
 import           Hedgehog.Internal.Show
 import           Hedgehog.Internal.Source
@@ -75,30 +78,6 @@ import           Text.Printf (printf)
 ------------------------------------------------------------------------
 -- Data
 
--- | The numbers of times a property was able to shrink after a failing test.
---
-newtype ShrinkCount =
-  ShrinkCount Int
-  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
-
--- | The number of tests a property ran successfully.
---
-newtype TestCount =
-  TestCount Int
-  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
-
--- | The number of tests a property had to discard.
---
-newtype DiscardCount =
-  DiscardCount Int
-  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
-
--- | The number of properties in a group.
---
-newtype PropertyCount =
-  PropertyCount Int
-  deriving (Eq, Ord, Show, Num, Enum, Real, Integral)
-
 data FailedAnnotation =
   FailedAnnotation {
       failedSpan :: !(Maybe Span)
@@ -110,6 +89,7 @@ data FailureReport =
       failureSize :: !Size
     , failureSeed :: !Seed
     , failureShrinks :: !ShrinkCount
+    , failureCoverage :: !(Maybe (Coverage CoverCount))
     , failureAnnotations :: ![FailedAnnotation]
     , failureLocation :: !(Maybe Span)
     , failureMessage :: !String
@@ -141,6 +121,7 @@ data Report a =
   Report {
       reportTests :: !TestCount
     , reportDiscards :: !DiscardCount
+    , reportCoverage :: !(Coverage CoverCount)
     , reportStatus :: !a
     } deriving (Show, Functor, Foldable, Traversable)
 
@@ -220,11 +201,13 @@ data Markup =
   | ShrinkingIcon
   | ShrinkingHeader
   | FailedIcon
-  | FailedHeader
+  | FailedText
   | GaveUpIcon
-  | GaveUpHeader
+  | GaveUpText
   | SuccessIcon
-  | SuccessHeader
+  | SuccessText
+  | CoverageIcon
+  | CoverageText
   | DeclarationLocation
   | StyledLineNo !Style
   | StyledBorder !Style
@@ -279,12 +262,13 @@ mkFailure ::
      Size
   -> Seed
   -> ShrinkCount
+  -> Maybe (Coverage CoverCount)
   -> Maybe Span
   -> String
   -> Maybe Diff
   -> [Log]
   -> FailureReport
-mkFailure size seed shrinks location message diff logs =
+mkFailure size seed shrinks mcoverage location message diff logs =
   let
     inputs =
       mapMaybe takeAnnotation logs
@@ -292,7 +276,7 @@ mkFailure size seed shrinks location message diff logs =
     footnotes =
       mapMaybe takeFootnote logs
   in
-    FailureReport size seed shrinks inputs location message diff footnotes
+    FailureReport size seed shrinks mcoverage inputs location message diff footnotes
 
 ------------------------------------------------------------------------
 -- Pretty Printing
@@ -504,11 +488,11 @@ ppDiff (Diff prefix removed infix_ added suffix diff) = [
 
 ppFailureLocation ::
      MonadIO m
-  => String
+  => [Doc Markup]
   -> Maybe Diff
   -> Span
   -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
-ppFailureLocation msg mdiff sloc =
+ppFailureLocation msgs mdiff sloc =
   runMaybeT $ do
     decl <- fmap defaultStyle . MaybeT $ readDeclaration sloc
     (startCol, endCol) <- bimap fromIntegral fromIntegral <$> lastLineSpan sloc decl
@@ -523,7 +507,7 @@ ppFailureLocation msg mdiff sloc =
           markup FailureGutter (WL.text "│ ") <> x
 
       msgDocs =
-        fmap ((StyleFailure, ) . ppFailure . markup FailureMessage . WL.text) (List.lines msg)
+        fmap ((StyleFailure, ) . ppFailure . markup FailureMessage) msgs
 
       diffDocs =
         case mdiff of
@@ -619,9 +603,9 @@ ppTextLines :: String -> [Doc Markup]
 ppTextLines =
   fmap WL.text . List.lines
 
-ppFailureReport :: MonadIO m => Maybe PropertyName -> FailureReport -> m (Doc Markup)
-ppFailureReport name (FailureReport size seed _ inputs0 mlocation0 msg mdiff msgs0) = do
-  (msgs, mlocation) <-
+ppFailureReport :: MonadIO m => Maybe PropertyName -> TestCount -> FailureReport -> m (Doc Markup)
+ppFailureReport name tests (FailureReport size seed _ mcoverage inputs0 mlocation0 msg mdiff msgs0) = do
+  (msgs1, mlocation) <-
     case mlocation0 of
       Nothing ->
         -- Move the failure message to the end section if we have
@@ -638,16 +622,37 @@ ppFailureReport name (FailureReport size seed _ inputs0 mlocation0 msg mdiff msg
           pure (docs, Nothing)
 
       Just location0 ->
-        (concatMap ppTextLines msgs0,)
-          <$> ppFailureLocation msg mdiff location0
+        fmap (concatMap ppTextLines msgs0,) $
+          ppFailureLocation (fmap WL.text $ List.lines msg) mdiff location0
 
-  (args, idecls) <- partitionEithers <$> zipWithM ppFailedInput [0..] inputs0
+  coverageLocations <-
+    case mcoverage of
+      Nothing ->
+        pure []
+      Just coverage ->
+        for (coverageFailures tests coverage) $ \(Classifier _ mclocation _ count) ->
+          case mclocation of
+            Nothing ->
+              pure Nothing
+            Just clocation ->
+              let
+                coverageMsg =
+                  WL.cat [
+                      "Failed ("
+                    , WL.annotate CoverageText $
+                        ppCoverPercentage (coverPercentage tests count) <> " coverage"
+                    , ")"
+                    ]
+              in
+                ppFailureLocation [coverageMsg] Nothing clocation
+
+  (args, idecls) <- fmap partitionEithers $ zipWithM ppFailedInput [0..] inputs0
 
   let
     decls =
       mergeDeclarations .
       catMaybes $
-        mlocation : fmap pure idecls
+        mlocation : coverageLocations <> fmap pure idecls
 
     with xs f =
       if null xs then
@@ -655,14 +660,19 @@ ppFailureReport name (FailureReport size seed _ inputs0 mlocation0 msg mdiff msg
       else
         [f xs]
 
-  pure . WL.indent 2 . WL.vsep . WL.punctuate WL.line $ concat [
+    msgs =
+      fmap (WL.indent 2) msgs1 <>
+      maybe [] (ppCoverage tests) mcoverage
+
+  pure . WL.vsep . WL.punctuate WL.line $ concat [
       with args $
-        WL.vsep . WL.punctuate WL.line
+        WL.indent 2 . WL.vsep . WL.punctuate WL.line
     , with decls $
-        WL.vsep . WL.punctuate WL.line . fmap ppDeclaration
+        WL.indent 2 . WL.vsep . WL.punctuate WL.line . fmap ppDeclaration
     , with msgs $
         WL.vsep
-    , [ppReproduce name size seed]
+    , with [ppReproduce name size seed] $
+        WL.indent 2 . WL.vsep
     ]
 
 ppName :: Maybe PropertyName -> Doc a
@@ -673,15 +683,18 @@ ppName = \case
     WL.text name
 
 ppProgress :: MonadIO m => Maybe PropertyName -> Report Progress -> m (Doc Markup)
-ppProgress name (Report tests discards status) =
+ppProgress name (Report tests discards coverage status) =
   case status of
     Running ->
-      pure . icon RunningIcon '●' . WL.annotate RunningHeader $
-        ppName name <+>
-        "passed" <+>
-        ppTestCount tests <>
-        ppWithDiscardCount discards <+>
-        "(running)"
+      pure . WL.vsep $ [
+          icon RunningIcon '●' . WL.annotate RunningHeader $
+            ppName name <+>
+            "passed" <+>
+            ppTestCount tests <>
+            ppWithDiscardCount discards <+>
+            "(running)"
+        ] ++
+        ppCoverage tests coverage
 
     Shrinking failure ->
       pure . icon ShrinkingIcon '↯' . WL.annotate ShrinkingHeader $
@@ -692,12 +705,12 @@ ppProgress name (Report tests discards status) =
         "(shrinking)"
 
 ppResult :: MonadIO m => Maybe PropertyName -> Report Result -> m (Doc Markup)
-ppResult name (Report tests discards result) =
+ppResult name (Report tests discards coverage result) = do
   case result of
     Failed failure -> do
-      pfailure <- ppFailureReport name failure
+      pfailure <- ppFailureReport name tests failure
       pure . WL.vsep $ [
-          icon FailedIcon '✗' . WL.annotate FailedHeader $
+          icon FailedIcon '✗' . WL.annotate FailedText $
             ppName name <+>
             "failed after" <+>
             ppTestCount tests <>
@@ -709,20 +722,57 @@ ppResult name (Report tests discards result) =
         ]
 
     GaveUp ->
-      pure . icon GaveUpIcon '⚐' . WL.annotate GaveUpHeader $
-        ppName name <+>
-        "gave up after" <+>
-        ppDiscardCount discards <>
-        ", passed" <+>
-        ppTestCount tests <>
-        "."
+      pure . WL.vsep $ [
+          icon GaveUpIcon '⚐' . WL.annotate GaveUpText $
+            ppName name <+>
+            "gave up after" <+>
+            ppDiscardCount discards <>
+            ", passed" <+>
+            ppTestCount tests <>
+            "."
+        ] ++
+        ppCoverage tests coverage
 
     OK ->
-      pure . icon SuccessIcon '✓' . WL.annotate SuccessHeader $
-        ppName name <+>
-        "passed" <+>
-        ppTestCount tests <>
-        "."
+      pure . WL.vsep $ [
+          icon SuccessIcon '✓' . WL.annotate SuccessText $
+            ppName name <+>
+            "passed" <+>
+            ppTestCount tests <>
+            "."
+        ] ++
+        ppCoverage tests coverage
+
+ppCoverage :: TestCount -> Coverage CoverCount -> [Doc Markup]
+ppCoverage tests (Coverage classes) =
+  if Map.null classes then
+    mempty
+  else
+    let
+      ppClass classifier@(Classifier name _ minimum_ count) =
+        if classifierCovered tests classifier then
+          "  " <>
+          ppCoverPercentage (coverPercentage tests count) <>
+          " " <>
+          ppClassifierName name
+        else
+          icon CoverageIcon '⚠' . WL.annotate CoverageText $
+            ppCoverPercentage (coverPercentage tests count) <>
+            " " <>
+            ppClassifierName name <>
+            " < " <>
+            ppCoverPercentage minimum_
+    in
+      fmap ppClass $
+        Map.elems classes
+
+ppClassifierName :: ClassifierName -> Doc a
+ppClassifierName (ClassifierName name) =
+  WL.text name
+
+ppCoverPercentage :: CoverPercentage -> Doc Markup
+ppCoverPercentage (CoverPercentage percentage) =
+  WL.text (show percentage) <> "%"
 
 ppWhenNonZero :: Doc a -> PropertyCount -> Maybe (Doc a)
 ppWhenNonZero suffix n =
@@ -734,13 +784,13 @@ ppWhenNonZero suffix n =
 annotateSummary :: Summary -> Doc Markup -> Doc Markup
 annotateSummary summary =
   if summaryFailed summary > 0 then
-    icon FailedIcon '✗' . WL.annotate FailedHeader
+    icon FailedIcon '✗' . WL.annotate FailedText
   else if summaryGaveUp summary > 0 then
-    icon GaveUpIcon '⚐' . WL.annotate GaveUpHeader
+    icon GaveUpIcon '⚐' . WL.annotate GaveUpText
   else if summaryWaiting summary > 0 || summaryRunning summary > 0 then
     icon WaitingIcon '○' . WL.annotate WaitingHeader
   else
-    icon SuccessIcon '✓' . WL.annotate SuccessHeader
+    icon SuccessIcon '✓' . WL.annotate SuccessText
 
 ppSummary :: MonadIO m => Summary -> m (Doc Markup)
 ppSummary summary =
@@ -811,16 +861,20 @@ renderDoc mcolor doc = do
         setSGRCode [vivid Red]
       FailedIcon ->
         setSGRCode [vivid Red]
-      FailedHeader ->
+      FailedText ->
         setSGRCode [vivid Red]
       GaveUpIcon ->
         setSGRCode [dull Yellow]
-      GaveUpHeader ->
+      GaveUpText ->
         setSGRCode [dull Yellow]
       SuccessIcon ->
         setSGRCode [dull Green]
-      SuccessHeader ->
+      SuccessText ->
         setSGRCode [dull Green]
+      CoverageIcon ->
+        setSGRCode [dull Yellow]
+      CoverageText ->
+        setSGRCode [dull Yellow]
 
       DeclarationLocation ->
         setSGRCode []
@@ -894,6 +948,7 @@ renderDoc mcolor doc = do
     hSetEncoding stdout utf8
     hSetEncoding stderr utf8
 #endif
+
   pure .
     display .
     WL.renderSmart 100 $
diff --git a/hedgehog/src/Hedgehog/Internal/Runner.hs b/hedgehog/src/Hedgehog/Internal/Runner.hs
index 74e41b3f..757a5444 100644
--- a/hedgehog/src/Hedgehog/Internal/Runner.hs
+++ b/hedgehog/src/Hedgehog/Internal/Runner.hs
@@ -36,10 +36,15 @@ import           Data.Semigroup ((<>))
 
 import           Hedgehog.Internal.Config
 import           Hedgehog.Internal.Gen (runGenT, runDiscardEffect)
+import           Hedgehog.Internal.Property (Journal(..), Coverage(..))
+import           Hedgehog.Internal.Property (DiscardCount(..), ShrinkCount(..))
 import           Hedgehog.Internal.Property (Group(..), GroupName(..))
+import           Hedgehog.Internal.Property (CoverCount(..), toCoverCount)
 import           Hedgehog.Internal.Property (Property(..), PropertyConfig(..), PropertyName(..))
+import           Hedgehog.Internal.Property (PropertyT(..), Failure(..), runTestT)
 import           Hedgehog.Internal.Property (ShrinkLimit, ShrinkRetries, withTests)
-import           Hedgehog.Internal.Property (PropertyT(..), Log(..), Failure(..), runTestT)
+import           Hedgehog.Internal.Property (TestCount(..), PropertyCount(..))
+import           Hedgehog.Internal.Property (coverageSuccess)
 import           Hedgehog.Internal.Queue
 import           Hedgehog.Internal.Region
 import           Hedgehog.Internal.Report
@@ -118,18 +123,18 @@ takeSmallest ::
   -> ShrinkLimit
   -> ShrinkRetries
   -> (Progress -> m ())
-  -> Node m (Maybe (Either Failure (), [Log]))
+  -> Node m (Maybe (Either Failure (), Journal))
   -> m Result
 takeSmallest size seed shrinks slimit retries updateUI = \case
   Node Nothing _ ->
     pure GaveUp
 
-  Node (Just (x, w)) xs ->
+  Node (Just (x, (Journal _ logs))) xs ->
     case x of
       Left (Failure loc err mdiff) -> do
         let
           failure =
-            mkFailure size seed shrinks loc err mdiff (reverse w)
+            mkFailure size seed shrinks Nothing loc err mdiff (reverse logs)
 
         updateUI $ Shrinking failure
 
@@ -162,21 +167,38 @@ checkReport cfg size0 seed0 test0 updateUI =
     test =
       catchAll test0 (fail . show)
 
-    loop :: TestCount -> DiscardCount -> Size -> Seed -> m (Report Result)
-    loop !tests !discards !size !seed = do
-      updateUI $ Report tests discards Running
+    loop ::
+         TestCount
+      -> DiscardCount
+      -> Size
+      -> Seed
+      -> Coverage CoverCount
+      -> m (Report Result)
+    loop !tests !discards !size !seed !coverage0 = do
+      updateUI $ Report tests discards coverage0 Running
 
       if size > 99 then
         -- size has reached limit, reset to 0
-        loop tests discards 0 seed
+        loop tests discards 0 seed coverage0
 
       else if tests >= fromIntegral (propertyTestLimit cfg) then
-        -- we've hit the test limit, test was successful
-        pure $ Report tests discards OK
+        -- we've hit the test limit
+        if coverageSuccess tests coverage0 then
+          -- all classifiers satisfied, test was successful
+          pure $ Report tests discards coverage0 OK
+        else
+          -- some classifiers unsatisfied, test was successful
+          let
+            message =
+              "Insufficient coverage\n" <>
+              "━━━━━━━━━━━━━━━━━━━━━"
+          in
+            pure . Report tests discards coverage0 . Failed $
+              mkFailure size seed 0 (Just coverage0) Nothing message Nothing []
 
       else if discards >= fromIntegral (propertyDiscardLimit cfg) then
         -- we've hit the discard limit, give up
-        pure $ Report tests discards GaveUp
+        pure $ Report tests discards coverage0 GaveUp
 
       else
         case Seed.split seed of
@@ -185,12 +207,12 @@ checkReport cfg size0 seed0 test0 updateUI =
               runTree . runDiscardEffect $ runGenT size s0 . runTestT $ unPropertyT test
             case x of
               Nothing ->
-                loop tests (discards + 1) (size + 1) s1
+                loop tests (discards + 1) (size + 1) s1 coverage0
 
               Just (Left _, _) ->
                 let
                   mkReport =
-                    Report (tests + 1) discards
+                    Report (tests + 1) discards coverage0
                 in
                   fmap mkReport $
                     takeSmallest
@@ -202,10 +224,14 @@ checkReport cfg size0 seed0 test0 updateUI =
                       (updateUI . mkReport)
                       node
 
-              Just (Right (), _) ->
-                loop (tests + 1) discards (size + 1) s1
+              Just (Right (), (Journal coverage1 _)) ->
+                let
+                  coverage =
+                    fmap toCoverCount coverage1 <> coverage0
+                in
+                  loop (tests + 1) discards (size + 1) s1 coverage
   in
-    loop 0 0 size0 seed0
+    loop 0 0 size0 seed0 mempty
 
 checkRegion ::
      MonadIO m
@@ -280,6 +306,7 @@ checkGroup config (Group group props) =
     hSetEncoding stdout utf8
     hSetEncoding stderr utf8
 #endif
+
     putStrLn $ "━━━ " ++ unGroupName group ++ " ━━━"
 
     verbosity <- resolveVerbosity (runnerVerbosity config)