diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,7 @@
+# 0.2.0.0 (November 17th, 2017)
+
+- Added `assertDo`, which automatically instruments a `do` block with uses of `shouldReturnAndMatch`.
+
 # 0.1.1.0 (November 15th, 2017)
 
 - Added `shouldReturnAndMatch`, which combines the action-running behavior of `shouldReturn` with the pattern-matching behavior of `shouldMatch`.
diff --git a/hspec-expectations-match.cabal b/hspec-expectations-match.cabal
--- a/hspec-expectations-match.cabal
+++ b/hspec-expectations-match.cabal
@@ -3,7 +3,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           hspec-expectations-match
-version:        0.1.1.0
+version:        0.2.0.0
 synopsis:       An hspec expectation that asserts a value matches a pattern.
 description:    This package provides expectations for use with @hspec@ that use Template
                 Haskell to assert that a value matches a particular pattern.
diff --git a/package.yaml b/package.yaml
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: hspec-expectations-match
-version: 0.1.1.0
+version: 0.2.0.0
 category: Testing
 synopsis: An hspec expectation that asserts a value matches a pattern.
 description: |
diff --git a/src/Test/Hspec/Expectations/Match.hs b/src/Test/Hspec/Expectations/Match.hs
--- a/src/Test/Hspec/Expectations/Match.hs
+++ b/src/Test/Hspec/Expectations/Match.hs
@@ -14,6 +14,7 @@
 module Test.Hspec.Expectations.Match
   ( shouldMatch
   , shouldReturnAndMatch
+  , assertDo
   ) where
 
 import Control.Monad.Base (MonadBase, liftBase)
@@ -89,25 +90,29 @@
 
 patBindingsToTupleExp :: Pat -> Exp
 patBindingsToTupleExp = TupE . map VarE . patBindings
-  where
-    patBindings (LitP _) = []
-    patBindings (VarP nm) = [nm]
-    patBindings (TupP pats) = concatMap patBindings pats
-    patBindings (UnboxedTupP pats) = concatMap patBindings pats
-    patBindings (ConP _ pats) = concatMap patBindings pats
-    patBindings (InfixP patA _ patB) = patBindings patA ++ patBindings patB
-    patBindings (UInfixP patA _ patB) = patBindings patA ++ patBindings patB
-    patBindings (ParensP pat) = patBindings pat
-    patBindings (TildeP pat) = patBindings pat
-    patBindings (BangP pat) = patBindings pat
-    patBindings (AsP nm pat) = nm : patBindings pat
-    patBindings WildP = []
-    patBindings (RecP _ fieldPats) = concatMap (patBindings . snd) fieldPats
-    patBindings (ListP pats) = concatMap patBindings pats
-    patBindings (SigP pat _) = patBindings pat
-    patBindings (ViewP _ pat) = patBindings pat
+
+patBindingsToTuplePat :: Pat -> Pat
+patBindingsToTuplePat = TupP . map VarP . patBindings
+
+patBindings :: Pat -> [Name]
+patBindings (LitP _) = []
+patBindings (VarP nm) = [nm]
+patBindings (TupP pats) = concatMap patBindings pats
+patBindings (UnboxedTupP pats) = concatMap patBindings pats
+patBindings (ConP _ pats) = concatMap patBindings pats
+patBindings (InfixP patA _ patB) = patBindings patA ++ patBindings patB
+patBindings (UInfixP patA _ patB) = patBindings patA ++ patBindings patB
+patBindings (ParensP pat) = patBindings pat
+patBindings (TildeP pat) = patBindings pat
+patBindings (BangP pat) = patBindings pat
+patBindings (AsP nm pat) = nm : patBindings pat
+patBindings WildP = []
+patBindings (RecP _ fieldPats) = concatMap (patBindings . snd) fieldPats
+patBindings (ListP pats) = concatMap patBindings pats
+patBindings (SigP pat _) = patBindings pat
+patBindings (ViewP _ pat) = patBindings pat
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,1,0)
-    patBindings (UnboxedSumP pat _ _) = patBindings pat
+patBindings (UnboxedSumP pat _ _) = patBindings pat
 #endif
 
 -- The pretty-printer provided by template-haskell always prints things with
@@ -185,3 +190,72 @@
 showLit (DoublePrimL r) = show (fromRational r :: Double) ++ "##"
 showLit (StringPrimL s) = show s ++ "#"
 showLit (CharPrimL c) = show c ++ "#"
+
+-- | Instruments a @do@ block by automatically inserting uses of
+-- 'shouldReturnAndMatch' for monadic bindings. Specifically, the transformation
+-- converts this:
+--
+-- @
+-- \$('assertDo' [|do
+--   [x, y] <- 'return' [1, 2]
+--   x `'Test.Hspec.Expectations.shouldBe`` 1
+--   y `'Test.Hspec.Expectations.shouldBe`` 2|])
+-- @
+--
+-- ...into this:
+--
+-- @
+-- do (x, y) <- $([|'return' [1, 2]|] `'shouldReturnAndMatch'` [p|[x, y]|])
+--    x `'Test.Hspec.Expectations.shouldBe`` 1
+--    y `'Test.Hspec.Expectations.shouldBe`` 2
+-- @
+--
+-- This makes it much easier to read @do@ blocks that make significant use of
+-- 'shouldReturnAndMatch'.
+--
+-- Note that this transformation /only/ applies to monadic bindings (not @let@
+-- bindings), and it does not occur when the pattern on the left hand side
+-- already fully covers all potential values (that is, when the pattern could
+-- not possibly fail to match).
+assertDo :: Q Exp -> Q Exp
+assertDo qDoExp = qDoExp >>= \case
+    DoE stmts -> DoE <$> traverse annotateStatement stmts
+    _ -> fail "assertDo: expected a do block"
+  where
+    annotateStatement stmt@(BindS pat expr) = case pat of
+      VarP _ -> pure stmt
+      WildP -> pure stmt
+      _ -> do
+        hasOtherCases <- patternHasOtherCases pat
+        if hasOtherCases
+          then BindS (patBindingsToTuplePat pat) <$> shouldReturnAndMatch (pure expr) (pure pat)
+          else pure stmt
+    annotateStatement stmt = pure stmt
+
+    patternHasOtherCases (LitP _) = pure True
+    patternHasOtherCases (VarP _) = pure False
+    patternHasOtherCases (TupP pats) = or <$> traverse patternHasOtherCases pats
+    patternHasOtherCases (UnboxedTupP pats) = or <$> traverse patternHasOtherCases pats
+    patternHasOtherCases (ConP nm pats) = do
+      DataConI _ _ tyNm <- reify nm
+      tyInfo <- reify tyNm
+      conHasOtherCases <- case tyInfo of
+        TyConI dec -> case dec of
+          DataD _ _ _ _ cons _ -> pure (length cons > 1)
+          NewtypeD{} -> pure False
+          _ -> fail ("patternHasOtherCases: internal error; unexpected declaration in TyConI: " ++ show dec)
+        _ -> fail ("patternHasOtherCases: internal error; unexpected Info in DataConI: " ++ show tyInfo)
+      if conHasOtherCases
+        then pure True
+        else or <$> traverse patternHasOtherCases pats
+    patternHasOtherCases (InfixP patA nm patB) = patternHasOtherCases (ConP nm [patA, patB])
+    patternHasOtherCases (UInfixP patA nm patB) = patternHasOtherCases (ConP nm [patA, patB])
+    patternHasOtherCases (ParensP pat) = patternHasOtherCases pat
+    patternHasOtherCases (TildeP pat) = patternHasOtherCases pat
+    patternHasOtherCases (BangP pat) = patternHasOtherCases pat
+    patternHasOtherCases (AsP _ pat) = patternHasOtherCases pat
+    patternHasOtherCases WildP = pure False
+    patternHasOtherCases (RecP _ fieldPats) = or <$> traverse (patternHasOtherCases . snd) fieldPats
+    patternHasOtherCases (ListP _) = pure True
+    patternHasOtherCases (SigP pat _) = patternHasOtherCases pat
+    patternHasOtherCases (ViewP _ _) = pure True
diff --git a/test/Test/Hspec/Expectations/MatchSpec.hs b/test/Test/Hspec/Expectations/MatchSpec.hs
--- a/test/Test/Hspec/Expectations/MatchSpec.hs
+++ b/test/Test/Hspec/Expectations/MatchSpec.hs
@@ -31,10 +31,24 @@
       c `shouldBe` 'y'
 
   describe "shouldReturnAndMatch" $
-    it "matches the result of an action against a pattern" $ example $ do
+    it "matches the result of an action against a pattern" $ do
       $([|pure (Just True)|] `shouldReturnAndMatch` [p|Just _|])
 
       $([|pure Nothing|] `shouldReturnAndMatch` [p|Just True|]) `shouldThrow` anyException
 
       a <- $([|pure (Just True)|] `shouldReturnAndMatch` [p|Just x|])
       a `shouldBe` True
+
+  describe "assertDo" $
+    it "automatically annotates pattern binds with shouldReturnAndMatch" $ do
+      $(assertDo [|do
+        () <- pure ()
+        pure ()|])
+
+      $(assertDo [|do
+        Just x <- pure $ Just True
+        x `shouldBe` True|])
+
+      $(assertDo [|do
+        Just x <- pure Nothing
+        x `shouldBe` True|]) `shouldThrow` anyException