diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for hmock
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/HMock.cabal b/HMock.cabal
new file mode 100644
--- /dev/null
+++ b/HMock.cabal
@@ -0,0 +1,96 @@
+cabal-version:      2.4
+name:               HMock
+version:            0.1.0.0
+synopsis:           A flexible mock framework for testing effectful code.
+description:        HMock is a flexible mock framework for testing effectful
+                    code in Haskell.  Tests can set up expectations about
+                    actions that can or should be performed and their results,
+                    and then verify those expectations when the test is
+                    complete.
+                    .
+                    For more information, see the module documentation for
+                    "Test.HMock".
+category:           Testing
+homepage:           https://github.com/cdsmith/HMock
+bug-reports:        https://github.com/cdsmith/HMock/issues
+license:            BSD-3-Clause
+license-file:       LICENSE
+
+author:             Chris Smith <cdsmith@gmail.com>
+maintainer:         Chris Smith <cdsmith@gmail.com>
+
+extra-source-files: CHANGELOG.md
+
+tested-with:        GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1
+
+source-repository head
+    type:     git
+    location: git://github.com/cdsmith/HMock.git
+
+library
+    exposed-modules:  Test.HMock,
+                      Test.HMock.TH,
+                      Test.HMock.Internal.Multiplicity,
+                      Test.HMock.Internal.MockT,
+                      Test.HMock.Internal.ExpectSet,
+                      Test.HMock.Internal.Expectable,
+                      Test.HMock.Internal.Mockable,
+                      Test.HMock.Internal.Predicates,
+                      Test.HMock.Internal.TH,
+                      Test.HMock.Internal.TH.Util,
+                      Test.HMock.Internal.Util
+    build-depends:    base >=4.11.0 && < 4.16,
+                      constraints >= 0.13 && < 0.14,
+                      containers >= 0.6.2 && < 0.7,
+                      data-default >= 0.7.1 && < 0.8,
+                      exceptions >= 0.10.4 && < 0.11,
+                      extra >= 1.7.9 && < 1.8,
+                      monad-control >= 1.0.2 && < 1.1,
+                      mono-traversable >= 1.0.15 && < 1.1,
+                      mtl >= 2.2.2 && < 2.3,
+                      regex-tdfa >= 1.3.1 && < 1.4,
+                      syb >= 0.7.2 && < 0.8,
+                      template-haskell >= 2.13.0 && < 2.18,
+                      transformers-base >= 0.4.5 && < 0.5,
+                      unliftio >= 0.2.18 && < 0.3,
+    hs-source-dirs:   src
+    default-language: Haskell2010
+    ghc-options:      -Wall -Wcompat -Wincomplete-uni-patterns
+
+test-suite tests
+    type:             exitcode-stdio-1.0
+    main-is:          Main.hs
+    other-modules:    Classes,
+                      Core,
+                      Demo,
+                      DocTests.All,
+                      DocTests.Test.HMock.Internal.Multiplicity,
+                      DocTests.Test.HMock.Internal.Predicates,
+                      ExpectSet,
+                      Extras,
+                      PolysemyTest,
+                      QuasiMock,
+                      TH,
+                      Util.DeriveRecursive,
+                      Util.TH
+    build-depends:    HMock,
+                      QuickCheck,
+                      base,
+                      containers,
+                      data-default,
+                      deepseq,
+                      directory,
+                      doctest-exitcode-stdio,
+                      doctest-lib,
+                      exceptions,
+                      extra,
+                      hspec,
+                      mtl,
+                      polysemy,
+                      polysemy-plugin,
+                      syb,
+                      template-haskell,
+                      unliftio
+    hs-source-dirs:   test
+    default-language: Haskell2010
+    ghc-options:      -threaded -Wall -Wcompat -Wincomplete-uni-patterns -Wno-orphans
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2021, Chris Smith
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Chris Smith nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/src/Test/HMock.hs b/src/Test/HMock.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- |
+--
+-- This module provides a monad transformer, 'MockT', which can be used to test
+-- with mocks of Haskell @mtl@-style type classes.  To use a mock, you define
+-- the expected actions and their results, and then run the code you are
+-- testing.  The framework verifies that the behavior of the code matched your
+-- expectations.
+--
+-- For an introduction to the idea of mocks, see
+-- <https://martinfowler.com/articles/mocksArentStubs.html Mocks Aren't Stubs>,
+-- by Martin Fowler.
+--
+-- WARNING: Hmock's API is likely to change soon.  Please ensure you use an
+-- upper bound on the version number.  The current API works fine for mocking
+-- with MTL-style classes.  I want HMock to also work with effect systems,
+-- servant, haxl, and more.  To accomplish this, I'll need to make breaking
+-- changes to the API.
+--
+-- Suppose you have a @MonadFilesystem@ typeclass, which is instantiated by
+-- monads that implement filesystem operations:
+--
+-- @
+-- class 'Monad' m => MonadFilesystem m where
+--   readFile :: 'FilePath' -> m 'String'
+--   writeFile :: 'FilePath' -> 'String' -> m ()
+-- @
+--
+-- You can use HMock to test code using @MonadFilesystem@ like this:
+--
+-- @
+-- copyFile :: MonadFilesystem m => 'FilePath' -> 'FilePath' -> m ()
+-- copyFile a b = readFile a >>= writeFile b
+--
+-- 'Test.HMock.TH.makeMockable' ''MonadFilesystem
+--
+-- spec = describe "copyFile" '$'
+--   it "reads a file and writes its contents to another file" '$'
+--     'runMockT' '$' do
+--       'expect' '$' ReadFile "foo.txt" '|->' "contents"
+--       'expect' '$' WriteFile "bar.txt" "contents" '|->' ()
+--       copyFile "foo.txt" "bar.txt"
+-- @
+--
+-- The Template Haskell splice, 'Test.HMock.TH.makeMockable', generates the
+-- boilerplate needed to use @MonadFilesystem@ with HMock.  You then use
+-- 'runMockT' to begin a test with mocks, 'expect' to set up your expected
+-- actions and responses, and finally execute your code.
+module Test.HMock
+  ( -- * Running mocks
+    MockT,
+    runMockT,
+    withMockT,
+    describeExpectations,
+    verifyExpectations,
+    byDefault,
+
+    -- * Setting expectations
+    MockableMethod,
+    Expectable (..),
+    Rule,
+    (|=>),
+    (|->),
+    ExpectContext,
+    expect,
+    expectN,
+    expectAny,
+    inSequence,
+    inAnyOrder,
+    anyOf,
+    times,
+    consecutiveTimes,
+
+    -- * Predicates
+    Predicate (..),
+    anything,
+    eq,
+    neq,
+    gt,
+    geq,
+    lt,
+    leq,
+    just,
+    left,
+    right,
+    zipP,
+    zip3P,
+    zip4P,
+    zip5P,
+    andP,
+    orP,
+    notP,
+    startsWith,
+    endsWith,
+    hasSubstr,
+    hasSubsequence,
+    caseInsensitive,
+    matchesRegex,
+    matchesCaseInsensitiveRegex,
+    containsRegex,
+    containsCaseInsensitiveRegex,
+    isEmpty,
+    nonEmpty,
+    sizeIs,
+    elemsAre,
+    unorderedElemsAre,
+    each,
+    contains,
+    containsAll,
+    containsOnly,
+    containsKey,
+    containsEntry,
+    keysAre,
+    entriesAre,
+    approxEq,
+    finite,
+    infinite,
+    nAn,
+    is,
+    qIs,
+    with,
+    qWith,
+    qMatch,
+    typed,
+
+    -- * Multiplicity
+    Multiplicity,
+    meetsMultiplicity,
+    once,
+    anyMultiplicity,
+    atLeast,
+    atMost,
+    between,
+
+    -- * Implementing mocks
+    MockableBase (..),
+    Mockable (..),
+    MatchResult (..),
+    mockMethod,
+    mockDefaultlessMethod,
+  )
+where
+
+import Test.HMock.Internal.Expectable
+import Test.HMock.Internal.MockT
+import Test.HMock.Internal.Mockable
+import Test.HMock.Internal.Multiplicity
+import Test.HMock.Internal.Predicates
diff --git a/src/Test/HMock/Internal/ExpectSet.hs b/src/Test/HMock/Internal/ExpectSet.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/ExpectSet.hs
@@ -0,0 +1,204 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Test.HMock.Internal.ExpectSet where
+
+import Test.HMock.Internal.Multiplicity
+  ( Multiplicity,
+    between,
+    exhaustable,
+    feasible,
+    normalize,
+  )
+
+-- | A set of expected steps and their responses.  This is the "core" language
+-- of expectations for HMock.  It's based roughly on Svenningsson, Svensson,
+-- Smallbone, Arts, Norell, and Hughes' Expressive Semantics of Mocking.
+-- However, there are a few small adjustments.  We have two repetition operators
+-- which respectively represent general repetition with interleaving, and
+-- consecutive repetition.  We also attach arbitrary multiplicities to
+-- repetition.
+data ExpectSet step where
+  ExpectStep :: step -> ExpectSet step
+  ExpectNothing :: ExpectSet step
+  ExpectSequence :: ExpectSet step -> ExpectSet step -> ExpectSet step
+  ExpectInterleave :: ExpectSet step -> ExpectSet step -> ExpectSet step
+  ExpectEither :: ExpectSet step -> ExpectSet step -> ExpectSet step
+  ExpectMulti :: Multiplicity -> ExpectSet step -> ExpectSet step
+  ExpectConsecutive :: Multiplicity -> ExpectSet step -> ExpectSet step
+  deriving (Show, Eq)
+
+-- | Checks whether an ExpectSet is in an "accepting" state.  In other words, is
+-- it okay for the test to end here?  If False, then there are still
+-- expectations that must be satisfied before the test can succeed.
+satisfied :: ExpectSet step -> Bool
+satisfied (ExpectStep _) = False
+satisfied ExpectNothing = True
+satisfied (ExpectSequence e f) = satisfied e && satisfied f
+satisfied (ExpectInterleave e f) = satisfied e && satisfied f
+satisfied (ExpectEither e f) = satisfied e || satisfied f
+satisfied (ExpectMulti mult e) =
+  feasible mult && (exhaustable mult || satisfied e)
+satisfied (ExpectConsecutive mult e) =
+  feasible mult && (exhaustable mult || satisfied e)
+
+-- | Computes the live steps of the ExpectSet.  In other words: which individual
+-- steps can be matched right now, and what are the remaining expectations in
+-- each case?
+liveSteps :: ExpectSet step -> [(step, ExpectSet step)]
+liveSteps (ExpectStep step) = [(step, ExpectNothing)]
+liveSteps ExpectNothing = []
+liveSteps (ExpectSequence e f) =
+  (fmap (`ExpectSequence` f) <$> liveSteps e)
+    ++ if satisfied e then liveSteps f else []
+liveSteps (ExpectInterleave e f) =
+  (fmap (`ExpectInterleave` f) <$> liveSteps e)
+    ++ (fmap (ExpectInterleave e) <$> liveSteps f)
+liveSteps (ExpectEither e f) = liveSteps e ++ liveSteps f
+liveSteps (ExpectMulti mult e)
+  | feasible (mult - 1) =
+    [ (step, ExpectInterleave f (ExpectMulti (mult - 1) e))
+      | (step, f) <- liveSteps e
+    ]
+  | otherwise = []
+liveSteps (ExpectConsecutive mult e)
+  | feasible (mult - 1) =
+    [ (step, ExpectSequence f (ExpectConsecutive (mult - 1) e))
+      | (step, f) <- liveSteps e
+    ]
+  | otherwise = []
+
+-- | Performs a complete simplification of the ExpectSet.  This could be slow,
+-- but we intend to do it only for error messages, so it need not be very fast.
+simplify :: ExpectSet step -> ExpectSet step
+simplify (ExpectSequence e f)
+  | ExpectNothing <- e' = f'
+  | ExpectNothing <- f' = e'
+  | ExpectSequence e1 e2 <- e' =
+    simplify (ExpectSequence e1 (ExpectSequence e2 f'))
+  | otherwise = ExpectSequence e' f'
+  where
+    e' = simplify e
+    f' = simplify f
+simplify (ExpectInterleave e f)
+  | ExpectNothing <- e' = f'
+  | ExpectNothing <- f' = e'
+  | ExpectInterleave e1 e2 <- e' =
+    simplify (ExpectInterleave e1 (ExpectInterleave e2 f'))
+  | otherwise = ExpectInterleave e' f'
+  where
+    e' = simplify e
+    f' = simplify f
+simplify (ExpectEither e f)
+  | ExpectNothing <- e', ExpectNothing <- f' = ExpectNothing
+  | ExpectNothing <- e' = simplify (ExpectEither f' ExpectNothing)
+  | ExpectEither e1 e2 <- e' =
+    simplify (ExpectEither e1 (ExpectEither e2 f'))
+  | ExpectNothing <- f', satisfied e' = e'
+  | ExpectNothing <- f' = simplify (ExpectMulti (between 0 1) e')
+  | otherwise = ExpectEither e' f'
+  where
+    e' = simplify e
+    f' = simplify f
+simplify (ExpectMulti m e)
+  | not (feasible m) = ExpectMulti m ExpectNothing 
+  | ExpectNothing <- e' = ExpectNothing
+  | m == 0 = ExpectNothing
+  | m == 1 = e'
+  | otherwise = ExpectMulti (normalize m) e'
+  where
+    e' = simplify e
+simplify (ExpectConsecutive m e)
+  | not (feasible m) = ExpectConsecutive m ExpectNothing 
+  | ExpectNothing <- e' = ExpectNothing
+  | m == 0 = ExpectNothing
+  | m == 1 = e'
+  | otherwise = ExpectConsecutive (normalize m) e'
+  where
+    e' = simplify e
+simplify other = other
+
+-- | Get a list of all steps mentioned by an 'ExpectSet'.  This is used to
+-- determine which classes need to be initialized before adding an expectation.
+getSteps :: ExpectSet step -> [step]
+getSteps ExpectNothing = []
+getSteps (ExpectStep step) = [step]
+getSteps (ExpectInterleave e f) = getSteps e ++ getSteps f
+getSteps (ExpectSequence e f) = getSteps e ++ getSteps f
+getSteps (ExpectEither e f) = getSteps e ++ getSteps f
+getSteps (ExpectMulti _ e) = getSteps e
+getSteps (ExpectConsecutive _ e) = getSteps e
+
+-- | A higher-level intermediate form of an ExpectSet suitable for communication
+-- with the user.  Chains of binary operators are collected into sequences to
+-- be displayed in lists rather than arbitrary nesting.
+data CollectedSet step where
+  CollectedStep :: step -> CollectedSet step
+  CollectedNothing :: CollectedSet step
+  CollectedSequence :: [CollectedSet step] -> CollectedSet step
+  CollectedInterleave :: [CollectedSet step] -> CollectedSet step
+  CollectedChoice :: [CollectedSet step] -> CollectedSet step
+  CollectedMulti :: Multiplicity -> CollectedSet step -> CollectedSet step
+  CollectedConsecutive :: Multiplicity -> CollectedSet step -> CollectedSet step
+
+-- | Collects an ExpectSet into the intermediate form for display.  It's assumed
+-- that the expression was simplified before this operation.
+collect :: ExpectSet step -> CollectedSet step
+collect (ExpectStep s) = CollectedStep s
+collect ExpectNothing = CollectedNothing
+collect (ExpectSequence e f) = CollectedSequence (collect e : fs)
+  where
+    fs = case collect f of
+      CollectedSequence f' -> f'
+      f' -> [f']
+collect (ExpectInterleave e f) = CollectedInterleave (collect e : fs)
+  where
+    fs = case collect f of
+      CollectedInterleave f' -> f'
+      f' -> [f']
+collect (ExpectEither e f) = CollectedChoice (collect e : fs)
+  where
+    fs = case collect f of
+      CollectedChoice f' -> f'
+      f' -> [f']
+collect (ExpectMulti m e) = CollectedMulti m (collect e)
+collect (ExpectConsecutive m e) = CollectedConsecutive m (collect e)
+
+-- | Converts a set of expectations into a string that summarizes them, with
+-- the given prefix (used to indent).
+formatExpectSet :: (Show step) => ExpectSet step -> String
+formatExpectSet = go "" . collect . simplify
+  where
+    go prefix CollectedNothing = prefix ++ "* nothing"
+    go prefix (CollectedStep step) = prefix ++ "* " ++ show step
+    go prefix (CollectedSequence cs) =
+      prefix ++ "* in sequence:\n" ++ unlines (map (go ("    " ++ prefix)) cs)
+    go prefix (CollectedInterleave cs) =
+      prefix ++ "* in any order:\n" ++ unlines (map (go ("    " ++ prefix)) cs)
+    go prefix (CollectedChoice cs) =
+      prefix ++ "* any of:\n" ++ unlines (map (go ("    " ++ prefix)) cs)
+    go prefix (CollectedMulti m e) =
+      prefix ++ "* " ++ show m ++ ":\n" ++ go ("    " ++ prefix) e
+    go prefix (CollectedConsecutive m e) =
+      prefix ++ "* " ++ show m ++ " consecutively:\n" ++ go ("    " ++ prefix) e
+
+-- | Reduces a set of expectations to the minimum steps that would be required
+-- to satisfy the entire set.  This weeds out unnecessary information before
+-- reporting that there were unmet expectations at the end of the test.
+excess :: ExpectSet step -> ExpectSet step
+excess = simplify . go
+  where
+    go (ExpectSequence e f) = ExpectSequence (go e) (go f)
+    go (ExpectInterleave e f) = ExpectInterleave (go e) (go f)
+    go (ExpectEither e f)
+      | satisfied e || satisfied f = ExpectNothing
+      | otherwise = ExpectEither (go e) (go f)
+    go (ExpectMulti m e)
+      | exhaustable m = ExpectNothing
+      | otherwise = ExpectMulti m (go e)
+    go (ExpectConsecutive m e)
+      | exhaustable m = ExpectNothing
+      | otherwise = ExpectConsecutive m (go e)
+    go other = other
diff --git a/src/Test/HMock/Internal/Expectable.hs b/src/Test/HMock/Internal/Expectable.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/Expectable.hs
@@ -0,0 +1,342 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Test.HMock.Internal.Expectable where
+
+import Control.Monad.Trans (MonadIO)
+import Data.Kind (Constraint, Type)
+import Data.Maybe (listToMaybe)
+import Data.Typeable
+import GHC.Stack (CallStack, HasCallStack, callStack)
+import GHC.TypeLits (KnownSymbol, Symbol)
+import Test.HMock.Internal.ExpectSet
+import {-# SOURCE #-} Test.HMock.Internal.MockT
+import Test.HMock.Internal.Mockable
+import Test.HMock.Internal.Multiplicity
+import Test.HMock.Internal.Util (Located (Loc), locate, withLoc)
+
+-- | Something that can be expected.  This type class covers a number of cases:
+--
+--   * Expecting an exact 'Action'.
+--   * Expecting anything that matches a 'Matcher'.
+--   * Adding a return value (with '|->') or response (with '|=>').
+class Expectable cls name m r e | e -> cls name m r where
+  toRule :: e -> Rule cls name m r
+
+-- | A rule for matching a method and responding to it when it matches.
+--
+-- The method may be matched by providing either an 'Action' to match exactly,
+-- or a 'Matcher'.  Exact matching is only available when all method arguments
+--
+--
+-- A 'Rule' may have zero or more responses, which are attached using '|->' and
+-- '|=>'.  If there are no responses for a 'Rule', then there must be a default
+-- response for that action, and it is used.  If more than one response is
+-- added, the rule will perform the responses in order, repeating the last
+-- response if there are additional matches.
+--
+-- Example:
+--
+-- @
+-- 'expect' $
+--   GetLine_ 'Test.HMock.anything'
+--     '|->' "hello"
+--     '|=>' \(GetLine prompt) -> "The prompt was " ++ prompt
+--     '|->' "quit"
+-- @
+data
+  Rule
+    (cls :: (Type -> Type) -> Constraint)
+    (name :: Symbol)
+    (m :: Type -> Type)
+    (r :: Type)
+  where
+  (:=>) ::
+    Matcher cls name m r ->
+    [Action cls name m r -> MockT m r] ->
+    Rule cls name m r
+
+-- | Attaches a response to an expectation.  This is a very flexible response,
+-- which can look at arguments, do things in the base monad, set up more
+-- expectations, etc.  The matching 'Action' is passed to the response, and is
+-- guaranteed to be a match so it's fine to just pattern match on the correct
+-- method.
+(|=>) ::
+  Expectable cls name m r expectable =>
+  expectable ->
+  (Action cls name m r -> MockT m r) ->
+  Rule cls name m r
+e |=> r = m :=> (rs ++ [r]) where m :=> rs = toRule e
+
+infixl 1 |=>
+
+-- | Attaches a return value to an expectation.  This is more convenient than
+-- '|=>' in the common case where you just want to return a known result.
+-- @e '|->' r@ means the same thing as @e '|=>' 'const' ('return' r)@.
+(|->) ::
+  (Monad m, Expectable cls name m r expectable) =>
+  expectable ->
+  r ->
+  Rule cls name m r
+m |-> r = m |=> const (return r)
+
+infixl 1 |->
+
+instance Expectable cls name m r (Rule cls name m r) where
+  toRule = id
+
+instance Expectable cls name m r (Matcher cls name m r) where
+  toRule m = m :=> []
+
+-- | All constraints needed to mock a method with the given class, name, base
+-- monad, and return type.
+type MockableMethod
+  (cls :: (Type -> Type) -> Constraint)
+  (name :: Symbol)
+  (m :: Type -> Type)
+  (r :: Type) =
+  (Mockable cls, Typeable m, KnownSymbol name, Typeable r)
+
+-- | A Rule that contains only a single response.  This is the target for
+-- desugaring the multi-response rule format.
+data
+  SingleRule
+    (cls :: (Type -> Type) -> Constraint)
+    (name :: Symbol)
+    (m :: Type -> Type)
+    (r :: Type)
+  where
+  (:->) ::
+    Matcher cls name m r ->
+    Maybe (Action cls name m r -> MockT m r) ->
+    SingleRule cls name m r
+
+-- | A single step of an expectation.
+data Step m where
+  Step ::
+    MockableMethod cls name m r =>
+    Located (SingleRule cls name m r) ->
+    Step m
+
+instance Show (Step m) where
+  show (Step l@(Loc _ (m :-> _))) =
+    withLoc (showMatcher Nothing m <$ l)
+
+-- | Expands a Rule into an expectation.  The expected multiplicity will be one
+-- if there are no responses; otherwise one call is expected per response.
+expandRule ::
+  MockableMethod cls name m r =>
+  CallStack ->
+  Rule cls name m r ->
+  ExpectSet (Step m)
+expandRule callstack (m :=> []) =
+  ExpectStep (Step (locate callstack (m :-> Nothing)))
+expandRule callstack (m :=> rs) =
+  foldr1
+    ExpectInterleave
+    (map (ExpectStep . Step . locate callstack . (m :->) . Just) rs)
+
+-- | Expands a Rule into an expectation, given a target multiplicity.  It is an
+-- error if there are too many responses for the multiplicity.  If there are
+-- too few responses, the last response will be repeated.
+expandRepeatRule ::
+  MockableMethod cls name m r =>
+  Multiplicity ->
+  CallStack ->
+  Rule cls name m r ->
+  ExpectSet (Step m)
+expandRepeatRule mult _ (_ :=> rs)
+  | not (feasible (mult - fromIntegral (length rs))) =
+    error $
+      show (length rs)
+        ++ " responses is too many for multiplicity "
+        ++ show mult
+expandRepeatRule mult callstack (m :=> (r1 : r2 : rs)) =
+  ExpectSequence first (expandRepeatRule (mult - 1) callstack (m :=> (r2 : rs)))
+  where
+    first
+      | exhaustable mult =
+        ExpectMulti
+          (atMost 1)
+          (ExpectStep (Step (locate callstack (m :-> Just r1))))
+      | otherwise = ExpectStep (Step (locate callstack (m :-> Just r1)))
+expandRepeatRule mult callstack (m :=> rs) =
+  ExpectMulti mult (ExpectStep (Step (locate callstack (m :-> listToMaybe rs))))
+
+-- | Type class for contexts in which it makes sense to express an expectation.
+-- Notably, this includes `MockT`, which expects actions to be performed during
+-- a test.
+class ExpectContext (t :: (Type -> Type) -> Type -> Type) where
+  fromExpectSet :: MonadIO m => ExpectSet (Step m) -> t m ()
+
+newtype Expected m a = Expected {unwrapExpected :: ExpectSet (Step m)}
+
+instance ExpectContext Expected where
+  fromExpectSet = Expected
+
+-- | Creates an expectation that an action is performed once per given
+-- response (or exactly once if there is no response).
+--
+-- @
+-- 'runMockT' '$' do
+--   'expect' '$'
+--     ReadFile "foo.txt"
+--       '|->' "lorem ipsum"
+--       '|->' "oops, the file changed out from under me!"
+--   callCodeUnderTest
+-- @
+--
+-- In this example, `readFile` must be called exactly twice by the tested code,
+-- and will return "lorem ipsum" the first time, but something different the
+-- second time.
+expect ::
+  ( HasCallStack,
+    MonadIO m,
+    MockableMethod cls name m r,
+    Expectable cls name m r expectable,
+    ExpectContext ctx
+  ) =>
+  expectable ->
+  ctx m ()
+expect e = fromExpectSet (expandRule callStack (toRule e))
+
+-- | Creates an expectation that an action is performed some number of times.
+--
+-- @
+--   'runMockT' '$' do
+--     'expect' '$' MakeList
+--     'expectN' ('Test.HMock.atLeast' 2) '$'
+--       CheckList "Cindy Lou Who" '|->' "nice"
+--
+--     callCodeUnderTest
+-- @
+expectN ::
+  ( HasCallStack,
+    MonadIO m,
+    MockableMethod cls name m r,
+    Expectable cls name m r expectable,
+    ExpectContext ctx
+  ) =>
+  -- | The number of times the action should be performed.
+  Multiplicity ->
+  -- | The action and its response.
+  expectable ->
+  ctx m ()
+expectN mult e = fromExpectSet (expandRepeatRule mult callStack (toRule e))
+
+-- | Specifies a response if a matching action is performed, but doesn't expect
+-- anything.  This is equivalent to @'expectN' 'anyMultiplicity'@, but shorter.
+--
+-- In this example, the later use of 'whenever' overrides earlier uses, but only
+-- for calls that match its conditions.
+--
+-- @
+--   'runMockT' '$' do
+--     'whenever' '$' ReadFile_ anything '|->' "tlhIngan maH!"
+--     'whenever' '$' ReadFile "config.txt" '|->' "lang: klingon"
+--
+--     callCodeUnderTest
+-- @
+expectAny ::
+  ( HasCallStack,
+    MonadIO m,
+    MockableMethod cls name m r,
+    Expectable cls name m r expectable,
+    ExpectContext ctx
+  ) =>
+  expectable ->
+  ctx m ()
+expectAny e =
+  fromExpectSet (expandRepeatRule anyMultiplicity callStack (toRule e))
+
+-- | Creates a sequential expectation.  Other actions can still happen during
+-- the sequence, but these specific expectations must be met in this order.
+--
+-- @
+--   'inSequence'
+--     [ 'expect' '$' MoveForward,
+--       'expect' '$' TurnRight,
+--       'expect' '$' MoveForward
+--     ]
+-- @
+--
+-- Beware of using 'inSequence' too often.  It is appropriate when the property
+-- you are testing is that the order of effects is correct.  If that's not the
+-- purpose of the test, consider adding several independent expectations,
+-- instead.  This avoids over-asserting, and keeps your tests less brittle.
+inSequence ::
+  (MonadIO m, ExpectContext ctx) =>
+  (forall ctx'. ExpectContext ctx' => [ctx' m ()]) ->
+  ctx m ()
+inSequence es = fromExpectSet (foldr1 ExpectSequence (map unwrapExpected es))
+
+-- | Combines multiple expectations, which can occur in any order.  Most of the
+-- time, you can achieve the same thing by expecting each separately, but this
+-- can be combined in complex expectations to describe more complex ordering
+-- constraints.
+--
+-- @
+--   'inSequence'
+--     [ 'inAnyOrder'
+--         [ 'expect' '$' AdjustMirrors,
+--           'expect' '$' FastenSeatBelt
+--         ],
+--       'expect' '$' StartCar
+--     ]
+-- @
+inAnyOrder ::
+  (MonadIO m, ExpectContext ctx) =>
+  (forall ctx'. ExpectContext ctx' => [ctx' m ()]) ->
+  ctx m ()
+inAnyOrder es = fromExpectSet (foldr1 ExpectInterleave (map unwrapExpected es))
+
+-- | Combines multiple expectations, requiring exactly one of them to occur.
+--
+-- @
+--   'anyOf'
+--     [ 'expect' $ ApplyForJob,
+--       'expect' $ ApplyForUniversity
+--     ]
+-- @
+anyOf ::
+  (MonadIO m, ExpectContext ctx) =>
+  (forall ctx'. ExpectContext ctx' => [ctx' m ()]) ->
+  ctx m ()
+anyOf es = fromExpectSet (foldr1 ExpectEither (map unwrapExpected es))
+
+-- | Creates a parent expectation that the child expectation will happen a
+-- certain number of times.  Unlike `expectN`, the child expectation can be
+-- arbitrarily complex and span multiple actions.  Also unlike 'expectN', each
+-- new execution will restart response sequences for rules with more than one
+-- response.
+--
+-- Different occurrences of the child can be interleaved.  In case of ambiguity,
+-- progressing on an existing occurrence is preferred over starting a new
+-- occurrence.
+times :: (MonadIO m, ExpectContext ctx) =>
+  Multiplicity ->
+  (forall ctx'. ExpectContext ctx' => ctx' m ()) ->
+  ctx m ()
+times mult e = fromExpectSet (ExpectMulti mult (unwrapExpected e))
+
+-- | Creates a parent expectation that the child expectation will happen a
+-- certain number of times.  Unlike `expectN`, the child expectation can be
+-- arbitrarily complex and span multiple actions.  Also unlike 'expectN', each
+-- new execution will restart response sequences for rules with more than one
+-- response.
+--
+-- Different occurrences of the child must happen consecutively, with one
+-- finishing before the next begins.
+consecutiveTimes :: (MonadIO m, ExpectContext ctx) =>
+  Multiplicity ->
+  (forall ctx'. ExpectContext ctx' => ctx' m ()) ->
+  ctx m ()
+consecutiveTimes mult e =
+  fromExpectSet (ExpectConsecutive mult (unwrapExpected e))
diff --git a/src/Test/HMock/Internal/MockT.hs b/src/Test/HMock/Internal/MockT.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/MockT.hs
@@ -0,0 +1,301 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Test.HMock.Internal.MockT where
+
+import Control.Concurrent (MVar)
+import Control.Monad (forM_, unless)
+import Control.Monad.Base (MonadBase)
+import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
+import Control.Monad.Cont (MonadCont)
+import Control.Monad.Except (MonadError)
+import Control.Monad.RWS (MonadRWS)
+import Control.Monad.Reader
+  ( MonadReader (ask, local, reader),
+    ReaderT,
+    mapReaderT,
+    runReaderT,
+  )
+import Control.Monad.State (MonadState)
+import Control.Monad.Trans (MonadIO, MonadTrans, lift)
+import Control.Monad.Writer (MonadWriter)
+import Data.Default (Default (def))
+import Data.Either (partitionEithers)
+import Data.Function (on)
+import Data.List (intercalate, sortBy)
+import Data.Maybe (catMaybes, fromMaybe)
+import Data.Proxy (Proxy (Proxy))
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Typeable (TypeRep, Typeable, cast, typeRep)
+import GHC.Stack
+import Test.HMock.Internal.ExpectSet
+import Test.HMock.Internal.Expectable
+import Test.HMock.Internal.Mockable
+import Test.HMock.Internal.Util (Located (..), locate, withLoc)
+import UnliftIO (MonadUnliftIO, newMVar, putMVar, readMVar, takeMVar)
+
+#if !MIN_VERSION_base(4, 13, 0)
+import Control.Monad.Fail (MonadFail)
+#endif
+
+data MockState m = MockState
+  { mockExpectSet :: ExpectSet (Step m),
+    mockDefaults :: [Step m],
+    mockClasses :: Set TypeRep
+  }
+
+initMockState :: MockState m
+initMockState =
+  MockState
+    { mockExpectSet = ExpectNothing,
+      mockDefaults = [],
+      mockClasses = Set.empty
+    }
+
+-- | Monad transformer for running mocks.
+newtype MockT m a where
+  MockT :: {unMockT :: ReaderT (MVar (MockState m)) m a} -> MockT m a
+  deriving
+    ( Functor,
+      Applicative,
+      Monad,
+      MonadFail,
+      MonadIO,
+      MonadState s,
+      MonadWriter w,
+      MonadRWS r w s,
+      MonadError e,
+      MonadCont,
+      MonadBase b,
+      MonadCatch,
+      MonadMask,
+      MonadThrow,
+      MonadUnliftIO
+    )
+
+instance MonadTrans MockT where
+  lift = MockT . lift
+
+mapMockT :: (m a -> m b) -> MockT m a -> MockT m b
+mapMockT f = MockT . mapReaderT f . unMockT
+
+initClassIfNeeded ::
+  forall cls m proxy.
+  (Mockable cls, Typeable m, MonadIO m) =>
+  proxy cls ->
+  MockT m ()
+initClassIfNeeded proxy =
+  do
+    stateVar <- MockT ask
+    mockState <- takeMVar stateVar
+    let newMockClasses = Set.insert t (mockClasses mockState)
+    putMVar stateVar (mockState {mockClasses = newMockClasses})
+    unless (t `Set.member` mockClasses mockState) $ do
+      setupMockable (Proxy :: Proxy cls)
+  where
+    t = typeRep proxy
+
+initClassesAsNeeded :: MonadIO m => ExpectSet (Step m) -> MockT m ()
+initClassesAsNeeded es = forM_ (getSteps es) $
+  \(Step (_ :: Located (SingleRule cls name m r))) ->
+    initClassIfNeeded (Proxy :: Proxy cls)
+
+instance MonadReader r m => MonadReader r (MockT m) where
+  ask = lift ask
+  local = mapMockT . local
+  reader = lift . reader
+
+instance ExpectContext MockT where
+  fromExpectSet e = do
+    initClassesAsNeeded e
+    stateVar <- MockT ask
+    mockState <- takeMVar stateVar
+    let newExpectSet = e `ExpectInterleave` mockExpectSet mockState
+    putMVar stateVar (mockState {mockExpectSet = newExpectSet})
+
+-- | Runs a test in the 'MockT' monad, handling all of the mocks.
+runMockT :: forall m a. MonadIO m => MockT m a -> m a
+runMockT test = withMockT constTest
+  where
+    constTest :: (forall b. MockT m b -> m b) -> MockT m a
+    constTest _inMockT = test
+
+-- | Runs a test in the 'MockT' monad.  The test can unlift other MockT pieces
+-- to the base monad while still acting on the same set of expectations.  This
+-- can be useful for testing concurrency or similar mechanisms.
+--
+-- @
+-- test = 'withMockT' '$' \inMockT -> do
+--    'expect' '$' ...
+--
+--    'liftIO' '$' 'forkIO' '$' inMockT firstThread
+--    'liftIO' '$' 'forkIO' '$' inMockT secondThread
+-- @
+--
+-- This is a low-level primitive.  Consider using the @unliftio@ package for
+-- higher level implementations of multithreading and other primitives.
+withMockT ::
+  forall m b. MonadIO m => ((forall a. MockT m a -> m a) -> MockT m b) -> m b
+withMockT test = do
+  stateVar <- newMVar initMockState
+  let inMockT :: forall a. MockT m a -> m a
+      inMockT m = runReaderT (unMockT m) stateVar
+  flip runReaderT stateVar $
+    unMockT $ do
+      a <- test inMockT
+      verifyExpectations
+      return a
+
+-- | Fetches a 'String' that describes the current set of outstanding
+-- expectations.  This is sometimes useful for debugging test code.  The exact
+-- format is not specified.
+describeExpectations :: MonadIO m => MockT m String
+describeExpectations =
+  formatExpectSet <$> (MockT ask >>= fmap mockExpectSet . readMVar)
+
+-- | Verifies that all mock expectations are satisfied.  You normally don't need
+-- to do this, because it happens automatically at the end of your test in
+-- 'runMockT'.  However, it's occasionally useful to check expectations in the
+-- middle of a test, such as before going on to the next stage.
+--
+-- Use of 'verifyExpectations' might signify that you are doing too much in a
+-- single test.  Consider splitting large tests into a separate test for each
+-- case.
+verifyExpectations :: MonadIO m => MockT m ()
+verifyExpectations = do
+  expectSet <- MockT ask >>= fmap mockExpectSet . readMVar
+  unless (satisfied expectSet) $ do
+    case excess expectSet of
+      ExpectNothing -> return ()
+      missing -> error $ "Unmet expectations:\n" ++ formatExpectSet missing
+
+-- | Changes the default response for matching actions.
+--
+-- Without 'byDefault', actions with no explicit response will return the
+-- 'Default' value for the type, or 'undefined' if the return type isn't an
+-- instance of 'Default'.  'byDefault' replaces that with a new default
+-- response, also overriding any previous defaults. The rule passed in must have
+-- exactly one response.
+byDefault ::
+  forall cls name m r.
+  (MonadIO m, MockableMethod cls name m r) =>
+  Rule cls name m r ->
+  MockT m ()
+byDefault (m :=> [r]) = do
+  initClassIfNeeded (Proxy :: Proxy cls)
+  stateVar <- MockT ask
+  mockState <- takeMVar stateVar
+  let newDefaults =
+        Step (locate callStack (m :-> Just r)) : mockDefaults mockState
+  putMVar stateVar (mockState {mockDefaults = newDefaults})
+byDefault _ = error "Defaults must have exactly one response."
+
+mockMethodImpl ::
+  forall cls name m r.
+  ( HasCallStack,
+    MonadIO m,
+    MockableMethod cls name m r
+  ) =>
+  r ->
+  Action cls name m r ->
+  MockT m r
+mockMethodImpl surrogate action =
+  do
+    initClassIfNeeded (Proxy :: Proxy cls)
+    stateVar <- MockT ask
+    mockState <- takeMVar stateVar
+    let (newExpectSet, response) =
+          decideAction (mockExpectSet mockState) (mockDefaults mockState)
+    putMVar stateVar mockState {mockExpectSet = newExpectSet}
+    response
+  where
+    decideAction expectSet defaults =
+      let (partial, full) = partitionEithers (tryMatch <$> liveSteps expectSet)
+          orderedPartial = snd <$> sortBy (compare `on` fst) (catMaybes partial)
+       in case (full, findDefault defaults, surrogate, orderedPartial) of
+            ((e, Just response) : _, _, _, _) -> (e, response)
+            ((e, Nothing) : _, d, s, _) -> (e, fromMaybe (return s) d)
+            ([], _, _, []) -> error $ noMatchError action
+            ([], _, _, _) -> error $ partialMatchError action orderedPartial
+    tryMatch ::
+      (Step m, ExpectSet (Step m)) ->
+      Either (Maybe (Int, String)) (ExpectSet (Step m), Maybe (MockT m r))
+    tryMatch (Step expected, e)
+      | Just lrule@(Loc _ (m :-> impl)) <- cast expected =
+        case matchAction m action of
+          NoMatch n ->
+            Left (Just (n, withLoc (showMatcher (Just action) m <$ lrule)))
+          Match ->
+            Right (e, ($ action) <$> impl)
+      | otherwise = Left Nothing
+
+    findDefault :: [Step m] -> Maybe (MockT m r)
+    findDefault [] = Nothing
+    findDefault (Step expected : _)
+      | Just (Loc _ (m :-> Just r)) <- cast expected,
+        Match <- matchAction m action =
+        Just (r action)
+    findDefault (_ : steps) = findDefault steps
+
+-- | Implements a method in a 'Mockable' monad by delegating to the mock
+-- framework.  If the method is called unexpectedly, an exception will be
+-- thrown.  However, an expected invocation without a specified response will
+-- return the default value.
+mockMethod ::
+  forall cls name m r.
+  ( HasCallStack,
+    MonadIO m,
+    MockableMethod cls name m r,
+    Default r
+  ) =>
+  Action cls name m r ->
+  MockT m r
+mockMethod action =
+  withFrozenCallStack $ mockMethodImpl def action
+
+-- | Implements a method in a 'Mockable' monad by delegating to the mock
+-- framework.  If the method is called unexpectedly, an exception will be
+-- thrown.  However, an expected invocation without a specified response will
+-- return undefined.  This can be used in place of 'mockMethod' when the return
+-- type has no default.
+mockDefaultlessMethod ::
+  forall cls name m r.
+  ( HasCallStack,
+    MonadIO m,
+    MockableMethod cls name m r
+  ) =>
+  Action cls name m r ->
+  MockT m r
+mockDefaultlessMethod action =
+  withFrozenCallStack $ mockMethodImpl undefined action
+
+-- An error for an action that matches no expectations at all.
+noMatchError ::
+  (HasCallStack, Mockable cls) =>
+  -- | The action that was received.
+  Action cls name m a ->
+  String
+noMatchError a =
+  "Unexpected action: " ++ showAction a
+
+-- An error for an action that doesn't match the argument predicates for any
+-- of the method's expectations.
+partialMatchError ::
+  (HasCallStack, Mockable cls) =>
+  -- | The action that was received.
+  Action cls name m a ->
+  -- | Descriptions of the matchers that most closely matched, closest first.
+  [String] ->
+  String
+partialMatchError a partials =
+  "Wrong arguments: "
+    ++ showAction a
+    ++ "\n\nClosest matches:\n - "
+    ++ intercalate "\n - " (take 5 partials)
diff --git a/src/Test/HMock/Internal/MockT.hs-boot b/src/Test/HMock/Internal/MockT.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/MockT.hs-boot
@@ -0,0 +1,12 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE RoleAnnotations #-}
+
+module Test.HMock.Internal.MockT where
+
+import Data.Kind (Type)
+
+type role MockT nominal nominal
+
+data MockT (m :: Type -> Type) (a :: Type)
+
+instance Monad m => Monad (MockT m)
diff --git a/src/Test/HMock/Internal/Mockable.hs b/src/Test/HMock/Internal/Mockable.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/Mockable.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Test.HMock.Internal.Mockable where
+
+import Control.Monad.Trans (MonadIO)
+import Data.Kind (Constraint, Type)
+import Data.Typeable (Typeable)
+import GHC.TypeLits (Symbol)
+import {-# SOURCE #-} Test.HMock.Internal.MockT (MockT)
+
+-- | The result of matching a @'Matcher' a@ with an @'Action' b@.  Because the
+-- types should already guarantee that the methods match, all that's left is to
+-- match arguments.
+data MatchResult where
+  -- | No match.  The int is the number of arguments that don't match.
+  NoMatch :: Int -> MatchResult
+  -- | Match. Stores a witness to the equality of return types.
+  Match :: MatchResult
+
+-- | A base class for 'Monad' subclasses whose methods can be mocked.  You
+-- usually want to generate this instance using 'Test.HMock.TH.makeMockable',
+-- 'Test.HMock.TH.makeMockableBase', 'Test.HMock.TH.deriveMockable', or
+-- 'Test.HMock.TH.deriveMockableBase'.  It's just boilerplate.
+class (Typeable cls) => MockableBase (cls :: (Type -> Type) -> Constraint) where
+  -- | An action that is performed.  This data type will have one constructor
+  -- for each method.
+  data Action cls :: Symbol -> (Type -> Type) -> Type -> Type
+
+  -- | A specification for matching actions.  The actual arguments should be
+  -- replaced with predicates.
+  data Matcher cls :: Symbol -> (Type -> Type) -> Type -> Type
+
+  -- | Gets a text description of an 'Action', for use in error messages.
+  showAction :: Action cls name m a -> String
+
+  -- | Gets a text description of a 'Matcher', for use in error messages.
+  showMatcher :: Maybe (Action cls name m a) -> Matcher cls name m b -> String
+
+  -- | Attempts to match an 'Action' with a 'Matcher'.
+  matchAction :: Matcher cls name m a -> Action cls name m a -> MatchResult
+
+-- | A class for 'Monad' subclasses whose methods can be mocked.  This class
+-- augments 'MockableBase' with a setup method that is run before HMock touches
+-- the 'Monad' subclass for the first time.  The default implementation does
+-- nothing, but you can derive your own instances that add setup behavior.
+class MockableBase cls => Mockable (cls :: (Type -> Type) -> Constraint) where
+  -- An action to run and set up defaults for this class.  The action will be
+  -- run before HMock touches the class, either to add expectations or to
+  -- delegate a method.
+  setupMockable :: (MonadIO m, Typeable m) => proxy cls -> MockT m ()
+  setupMockable _ = return ()
diff --git a/src/Test/HMock/Internal/Multiplicity.hs b/src/Test/HMock/Internal/Multiplicity.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/Multiplicity.hs
@@ -0,0 +1,153 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Test.HMock.Internal.Multiplicity where
+
+-- | An acceptable range of number of times for something to happen.
+--
+-- A multiplicity can have a lower and an upper bound.
+data Multiplicity = Multiplicity Int (Maybe Int) deriving (Eq)
+
+instance Show Multiplicity where
+  show m | not (feasible m) = "infeasible"
+  show (Multiplicity 0 (Just 0)) = "never"
+  show (Multiplicity 1 (Just 1)) = "once"
+  show (Multiplicity 2 (Just 2)) = "twice"
+  show (Multiplicity 0 Nothing) = "any number of times"
+  show (Multiplicity 1 Nothing) = "at least once"
+  show (Multiplicity 2 Nothing) = "at least twice"
+  show (Multiplicity n Nothing) = "at least " ++ show n ++ " times"
+  show (Multiplicity 0 (Just 1)) = "at most once"
+  show (Multiplicity 0 (Just 2)) = "at most twice"
+  show (Multiplicity 0 (Just n)) = "at most " ++ show n ++ " times"
+  show (Multiplicity m (Just n))
+    | m == n = show n ++ " times"
+    | m == n - 1 = show m ++ " or " ++ show n ++ " times"
+    | otherwise = show m ++ " to " ++ show n ++ " times"
+
+-- | A 'Multiplicity' value representing inconsistent expectations.
+infeasible :: Multiplicity
+infeasible = Multiplicity 0 (Just (-1))
+
+-- | This is an incomplete instance, provided for convenience.
+--
+-- >>> meetsMultiplicity 5 4
+-- False
+-- >>> meetsMultiplicity 5 5
+-- True
+-- >>> between 4 6 - between 1 2
+-- 2 to 5 times
+instance Num Multiplicity where
+  fromInteger n
+    | n < 0 = infeasible
+    | otherwise =
+      normalize $
+        Multiplicity (fromInteger n) (Just (fromInteger n))
+
+  m1@(Multiplicity a b) + m2@(Multiplicity c d)
+    | feasible m1 && feasible m2 =
+      normalize $ Multiplicity (a + c) ((+) <$> b <*> d)
+    | otherwise = infeasible
+
+  m1@(Multiplicity a b) - m2@(Multiplicity c d)
+    | feasible m1 && feasible m2 =
+      normalize $ Multiplicity (maybe 0 (a -) d) (subtract c <$> b)
+    | otherwise = infeasible
+
+  (*) = error "Multiplicities are not closed under multiplication"
+
+  abs = id
+
+  signum (Multiplicity 0 (Just 0)) = 0
+  signum _ = 1
+
+normalize :: Multiplicity -> Multiplicity
+normalize (Multiplicity a b) = Multiplicity (max a 0) b
+
+-- | Checks whether a certain number satisfies the 'Multiplicity'.
+meetsMultiplicity :: Multiplicity -> Int -> Bool
+meetsMultiplicity (Multiplicity lo mbhi) n
+  | n < lo = False
+  | Just hi <- mbhi, n > hi = False
+  | otherwise = True
+
+-- | A 'Multiplicity' that means exactly once.
+--
+-- >>> meetsMultiplicity once 0
+-- False
+-- >>> meetsMultiplicity once 1
+-- True
+-- >>> meetsMultiplicity once 2
+-- False
+once :: Multiplicity
+once = 1
+
+-- | A 'Multiplicity' that means any number of times.
+-- >>> meetsMultiplicity anyMultiplicity 0
+-- True
+-- >>> meetsMultiplicity anyMultiplicity 1
+-- True
+-- >>> meetsMultiplicity anyMultiplicity 10
+-- True
+anyMultiplicity :: Multiplicity
+anyMultiplicity = atLeast 0
+
+-- | A 'Multiplicity' that means at least this many times.
+--
+-- >>> meetsMultiplicity (atLeast 2) 1
+-- False
+-- >>> meetsMultiplicity (atLeast 2) 2
+-- True
+-- >>> meetsMultiplicity (atLeast 2) 3
+-- True
+atLeast :: Multiplicity -> Multiplicity
+atLeast (Multiplicity n _) = Multiplicity n Nothing
+
+-- | A 'Multiplicity' that means at most this many times.
+--
+-- >>> meetsMultiplicity (atMost 2) 1
+-- True
+-- >>> meetsMultiplicity (atMost 2) 2
+-- True
+-- >>> meetsMultiplicity (atMost 2) 3
+-- False
+atMost :: Multiplicity -> Multiplicity
+atMost (Multiplicity _ n) = Multiplicity 0 n
+
+-- | A 'Multiplicity' that means any number in this interval, endpoints
+-- included.  For example, @'between' 2 3@ means 2 or 3 times, while
+-- @'between' n n@ is equivalent to @n@.
+--
+-- >>> meetsMultiplicity (between 2 3) 1
+-- False
+-- >>> meetsMultiplicity (between 2 3) 2
+-- True
+-- >>> meetsMultiplicity (between 2 3) 3
+-- True
+-- >>> meetsMultiplicity (between 2 3) 4
+-- False
+between :: Multiplicity -> Multiplicity -> Multiplicity
+between (Multiplicity m _) (Multiplicity _ n) = Multiplicity m n
+
+-- | Checks whether a 'Multiplicity' includes zero in its range.
+--
+-- >>> exhaustable anyMultiplicity
+-- True
+-- >>> exhaustable (atLeast 2)
+-- False
+-- >>> exhaustable (atMost 3)
+-- True
+-- >>> exhaustable (between 0 2)
+-- True
+exhaustable :: Multiplicity -> Bool
+exhaustable m@(Multiplicity lo _) = feasible m && lo == 0
+
+-- | Checks whether a 'Multiplicity' is capable of matching any number at all.
+--
+-- >>> feasible once
+-- True
+-- >>> feasible 0
+-- True
+-- >>> feasible (once - 2)
+-- False
+feasible :: Multiplicity -> Bool
+feasible (Multiplicity a b) = maybe True (>= a) b
diff --git a/src/Test/HMock/Internal/Predicates.hs b/src/Test/HMock/Internal/Predicates.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/Predicates.hs
@@ -0,0 +1,944 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Test.HMock.Internal.Predicates where
+
+import Data.Char (toUpper)
+import Data.Maybe (isJust)
+import Data.MonoTraversable
+import qualified Data.Sequences as Seq
+import Data.Typeable (Proxy (..), Typeable, cast, typeRep)
+import GHC.Exts (IsList (Item, toList))
+import GHC.Stack (HasCallStack, callStack)
+import Language.Haskell.TH (ExpQ, PatQ, pprint)
+import Language.Haskell.TH.Syntax (lift)
+import Test.HMock.Internal.TH.Util (removeModNames)
+import Test.HMock.Internal.Util (choices, locate, isSubsequenceOf, withLoc)
+import Text.Regex.TDFA hiding (match)
+
+-- $setup
+-- >>> :set -XTemplateHaskell
+-- >>> :set -XTypeApplications
+-- >>> :set -Wno-type-defaults
+
+-- | A predicate, which tests values and either accepts or rejects them.  This
+-- is similar to @a -> 'Bool'@, but also has a 'Show' instance to describe what
+-- it is checking.
+--
+-- Predicates are used to define which arguments a general matcher should
+-- accept.
+data Predicate a = Predicate
+  { showPredicate :: String,
+    accept :: a -> Bool
+  }
+
+instance Show (Predicate a) where show = showPredicate
+
+-- | A 'Predicate' that accepts anything at all.
+--
+-- >>> accept anything "foo"
+-- True
+-- >>> accept anything undefined
+-- True
+anything :: Predicate a
+anything =
+  Predicate
+    { showPredicate = "anything",
+      accept = const True
+    }
+
+-- | A 'Predicate' that accepts only the given value.
+--
+-- >>> accept (eq "foo") "foo"
+-- True
+-- >>> accept (eq "foo") "bar"
+-- False
+eq :: (Show a, Eq a) => a -> Predicate a
+eq x =
+  Predicate
+    { showPredicate = show x,
+      accept = (== x)
+    }
+
+-- | A 'Predicate' that accepts anything but the given value.
+--
+-- >>> accept (neq "foo") "foo"
+-- False
+-- >>> accept (neq "foo") "bar"
+-- True
+neq :: (Show a, Eq a) => a -> Predicate a
+neq x =
+  Predicate
+    { showPredicate = "≠ " ++ show x,
+      accept = (/= x)
+    }
+
+-- | A 'Predicate' that accepts anything greater than the given value.
+--
+-- >>> accept (gt 5) 4
+-- False
+-- >>> accept (gt 5) 5
+-- False
+-- >>> accept (gt 5) 6
+-- True
+gt :: (Show a, Ord a) => a -> Predicate a
+gt x =
+  Predicate
+    { showPredicate = "> " ++ show x,
+      accept = (> x)
+    }
+
+-- | A 'Predicate' that accepts anything greater than or equal to the given
+-- value.
+--
+-- >>> accept (geq 5) 4
+-- False
+-- >>> accept (geq 5) 5
+-- True
+-- >>> accept (geq 5) 6
+-- True
+geq :: (Show a, Ord a) => a -> Predicate a
+geq x =
+  Predicate
+    { showPredicate = "≥ " ++ show x,
+      accept = (>= x)
+    }
+
+-- | A 'Predicate' that accepts anything less than the given value.
+--
+-- >>> accept (lt 5) 4
+-- True
+-- >>> accept (lt 5) 5
+-- False
+-- >>> accept (lt 5) 6
+-- False
+lt :: (Show a, Ord a) => a -> Predicate a
+lt x =
+  Predicate
+    { showPredicate = "< " ++ show x,
+      accept = (< x)
+    }
+
+-- | A 'Predicate' that accepts anything less than or equal to the given value.
+--
+-- >>> accept (leq 5) 4
+-- True
+-- >>> accept (leq 5) 5
+-- True
+-- >>> accept (leq 5) 6
+-- False
+leq :: (Show a, Ord a) => a -> Predicate a
+leq x =
+  Predicate
+    { showPredicate = "≤ " ++ show x,
+      accept = (<= x)
+    }
+
+-- | A 'Predicate' that matches 'True' values.
+--
+-- >>> accept true True
+-- True
+-- >>> accept true False
+-- False
+true :: Predicate Bool
+true = eq True
+
+-- | A 'Predicate' that matches 'False' values.
+--
+-- >>> accept false True
+-- False
+-- >>> accept false False
+-- True
+false :: Predicate Bool
+false = eq False
+
+-- | A 'Predicate' that accepts 'Maybe' values of @'Just' x@, where @x@ matches
+-- the given child 'Predicate'.
+--
+-- >>> accept (just (eq "value")) Nothing
+-- False
+-- >>> accept (just (eq "value")) (Just "value")
+-- True
+-- >>> accept (just (eq "value")) (Just "wrong value")
+-- False
+just :: Predicate a -> Predicate (Maybe a)
+just p =
+  Predicate
+    { showPredicate = "Just (" ++ showPredicate p ++ ")",
+      accept = \case Just x -> accept p x; _ -> False
+    }
+
+-- | A 'Predicate' that accepts an 'Either' value of @'Left' x@, where @x@
+-- matches the given child 'Predicate'.
+--
+-- >>> accept (left (eq "value")) (Left "value")
+-- True
+-- >>> accept (left (eq "value")) (Right "value")
+-- False
+-- >>> accept (left (eq "value")) (Left "wrong value")
+-- False
+left :: Predicate a -> Predicate (Either a b)
+left p =
+  Predicate
+    { showPredicate = "Left (" ++ showPredicate p ++ ")",
+      accept = \case Left x -> accept p x; _ -> False
+    }
+
+-- | A 'Predicate' that accepts an 'Either' value of @'Right' x@, where @x@
+-- matches the given child 'Predicate'.
+--
+-- >>> accept (right (eq "value")) (Right "value")
+-- True
+-- >>> accept (right (eq "value")) (Right "wrong value")
+-- False
+-- >>> accept (right (eq "value")) (Left "value")
+-- False
+right :: Predicate b -> Predicate (Either a b)
+right p =
+  Predicate
+    { showPredicate = "Right (" ++ showPredicate p ++ ")",
+      accept = \case Right x -> accept p x; _ -> False
+    }
+
+-- | A 'Predicate' that accepts pairs whose elements satisfy the corresponding
+-- child 'Predicates'.
+--
+-- >>> accept (zipP (eq "foo") (eq "bar")) ("foo", "bar")
+-- True
+-- >>> accept (zipP (eq "foo") (eq "bar")) ("bar", "foo")
+-- False
+zipP :: Predicate a -> Predicate b -> Predicate (a, b)
+zipP p q =
+  Predicate
+    { showPredicate = show (p, q),
+      accept = \(x, y) -> accept p x && accept q y
+    }
+
+-- | A 'Predicate' that accepts 3-tuples whose elements satisfy the
+-- corresponding child 'Predicate's.
+--
+-- >>> accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("foo", "bar", "qux")
+-- True
+-- >>> accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("qux", "bar", "foo")
+-- False
+zip3P :: Predicate a -> Predicate b -> Predicate c -> Predicate (a, b, c)
+zip3P p1 p2 p3 =
+  Predicate
+    { showPredicate = show (p1, p2, p3),
+      accept = \(x1, x2, x3) -> accept p1 x1 && accept p2 x2 && accept p3 x3
+    }
+
+-- | A 'Predicate' that accepts 3-tuples whose elements satisfy the
+-- corresponding child 'Predicates'.
+--
+-- >>> accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (1, 2, 3, 4)
+-- True
+-- >>> accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (4, 3, 2, 1)
+-- False
+zip4P ::
+  Predicate a ->
+  Predicate b ->
+  Predicate c ->
+  Predicate d ->
+  Predicate (a, b, c, d)
+zip4P p1 p2 p3 p4 =
+  Predicate
+    { showPredicate = show (p1, p2, p3, p4),
+      accept = \(x1, x2, x3, x4) ->
+        accept p1 x1 && accept p2 x2 && accept p3 x3 && accept p4 x4
+    }
+
+-- | A 'Predicate' that accepts 3-tuples whose elements satisfy the
+-- corresponding child 'Predicates'.
+--
+-- >>> accept (zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5)) (1, 2, 3, 4, 5)
+-- True
+-- >>> accept (zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5)) (5, 4, 3, 2, 1)
+-- False
+zip5P ::
+  Predicate a ->
+  Predicate b ->
+  Predicate c ->
+  Predicate d ->
+  Predicate e ->
+  Predicate (a, b, c, d, e)
+zip5P p1 p2 p3 p4 p5 =
+  Predicate
+    { showPredicate = show (p1, p2, p3, p4, p5),
+      accept = \(x1, x2, x3, x4, x5) ->
+        accept p1 x1 && accept p2 x2 && accept p3 x3 && accept p4 x4
+          && accept p5 x5
+    }
+
+-- | A 'Predicate' that accepts anything accepted by both of its children.
+--
+-- >>> accept (lt "foo" `andP` gt "bar") "eta"
+-- True
+-- >>> accept (lt "foo" `andP` gt "bar") "quz"
+-- False
+-- >>> accept (lt "foo" `andP` gt "bar") "alpha"
+-- False
+andP :: Predicate a -> Predicate a -> Predicate a
+p `andP` q =
+  Predicate
+    { showPredicate = showPredicate p ++ " and " ++ showPredicate q,
+      accept = \x -> accept p x && accept q x
+    }
+
+-- | A 'Predicate' that accepts anything accepted by either of its children.
+--
+-- >>> accept (lt "bar" `orP` gt "foo") "eta"
+-- False
+-- >>> accept (lt "bar" `orP` gt "foo") "quz"
+-- True
+-- >>> accept (lt "bar" `orP` gt "foo") "alpha"
+-- True
+orP :: Predicate a -> Predicate a -> Predicate a
+p `orP` q =
+  Predicate
+    { showPredicate = showPredicate p ++ " or " ++ showPredicate q,
+      accept = \x -> accept p x || accept q x
+    }
+
+-- | A 'Predicate' that inverts another 'Predicate', accepting whatever its
+-- child rejects, and rejecting whatever its child accepts.
+--
+-- >>> accept (notP (eq "negative")) "positive"
+-- True
+-- >>> accept (notP (eq "negative")) "negative"
+-- False
+notP :: Predicate a -> Predicate a
+notP p =
+  Predicate
+    { showPredicate = "not " ++ showPredicate p,
+      accept = not . accept p
+    }
+
+-- | A 'Predicate' that accepts sequences that start with the given prefix.
+--
+-- >>> accept (startsWith "fun") "fungible"
+-- True
+-- >>> accept (startsWith "gib") "fungible"
+-- False
+startsWith :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t
+startsWith pfx =
+  Predicate
+    { showPredicate = "starts with " ++ show pfx,
+      accept = (pfx `Seq.isPrefixOf`)
+    }
+
+-- | A 'Predicate' that accepts sequences that end with the given suffix.
+--
+-- >>> accept (endsWith "ow") "crossbow"
+-- True
+-- >>> accept (endsWith "ow") "trebuchet"
+-- False
+endsWith :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t
+endsWith sfx =
+  Predicate
+    { showPredicate = "ends with " ++ show sfx,
+      accept = (sfx `Seq.isSuffixOf`)
+    }
+
+-- | A 'Predicate' that accepts sequences that contain the given (consecutive)
+-- substring.
+--
+-- >>> accept (hasSubstr "i") "team"
+-- False
+-- >>> accept (hasSubstr "i") "partnership"
+-- True
+hasSubstr :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t
+hasSubstr s =
+  Predicate
+    { showPredicate = "has substring " ++ show s,
+      accept = (s `Seq.isInfixOf`)
+    }
+
+-- | A 'Predicate' that accepts sequences that contain the given (not
+-- necessarily consecutive) subsequence.
+--
+-- >>> accept (hasSubsequence [1..5]) [1, 2, 3, 4, 5]
+-- True
+-- >>> accept (hasSubsequence [1..5]) [0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0]
+-- True
+-- >>> accept (hasSubsequence [1..5]) [2, 3, 5, 7, 11]
+-- False
+hasSubsequence :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t
+hasSubsequence s =
+  Predicate
+    { showPredicate = "has subsequence " ++ show s,
+      accept = (s `isSubsequenceOf`)
+    }
+
+-- | Transforms a 'Predicate' on 'String's or string-like types to match without
+-- regard to case.
+--
+-- >>> accept (caseInsensitive startsWith "foo") "FOOTBALL!"
+-- True
+-- >>> accept (caseInsensitive endsWith "ball") "soccer"
+-- False
+-- >>> accept (caseInsensitive eq "time") "TIME"
+-- True
+-- >>> accept (caseInsensitive gt "NOTHING") "everything"
+-- False
+caseInsensitive ::
+  ( MonoFunctor t,
+    MonoFunctor a,
+    Element t ~ Char,
+    Element a ~ Char
+  ) =>
+  (t -> Predicate a) ->
+  (t -> Predicate a)
+caseInsensitive p s =
+  Predicate
+    { showPredicate = "(case insensitive) " ++ show (p s),
+      accept = accept capP . omap toUpper
+    }
+  where
+    capP = p (omap toUpper s)
+
+-- | A 'Predicate' that accepts 'String's or string-like values matching a
+-- regular expression.  The expression must match the entire argument.
+--
+-- You should not use @'caseInsensitive' 'matchesRegex'@, because regular
+-- expression syntax itself is still case-sensitive even when the text you are
+-- matching is not.  Instead, use 'matchesCaseInsensitiveRegex'.
+--
+-- >>> accept (matchesRegex "x{2,5}y?") "xxxy"
+-- True
+-- >>> accept (matchesRegex "x{2,5}y?") "xyy"
+-- False
+-- >>> accept (matchesRegex "x{2,5}y?") "wxxxyz"
+-- False
+matchesRegex :: (RegexLike Regex a, Eq a) => String -> Predicate a
+matchesRegex s =
+  Predicate
+    { showPredicate = "/" ++ init (tail $ show s) ++ "/",
+      accept = \x -> case matchOnceText r x of
+        Just (a, _, b) -> a == empty && b == empty
+        Nothing -> False
+    }
+  where
+    r = makeRegexOpts comp exec s :: Regex
+    comp = defaultCompOpt {newSyntax = True, lastStarGreedy = True}
+    exec = defaultExecOpt {captureGroups = False}
+
+-- | A 'Predicate' that accepts 'String's or string-like values matching a
+-- regular expression in a case-insensitive way.  The expression must match the
+-- entire argument.
+--
+-- You should use this instead of @'caseInsensitive' 'matchesRegex'@, because
+-- regular expression syntax itself is still case-sensitive even when the text
+-- you are matching is not.
+--
+-- >>> accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XXXY"
+-- True
+-- >>> accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XYY"
+-- False
+-- >>> accept (matchesCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ"
+-- False
+matchesCaseInsensitiveRegex ::
+  (RegexLike Regex a, Eq a) => String -> Predicate a
+matchesCaseInsensitiveRegex s =
+  Predicate
+    { showPredicate = "/" ++ init (tail $ show s) ++ "/i",
+      accept = \x -> case matchOnceText r x of
+        Just (a, _, b) -> a == empty && b == empty
+        Nothing -> False
+    }
+  where
+    r = makeRegexOpts comp exec s :: Regex
+    comp =
+      defaultCompOpt
+        { newSyntax = True,
+          lastStarGreedy = True,
+          caseSensitive = False
+        }
+    exec = defaultExecOpt {captureGroups = False}
+
+-- | A 'Predicate' that accepts 'String's or string-like values containing a
+-- match for a regular expression.  The expression need not match the entire
+-- argument.
+--
+-- You should not use @'caseInsensitive' 'containsRegex'@, because regular
+-- expression syntax itself is still case-sensitive even when the text you are
+-- matching is not.  Instead, use 'containsCaseInsensitiveRegex'.
+--
+-- >>> accept (containsRegex "x{2,5}y?") "xxxy"
+-- True
+-- >>> accept (containsRegex "x{2,5}y?") "xyy"
+-- False
+-- >>> accept (containsRegex "x{2,5}y?") "wxxxyz"
+-- True
+containsRegex :: (RegexLike Regex a, Eq a) => String -> Predicate a
+containsRegex s =
+  Predicate
+    { showPredicate = "contains /" ++ init (tail $ show s) ++ "/",
+      accept = isJust . matchOnce r
+    }
+  where
+    r = makeRegexOpts comp exec s :: Regex
+    comp = defaultCompOpt {newSyntax = True, lastStarGreedy = True}
+    exec = defaultExecOpt {captureGroups = False}
+
+-- | A 'Predicate' that accepts 'String's or string-like values containing a
+-- match for a regular expression in a case-insensitive way.  The expression
+-- need match the entire argument.
+--
+-- You should use this instead of @'caseInsensitive' 'containsRegex'@, because
+-- regular expression syntax itself is still case-sensitive even when the text
+-- you are matching is not.
+--
+-- >>> accept (containsCaseInsensitiveRegex "x{2,5}y?") "XXXY"
+-- True
+-- >>> accept (containsCaseInsensitiveRegex "x{2,5}y?") "XYY"
+-- False
+-- >>> accept (containsCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ"
+-- True
+containsCaseInsensitiveRegex ::
+  (RegexLike Regex a, Eq a) => String -> Predicate a
+containsCaseInsensitiveRegex s =
+  Predicate
+    { showPredicate = "contains /" ++ init (tail $ show s) ++ "/i",
+      accept = isJust . matchOnce r
+    }
+  where
+    r = makeRegexOpts comp exec s :: Regex
+    comp =
+      defaultCompOpt
+        { newSyntax = True,
+          lastStarGreedy = True,
+          caseSensitive = False
+        }
+    exec = defaultExecOpt {captureGroups = False}
+
+-- | A 'Predicate' that accepts empty data structures.
+--
+-- >>> accept isEmpty []
+-- True
+-- >>> accept isEmpty [1, 2, 3]
+-- False
+-- >>> accept isEmpty ""
+-- True
+-- >>> accept isEmpty "gas tank"
+-- False
+isEmpty :: MonoFoldable t => Predicate t
+isEmpty =
+  Predicate
+    { showPredicate = "empty",
+      accept = onull
+    }
+
+-- | A 'Predicate' that accepts non-empty data structures.
+--
+-- >>> accept nonEmpty []
+-- False
+-- >>> accept nonEmpty [1, 2, 3]
+-- True
+-- >>> accept nonEmpty ""
+-- False
+-- >>> accept nonEmpty "gas tank"
+-- True
+nonEmpty :: MonoFoldable t => Predicate t
+nonEmpty =
+  Predicate
+    { showPredicate = "nonempty",
+      accept = not . onull
+    }
+
+-- | A 'Predicate' that accepts data structures whose number of elements match
+-- the child 'Predicate'.
+--
+-- >>> accept (sizeIs (lt 3)) ['a' .. 'f']
+-- False
+-- >>> accept (sizeIs (lt 3)) ['a' .. 'b']
+-- True
+sizeIs :: MonoFoldable t => Predicate Int -> Predicate t
+sizeIs p =
+  Predicate
+    { showPredicate = "size " ++ showPredicate p,
+      accept = accept p . olength
+    }
+
+-- | A 'Predicate' that accepts data structures whose contents each match the
+-- corresponding 'Predicate' in the given list, in the same order.
+--
+-- >>> accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4]
+-- True
+-- >>> accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4, 5]
+-- False
+-- >>> accept (elemsAre [lt 3, lt 4, lt 5]) [2, 10, 4]
+-- False
+elemsAre :: MonoFoldable t => [Predicate (Element t)] -> Predicate t
+elemsAre ps =
+  Predicate
+    { showPredicate = show ps,
+      accept = \xs ->
+        olength xs == olength ps
+          && and (zipWith accept ps (otoList xs))
+    }
+
+-- | A 'Predicate' that accepts data structures whose contents each match the
+-- corresponding 'Predicate' in the given list, in any order.
+--
+-- >>> accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3]
+-- True
+-- >>> accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [2, 3, 1]
+-- True
+-- >>> accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3, 4]
+-- False
+-- >>> accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 3]
+-- False
+unorderedElemsAre :: MonoFoldable t => [Predicate (Element t)] -> Predicate t
+unorderedElemsAre ps =
+  Predicate
+    { showPredicate =
+        "(any order) " ++ show ps,
+      accept = matches ps . otoList
+    }
+  where
+    matches (q : qs) xs = or [matches qs ys | (y, ys) <- choices xs, accept q y]
+    matches [] xs = null xs
+
+-- | A 'Predicate' that accepts data structures whose elements each match the
+-- child 'Predicate'.
+--
+-- >>> accept (each (gt 5)) [4, 5, 6]
+-- False
+-- >>> accept (each (gt 5)) [6, 7, 8]
+-- True
+-- >>> accept (each (gt 5)) []
+-- True
+each :: MonoFoldable t => Predicate (Element t) -> Predicate t
+each p =
+  Predicate
+    { showPredicate = "each (" ++ showPredicate p ++ ")",
+      accept = oall (accept p)
+    }
+
+-- | A 'Predicate' that accepts data structures which contain at least one
+-- element matching the child 'Predicate'.
+--
+-- >>> accept (contains (gt 5)) [3, 4, 5]
+-- False
+-- >>> accept (contains (gt 5)) [4, 5, 6]
+-- True
+-- >>> accept (contains (gt 5)) []
+-- False
+contains :: MonoFoldable t => Predicate (Element t) -> Predicate t
+contains p =
+  Predicate
+    { showPredicate = "contains (" ++ showPredicate p ++ ")",
+      accept = oany (accept p)
+    }
+
+-- | A 'Predicate' that accepts data structures which contain an element
+-- satisfying each of the child predicates.  @'containsAll' [p1, p2, ..., pn]@
+-- is equivalent to @'contains' p1 `'andP'` 'contains' p2 `'andP'` ... `'andP'`
+-- 'contains' pn@.
+--
+-- >>> accept (containsAll [eq "foo", eq "bar"]) ["bar", "foo"]
+-- True
+-- >>> accept (containsAll [eq "foo", eq "bar"]) ["foo"]
+-- False
+-- >>> accept (containsAll [eq "foo", eq "bar"]) ["foo", "bar", "qux"]
+-- True
+containsAll :: MonoFoldable t => [Predicate (Element t)] -> Predicate t
+containsAll ps =
+  Predicate
+    { showPredicate = "contains all of " ++ show ps,
+      accept = \xs -> all (flip oany xs . accept) ps
+    }
+
+-- | A 'Predicate' that accepts data structures whose elements all satisfy at
+-- least one of the child predicates.  @'containsOnly' [p1, p2, ..., pn]@ is
+-- equivalent to @'each' (p1 `'orP'` p2 `'orP'` ... `'orP'` pn)@.
+--
+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "foo"]
+-- True
+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "bar"]
+-- True
+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "qux"]
+-- False
+containsOnly :: MonoFoldable t => [Predicate (Element t)] -> Predicate t
+containsOnly ps =
+  Predicate
+    { showPredicate = "contains only " ++ show ps,
+      accept = oall (\x -> any (`accept` x) ps)
+    }
+
+-- | A 'Predicate' that accepts map-like structures which contain a key matching
+-- the child 'Predicate'.
+--
+-- >>> accept (containsKey (eq "foo")) [("foo", 1), ("bar", 2)]
+-- True
+-- >>> accept (containsKey (eq "foo")) [("bar", 1), ("qux", 2)]
+-- False
+containsKey :: (IsList t, Item t ~ (k, v)) => Predicate k -> Predicate t
+containsKey p =
+  Predicate
+    { showPredicate = "contains key " ++ show p,
+      accept = \m -> any (accept p) (fst <$> toList m)
+    }
+
+-- | A 'Predicate' that accepts map-like structures which contain a key/value
+-- pair matched by the given child 'Predicate's (one for the key, and one for
+-- the value).
+--
+-- >>> accept (containsEntry (eq "foo") (gt 10)) [("foo", 12), ("bar", 5)]
+-- True
+-- >>> accept (containsEntry (eq "foo") (gt 10)) [("foo", 5), ("bar", 12)]
+-- False
+-- >>> accept (containsEntry (eq "foo") (gt 10)) [("bar", 12)]
+-- False
+containsEntry ::
+  (IsList t, Item t ~ (k, v)) => Predicate k -> Predicate v -> Predicate t
+containsEntry p q =
+  Predicate
+    { showPredicate = "contains entry " ++ show (p, q),
+      accept = any (\(x, y) -> accept p x && accept q y) . toList
+    }
+
+-- | A 'Predicate' that accepts map-like structures whose keys are exactly those
+-- matched by the given list of 'Predicates', in any order.
+--
+-- >>> accept (keysAre [eq "a", eq "b", eq "c"]) [("a", 1), ("b", 2), ("c", 3)]
+-- True
+-- >>> accept (keysAre [eq "a", eq "b", eq "c"]) [("c", 1), ("b", 2), ("a", 3)]
+-- True
+-- >>> accept (keysAre [eq "a", eq "b", eq "c"]) [("a", 1), ("c", 3)]
+-- False
+-- >>> accept (keysAre [eq "a", eq "b"]) [("a", 1), ("b", 2), ("c", 3)]
+-- False
+keysAre ::
+  (IsList t, Item t ~ (k, v)) => [Predicate k] -> Predicate t
+keysAre ps =
+  Predicate
+    { showPredicate = "keys are " ++ show ps,
+      accept = matches ps . map fst . toList
+    }
+  where
+    matches (q : qs) xs = or [matches qs ys | (y, ys) <- choices xs, accept q y]
+    matches [] xs = null xs
+
+-- | A 'Predicate' that accepts map-like structures whose entries are exactly
+-- those matched by the given list of 'Predicate' pairs, in any order.
+--
+-- >>> accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(1, 2), (3, 4)]
+-- True
+-- >>> accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(3, 4), (1, 2)]
+-- True
+-- >>> accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(1, 4), (3, 2)]
+-- False
+-- >>> accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(1, 2), (3, 4), (5, 6)]
+-- False
+entriesAre ::
+  (IsList t, Item t ~ (k, v)) => [(Predicate k, Predicate v)] -> Predicate t
+entriesAre ps =
+  Predicate
+    { showPredicate = "entries are " ++ show ps,
+      accept = matches ps . toList
+    }
+  where
+    matches ((p, q) : pqs) xs =
+      or [matches pqs ys | ((k, v), ys) <- choices xs, accept p k, accept q v]
+    matches [] xs = null xs
+
+-- | A 'Predicate' that accepts values of 'RealFloat' types that are close to
+-- the given number.  The expected precision is scaled based on the target
+-- value, so that reasonable rounding error is accepted but grossly inaccurate
+-- results are not.
+--
+-- The following naive use of 'eq' fails due to rounding:
+--
+-- >>> accept (eq 1.0) (sum (replicate 100 0.01))
+-- False
+--
+-- The solution is to use 'approxEq', which accounts for rounding error.
+-- However, 'approxEq' doesn't accept results that are far enough off that they
+-- likely arise from incorrect calculations instead of rounding error.
+--
+-- >>> accept (approxEq 1.0) (sum (replicate 100 0.01))
+-- True
+-- >>> accept (approxEq 1.0) (sum (replicate 100 0.009999))
+-- False
+approxEq :: (RealFloat a, Show a) => a -> Predicate a
+approxEq x =
+  Predicate
+    { showPredicate = "≈ " ++ show x,
+      accept = \y -> abs (x - y) < diff
+    }
+  where
+    diff = encodeFloat 1 (snd (decodeFloat x) + floatDigits x `div` 2)
+
+-- | A 'Predicate' that accepts finite numbers of any 'RealFloat' type.
+--
+-- >>> accept finite 1.0
+-- True
+-- >>> accept finite (0 / 0)
+-- False
+-- >>> accept finite (1 / 0)
+-- False
+finite :: RealFloat a => Predicate a
+finite =
+  Predicate
+    { showPredicate = "finite",
+      accept = \x -> not (isInfinite x) && not (isNaN x)
+    }
+
+-- | A 'Predicate' that accepts infinite numbers of any 'RealFloat' type.
+--
+-- >>> accept infinite 1.0
+-- False
+-- >>> accept infinite (0 / 0)
+-- False
+-- >>> accept infinite (1 / 0)
+-- True
+infinite :: RealFloat a => Predicate a
+infinite =
+  Predicate
+    { showPredicate = "infinite",
+      accept = isInfinite
+    }
+
+-- | A 'Predicate' that accepts NaN values of any 'RealFloat' type.
+--
+-- >>> accept nAn 1.0
+-- False
+-- >>> accept nAn (0 / 0)
+-- True
+-- >>> accept nAn (1 / 0)
+-- False
+nAn :: RealFloat a => Predicate a
+nAn =
+  Predicate
+    { showPredicate = "NaN",
+      accept = isNaN
+    }
+
+-- | A conversion from @a -> 'Bool'@ to 'Predicate'.  This is a fallback that
+-- can be used to build a 'Predicate' that checks anything at all.  However, its
+-- description will be less helpful than standard 'Predicate's.
+--
+-- >>> accept (is even) 3
+-- False
+-- >>> accept (is even) 4
+-- True
+is :: HasCallStack => (a -> Bool) -> Predicate a
+is f =
+  Predicate
+    { showPredicate = withLoc (locate callStack "custom predicate"),
+      accept = f
+    }
+
+-- | A Template Haskell splice that acts like 'is', but receives a quoted
+-- expression at compile time and has a more helpful description for error
+-- messages.
+--
+-- >>> accept $(qIs [| even |]) 3
+-- False
+-- >>> accept $(qIs [| even |]) 4
+-- True
+--
+-- >>> show $(qIs [| even |])
+-- "even"
+qIs :: HasCallStack => ExpQ -> ExpQ
+qIs f =
+  [|
+    Predicate
+      { showPredicate = $(lift . pprint . removeModNames =<< f),
+        accept = $f
+      }
+    |]
+
+-- | A combinator to lift a 'Predicate' to work on a property or computed value
+-- of the original value.
+--
+-- >>> accept (with abs (gt 5)) (-6)
+-- True
+-- >>> accept (with abs (gt 5)) (-5)
+-- False
+-- >>> accept (with reverse (eq "olleh")) "hello"
+-- True
+-- >>> accept (with reverse (eq "olleh")) "goodbye"
+-- False
+with :: HasCallStack => (a -> b) -> Predicate b -> Predicate a
+with f p =
+  Predicate
+    { showPredicate =
+        withLoc (locate callStack "property") ++ ": " ++ show p,
+      accept = accept p . f
+    }
+
+-- | A Template Haskell splice that acts like 'is', but receives a quoted typed
+-- expression at compile time and has a more helpful description for error
+-- messages.
+--
+-- >>> accept ($(qWith [| abs |]) (gt 5)) (-6)
+-- True
+-- >>> accept ($(qWith [| abs |]) (gt 5)) (-5)
+-- False
+-- >>> accept ($(qWith [| reverse |]) (eq "olleh")) "hello"
+-- True
+-- >>> accept ($(qWith [| reverse |]) (eq "olleh")) "goodbye"
+-- False
+--
+-- >>> show ($(qWith [| abs |]) (gt 5))
+-- "abs: > 5"
+qWith :: ExpQ -> ExpQ
+qWith f =
+  [|
+    \p ->
+      Predicate
+        { showPredicate =
+            $(lift . pprint . removeModNames =<< f) ++ ": " ++ show p,
+          accept = accept p . $f
+        }
+    |]
+
+-- | A Template Haskell splice that turns a quoted pattern into a predicate that
+-- accepts values that match the pattern.
+--
+-- >>> accept $(qMatch [p| Just (Left _) |]) Nothing
+-- False
+-- >>> accept $(qMatch [p| Just (Left _) |]) (Just (Left 5))
+-- True
+-- >>> accept $(qMatch [p| Just (Left _) |]) (Just (Right 5))
+-- False
+--
+-- >>> show $(qMatch [p| Just (Left _) |])
+-- "Just (Left _)"
+qMatch :: PatQ -> ExpQ
+qMatch qpat =
+  [|
+    Predicate
+      { showPredicate = $(lift . pprint . removeModNames =<< qpat),
+        accept = \case
+          $(qpat) -> True
+          _ -> False
+      }
+    |]
+
+-- | Converts a 'Predicate' to a new type.  Typically used with visible type
+-- application, as in the examples below.
+--
+-- >>> accept (typed @String anything) "foo"
+-- True
+-- >>> accept (typed @String (sizeIs (gt 5))) "foo"
+-- False
+-- >>> accept (typed @String anything) (42 :: Int)
+-- False
+typed :: forall a b. (Typeable a, Typeable b) => Predicate a -> Predicate b
+typed p =
+  Predicate
+    { showPredicate =
+        showPredicate p ++ " :: " ++ show (typeRep (Proxy :: Proxy a)),
+      accept = \x -> case cast x of
+        Nothing -> False
+        Just y -> accept p y
+    }
diff --git a/src/Test/HMock/Internal/TH.hs b/src/Test/HMock/Internal/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/TH.hs
@@ -0,0 +1,697 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+module Test.HMock.Internal.TH
+  ( MockableOptions (..),
+    makeMockable,
+    makeMockableType,
+    makeMockableWithOptions,
+    makeMockableTypeWithOptions,
+    makeMockableBase,
+    makeMockableBaseType,
+    makeMockableBaseWithOptions,
+    makeMockableBaseTypeWithOptions,
+    deriveMockable,
+    deriveMockableType,
+    deriveMockableWithOptions,
+    deriveMockableTypeWithOptions,
+    deriveMockableBase,
+    deriveMockableBaseType,
+    deriveMockableBaseWithOptions,
+    deriveMockableBaseTypeWithOptions,
+    deriveForMockT,
+    deriveTypeForMockT,
+    deriveForMockTWithOptions,
+    deriveTypeForMockTWithOptions,
+  )
+where
+
+import Control.Monad (replicateM, unless, when, zipWithM)
+import Control.Monad.Extra (concatMapM)
+import Control.Monad.Trans (MonadIO)
+import Data.Bool (bool)
+import Data.Char (toUpper)
+import Data.Default (Default (..))
+import Data.Either (partitionEithers)
+import qualified Data.Kind
+import Data.List (foldl', (\\))
+import Data.Typeable (Typeable)
+import GHC.Stack (HasCallStack)
+import GHC.TypeLits (Symbol)
+import Language.Haskell.TH hiding (Match, match)
+import Language.Haskell.TH.Syntax (Lift (lift))
+import Test.HMock
+import Test.HMock.Internal.TH.Util
+
+-- | Custom options for deriving a 'Mockable' class.
+data MockableOptions = MockableOptions
+  { -- | Suffix to add to 'Action' and 'Matcher' names.  Defaults to @""@.
+    mockSuffix :: String,
+    -- | Whether to warn about limitations of the generated mocks.  This is
+    -- mostly useful temporarily for finding out why generated code doesn't
+    -- match your expectations.  Defaults to @'False'@.
+    mockVerbose :: Bool
+  }
+
+instance Default MockableOptions where
+  def = MockableOptions {mockSuffix = "", mockVerbose = False}
+
+-- | Define all instances necessary to use HMock with the given class.
+-- Equivalent to both 'deriveMockable' and 'deriveForMockT'.
+--
+-- If @MyClass@ is a class and @myMethod@ is one of its methods, then
+-- @'makeMockable' MyClass@ generates all of the following:
+--
+-- If @MyClass@ is a class and @myMethod@ is one of its methods, then
+-- @'makeMockable' MyClass@ generates everything generated by
+-- 'makeMockableBase', as well as a 'Mockable' instance that does no setup.
+makeMockable :: Name -> Q [Dec]
+makeMockable = makeMockableType . conT
+
+-- | Define all instances necessary to use HMock with the given constraint type,
+-- which should be a class applied to zero or more type arguments.  Equivalent
+-- to both 'deriveMockableType' and 'deriveTypeForMockT'.
+--
+-- See 'makeMockable' for a list of what is generated by this splice.
+makeMockableType :: Q Type -> Q [Dec]
+makeMockableType = makeMockableTypeWithOptions def
+
+-- | Define all instances necessary to use HMock with the given class.  This is
+-- like 'makeMockable', but with the ability to specify custom options.
+--
+-- See 'makeMockable' for a list of what is generated by this splice.
+makeMockableWithOptions :: MockableOptions -> Name -> Q [Dec]
+makeMockableWithOptions options = makeMockableTypeWithOptions options . conT
+
+-- | Define all instances necessary to use HMock with the given constraint type,
+-- which should be a class applied to zero or more type arguments.  This is
+-- like 'makeMockableType', but with the ability to specify custom options.
+--
+-- See 'makeMockable' for a list of what is generated by this splice.
+makeMockableTypeWithOptions :: MockableOptions -> Q Type -> Q [Dec]
+makeMockableTypeWithOptions options qt =
+  (++) <$> deriveMockableTypeWithOptions options qt
+    <*> deriveTypeForMockTWithOptions options qt
+
+-- | Defines almost all instances necessary to use HMock with the given class.
+-- Equivalent to both 'deriveMockableBase' and 'deriveForMockT'.
+makeMockableBase :: Name -> Q [Dec]
+makeMockableBase = makeMockableBaseType . conT
+
+-- | Defines almost all instances necessary to use HMock with the given
+-- constraint type, which should be a class applied to zero or more type
+-- arguments.  Equivalent to both 'deriveMockableBaseType' and
+-- 'deriveTypeForMockT'.
+makeMockableBaseType :: Q Type -> Q [Dec]
+makeMockableBaseType = makeMockableBaseTypeWithOptions def
+
+-- | Defines almost all instances necessary to use HMock with the given class.
+-- This is like 'makeMockable', but with the ability to specify custom options.
+makeMockableBaseWithOptions :: MockableOptions -> Name -> Q [Dec]
+makeMockableBaseWithOptions options =
+  makeMockableBaseTypeWithOptions options . conT
+
+-- | Defines almost all instances necessary to use HMock with the given
+-- constraint type, which should be a class applied to zero or more type
+-- arguments.  This is like 'makeMockableType', but with the ability to specify
+-- custom options.
+makeMockableBaseTypeWithOptions :: MockableOptions -> Q Type -> Q [Dec]
+makeMockableBaseTypeWithOptions options qt =
+  (++) <$> deriveMockableBaseTypeWithOptions options qt
+    <*> deriveTypeForMockTWithOptions options qt
+
+-- | Defines the 'Mockable' instance for the given class.
+--
+-- If @MyClass@ is a class and @myMethod@ is one of its methods, then
+-- @'deriveMockable' MyClass@ generates everything generated by
+-- 'makeMockableBase', as well as a 'Mockable' instance that does no setup.
+deriveMockable :: Name -> Q [Dec]
+deriveMockable = deriveMockableType . conT
+
+-- | Defines the 'Mockable' instance for the given constraint type, which should
+-- be a class applied to zero or more type arguments.
+--
+-- See 'deriveMockable' for a list of what is generated by this splice.
+deriveMockableType :: Q Type -> Q [Dec]
+deriveMockableType = deriveMockableTypeWithOptions def
+
+-- | Defines the 'Mockable' instance for the given class.  This is like
+-- 'deriveMockable', but with the ability to specify custom options.
+--
+-- See 'deriveMockable' for a list of what is generated by this splice.
+deriveMockableWithOptions :: MockableOptions -> Name -> Q [Dec]
+deriveMockableWithOptions options = deriveMockableTypeWithOptions options . conT
+
+-- | Defines the 'Mockable' instance for the given constraint type, which should
+-- be a class applied to zero or more type arguments.  This is like
+-- 'deriveMockableType', but with the ability to specify custom options.
+--
+-- See 'deriveMockable' for a list of what is generated by this splice.
+deriveMockableTypeWithOptions :: MockableOptions -> Q Type -> Q [Dec]
+deriveMockableTypeWithOptions = deriveMockableImpl False
+
+-- | Defines the 'MockableBase' instance for the given class.
+--
+-- If @MyClass@ is a class and @myMethod@ is one of its methods, then
+-- @'deriveMockableBase' MyClass@ generates all of the following:
+--
+-- * A @'MockableBase' MyClass@ instance.
+-- * An associated type @'Action' MyClass@, with a constructor @MyMethod@.
+-- * An associated type @'Matcher' MyClass@, with a constructor @MyMethod_@.
+-- * An 'Expectable' instance for @'Action' MyClass@ which matches an exact set
+--   of arguments, if and only if all of @myMethod@'s arguments have 'Eq' and
+--   'Show' instances.
+deriveMockableBase :: Name -> Q [Dec]
+deriveMockableBase = deriveMockableBaseType . conT
+
+-- | Defines the 'MockableBase' instance for the given constraint type, which
+-- should be a class applied to zero or more type arguments.
+--
+-- See 'deriveMockableBase' for a list of what is generated by this splice.
+deriveMockableBaseType :: Q Type -> Q [Dec]
+deriveMockableBaseType = deriveMockableBaseTypeWithOptions def
+
+-- | Defines the 'MockableBase' instance for the given class.  This is like
+-- 'deriveMockableBase', but with the ability to specify custom options.
+--
+-- See 'deriveMockableBase' for a list of what is generated by this splice.
+deriveMockableBaseWithOptions :: MockableOptions -> Name -> Q [Dec]
+deriveMockableBaseWithOptions options =
+  deriveMockableBaseTypeWithOptions options . conT
+
+-- | Defines the 'MockableBase' instance for the given constraint type, which
+-- should be a class applied to zero or more type arguments.  This is like
+-- 'deriveMockableBaseType', but with the ability to specify custom options.
+--
+-- See 'deriveMockableBase' for a list of what is generated by this splice.
+deriveMockableBaseTypeWithOptions :: MockableOptions -> Q Type -> Q [Dec]
+deriveMockableBaseTypeWithOptions = deriveMockableImpl True
+
+-- | Defines an instance of the given class for @'MockT' m@, delegating all of
+-- its methods to 'mockMethod' to be handled by HMock.
+--
+-- This may only be used if all members of the class are mockable methods.  If
+-- the class contains some unmockable methods, associated types, or other
+-- members, you will need to define this instance yourself, delegating the
+-- mockable methods as follows:
+--
+-- @
+-- instance MyClass ('MockT' m) where
+--   myMethod x y = 'mockMethod' (MyMethod x y)
+--   ...
+-- @
+deriveForMockT :: Name -> Q [Dec]
+deriveForMockT = deriveTypeForMockT . conT
+
+-- | Defines an instance of the given constraint type for @'MockT' m@,
+-- delegating all of its methods to 'mockMethod' to be handled by HMock.
+-- The type should be a class applied to zero or more type arguments.
+--
+-- See 'deriveForMockT' for restrictions on the use of this splice.
+deriveTypeForMockT :: Q Type -> Q [Dec]
+deriveTypeForMockT = deriveTypeForMockTWithOptions def
+
+-- | Defines an instance of the given class for @'MockT' m@, delegating all of
+-- its methods to 'mockMethod' to be handled by HMock.  This is like
+-- 'deriveForMockT', but with the ability to specify custom options.
+--
+-- See 'deriveForMockT' for restrictions on the use of this splice.
+deriveForMockTWithOptions :: MockableOptions -> Name -> Q [Dec]
+deriveForMockTWithOptions options = deriveTypeForMockTWithOptions options . conT
+
+-- | Defines an instance of the given constraint type for @'MockT' m@,
+-- delegating all of its methods to 'mockMethod' to be handled by HMock.
+-- The type should be a class applied to zero or more type arguments.  This is
+-- like 'deriveTypeForMockT', but with the ability to specify custom options.
+--
+-- See 'deriveForMockT' for restrictions on the use of this splice.
+deriveTypeForMockTWithOptions :: MockableOptions -> Q Type -> Q [Dec]
+deriveTypeForMockTWithOptions = deriveForMockTImpl
+
+data Instance = Instance
+  { instType :: Type,
+    instRequiredContext :: Cxt,
+    instGeneralParams :: [Name],
+    instMonadVar :: Name,
+    instMethods :: [Method],
+    instExtraMembers :: [Dec]
+  }
+  deriving (Show)
+
+data Method = Method
+  { methodName :: Name,
+    methodTyVars :: [Name],
+    methodCxt :: Cxt,
+    methodArgs :: [Type],
+    methodResult :: Type
+  }
+  deriving (Show)
+
+withClass :: Type -> (Dec -> Q a) -> Q a
+withClass t f = do
+  case unappliedName t of
+    Just cls -> do
+      info <- reify cls
+      case info of
+        ClassI dec@ClassD {} _ -> f dec
+        _ -> fail $ "Expected " ++ show cls ++ " to be a class, but it wasn't."
+    _ -> fail "Expected a class, but got something else."
+
+getInstance :: MockableOptions -> Type -> Q Instance
+getInstance options ty = withClass ty go
+  where
+    go (ClassD _ className [] _ _) =
+      fail $ "Class " ++ nameBase className ++ " has no type parameters."
+    go (ClassD cx _ params _ members) = matchVars ty [] (tvName <$> params)
+      where
+        matchVars :: Type -> [Type] -> [Name] -> Q Instance
+        matchVars _ _ [] = internalError
+        matchVars (AppT _ _) _ [_] =
+          fail $ pprint ty ++ " is applied to too many arguments."
+        matchVars (AppT a b) ts (_ : ps) =
+          checkExt FlexibleInstances >> matchVars a (b : ts) ps
+        matchVars _ ts ps = do
+          let t = foldl' (\t' v -> AppT t' (VarT v)) ty (init ps)
+          let tbl = zip (tvName <$> params) ts
+          let cx' = substTypeVars tbl <$> cx
+          makeInstance options t cx' tbl (init ps) (last ps) members
+    go _ = internalError
+
+makeInstance ::
+  MockableOptions ->
+  Type ->
+  Cxt ->
+  [(Name, Type)] ->
+  [Name] ->
+  Name ->
+  [Dec] ->
+  Q Instance
+makeInstance options ty cx tbl ps m members = do
+  processedMembers <- mapM (getMethod ty m tbl) members
+  (extraMembers, methods) <-
+    partitionEithers <$> zipWithM memberOrMethod members processedMembers
+  return $
+    Instance
+      { instType = ty,
+        instRequiredContext = cx,
+        instGeneralParams = ps,
+        instMonadVar = m,
+        instMethods = methods,
+        instExtraMembers = extraMembers
+      }
+  where
+    memberOrMethod :: Dec -> Either String Method -> Q (Either Dec Method)
+    memberOrMethod dec (Left warning) = do
+      when (mockVerbose options) $ reportWarning warning
+      return (Left dec)
+    memberOrMethod _ (Right method) = return (Right method)
+
+getMethod :: Type -> Name -> [(Name, Type)] -> Dec -> Q (Either String Method)
+getMethod instTy m tbl (SigD name ty) = do
+  simpleTy <- localizeMember instTy m (substTypeVars tbl ty)
+  return $ do
+    let (tvs, cx, argsAndReturn) = splitType simpleTy
+    (m', result) <- case last argsAndReturn of
+      AppT (VarT m') result -> return (m', result)
+      _ ->
+        Left $
+          nameBase name
+            ++ " can't be mocked: non-monadic result."
+    when (m' /= m) $
+      Left $
+        nameBase name
+          ++ " can't be mocked: return value in wrong monad."
+    when (relevantContext result (tvs, cx) /= ([], [])) $
+      Left $
+        nameBase name
+          ++ " can't be mocked: polymorphic return value."
+    let argTypes =
+          map
+            (substTypeVar m (AppT (ConT ''MockT) (VarT m)))
+            (init argsAndReturn)
+    when (any hasNestedPolyType argTypes) $
+      Left $
+        nameBase name
+          ++ " can't be mocked: rank-n types nested in arguments."
+    return $
+      Method
+        { methodName = name,
+          methodTyVars = tvs,
+          methodCxt = cx,
+          methodArgs = argTypes,
+          methodResult = result
+        }
+getMethod _ _ _ _ = return (Left "A non-value member cannot be mocked.")
+
+isKnownType :: Method -> Type -> Bool
+isKnownType method ty = null tyVars && null cx
+  where
+    (tyVars, cx) =
+      relevantContext ty (methodTyVars method, methodCxt method)
+
+withMethodParams :: Instance -> Method -> TypeQ -> TypeQ
+withMethodParams inst method t =
+  [t|
+    $t
+      $(pure (instType inst))
+      $(litT (strTyLit (nameBase (methodName method))))
+      $(varT (instMonadVar inst))
+      $(pure (methodResult method))
+    |]
+
+deriveMockableImpl :: Bool -> MockableOptions -> Q Type -> Q [Dec]
+deriveMockableImpl baseOnly options qt = do
+  checkExt DataKinds
+  checkExt FlexibleInstances
+  checkExt GADTs
+  checkExt MultiParamTypeClasses
+  checkExt TypeFamilies
+
+  inst <- getInstance options =<< qt
+
+  when (null (instMethods inst)) $ do
+    fail $
+      "Cannot derive Mockable because " ++ pprint (instType inst)
+        ++ " has no mockable methods."
+
+  typeableCxts <- constrainVars [conT ''Typeable] (instGeneralParams inst)
+
+  mockableBase <-
+    instanceD
+      (pure typeableCxts)
+      [t|MockableBase $(pure (instType inst))|]
+      [ defineActionType options inst,
+        defineMatcherType options inst,
+        defineShowAction options (instMethods inst),
+        defineShowMatcher options (instMethods inst),
+        defineMatchAction options (instMethods inst)
+      ]
+  mockable <-
+    if baseOnly
+      then return []
+      else
+        (: [])
+          <$> instanceD
+            (pure typeableCxts)
+            [t|Mockable $(pure (instType inst))|]
+            []
+  expectables <- defineExpectableActions options inst
+
+  return $ mockableBase : mockable ++ expectables
+
+defineActionType :: MockableOptions -> Instance -> DecQ
+defineActionType options inst = do
+  kind <-
+    [t|
+      Symbol ->
+      (Data.Kind.Type -> Data.Kind.Type) ->
+      Data.Kind.Type ->
+      Data.Kind.Type
+      |]
+  let cons = actionConstructor options inst <$> instMethods inst
+  dataInstD (pure []) ''Action [pure (instType inst)] (Just kind) cons []
+
+actionConstructor :: MockableOptions -> Instance -> Method -> ConQ
+actionConstructor options inst method = do
+  forallC [] (return (methodCxt method)) $
+    gadtC
+      [getActionName options method]
+      [ return (Bang NoSourceUnpackedness NoSourceStrictness, argTy)
+        | argTy <- methodArgs method
+      ]
+      (withMethodParams inst method [t|Action|])
+
+getActionName :: MockableOptions -> Method -> Name
+getActionName options method =
+  mkName (map toUpper (take 1 name) ++ drop 1 name ++ mockSuffix options)
+  where
+    name = nameBase (methodName method)
+
+defineMatcherType :: MockableOptions -> Instance -> Q Dec
+defineMatcherType options inst = do
+  kind <-
+    [t|
+      Symbol ->
+      (Data.Kind.Type -> Data.Kind.Type) ->
+      Data.Kind.Type ->
+      Data.Kind.Type
+      |]
+  let cons = matcherConstructor options inst <$> instMethods inst
+  dataInstD (pure []) ''Matcher [pure (instType inst)] (Just kind) cons []
+
+matcherConstructor :: MockableOptions -> Instance -> Method -> ConQ
+matcherConstructor options inst method = do
+  gadtC
+    [getMatcherName options method]
+    [ (Bang NoSourceUnpackedness NoSourceStrictness,) <$> mkPredicate argTy
+      | argTy <- methodArgs method
+    ]
+    (withMethodParams inst method [t|Matcher|])
+  where
+    mkPredicate argTy
+      | hasPolyType argTy = do
+        checkExt RankNTypes
+        v <- newName "t"
+        forallT [bindVar v] (pure []) [t|Predicate $(varT v)|]
+      | null tyVars && null cx = [t|Predicate $(pure argTy)|]
+      | otherwise = do
+        checkExt RankNTypes
+        forallT (bindVar <$> tyVars) (pure cx) [t|Predicate $(pure argTy)|]
+      where
+        (tyVars, cx) =
+          relevantContext argTy (methodTyVars method, methodCxt method)
+
+getMatcherName :: MockableOptions -> Method -> Name
+getMatcherName options method =
+  mkName (map toUpper (take 1 name) ++ drop 1 name ++ mockSuffix options ++ "_")
+  where
+    name = nameBase (methodName method)
+
+defineShowAction :: MockableOptions -> [Method] -> Q Dec
+defineShowAction options methods =
+  funD 'showAction (showActionClause options <$> methods)
+
+showActionClause :: MockableOptions -> Method -> Q Clause
+showActionClause options method = do
+  argVars <- replicateM (length (methodArgs method)) (newName "a")
+  clause
+    [ conP
+        (getActionName options method)
+        (zipWith argPattern (methodArgs method) argVars)
+    ]
+    ( normalB
+        [|
+          unwords
+            ( $(lift (nameBase (methodName method))) :
+              $(listE (zipWith showArg (methodArgs method) argVars))
+            )
+          |]
+    )
+    []
+  where
+    canShow ty
+      | not (null (freeTypeVars ty)) = return False
+      | otherwise = isInstance ''Show [ty]
+    argPattern ty v = canShow ty >>= bool wildP (varP v)
+    showArg ty var =
+      canShow ty
+        >>= bool
+          (lift ("(_ :: " ++ pprint (removeModNames ty) ++ ")"))
+          [|showsPrec 11 $(varE var) ""|]
+
+defineShowMatcher :: MockableOptions -> [Method] -> Q Dec
+defineShowMatcher options methods = do
+  clauses <- concatMapM (showMatcherClauses options) methods
+  funD 'showMatcher clauses
+
+showMatcherClauses :: MockableOptions -> Method -> Q [ClauseQ]
+showMatcherClauses options method = do
+  argTVars <- replicateM (length (methodArgs method)) (newName "t")
+  predVars <- replicateM (length (methodArgs method)) (newName "p")
+  let actionArgs = zipWith actionArg argTVars (methodArgs method)
+  let matcherArgs = varP <$> predVars
+  let printedArgs = zipWith3 printedArg predVars argTVars (methodArgs method)
+  let polyMatcherArgs = zipWith matcherArg predVars (methodArgs method)
+  let printedPolyArgs = zipWith printedPolyArg predVars (methodArgs method)
+  let body name args = normalB [|unwords ($(lift name) : $(listE args))|]
+  return
+    [ clause
+        [ conP 'Just [conP (getActionName options method) actionArgs],
+          conP (getMatcherName options method) matcherArgs
+        ]
+        (body (nameBase (methodName method)) printedArgs)
+        [],
+      clause
+        [ conP 'Nothing [],
+          conP (getMatcherName options method) polyMatcherArgs
+        ]
+        (body (nameBase (methodName method)) printedPolyArgs)
+        []
+    ]
+  where
+    actionArg t ty
+      | isKnownType method ty = wildP
+      | otherwise = checkExt ScopedTypeVariables >> sigP wildP (varT t)
+
+    matcherArg p ty
+      | isKnownType method ty = varP p
+      | otherwise = wildP
+
+    printedArg p t ty
+      | isKnownType method ty = [|"«" ++ show $(varE p) ++ "»"|]
+      | otherwise =
+        [|"«" ++ show ($(varE p) :: Predicate $(varT t)) ++ "»"|]
+
+    printedPolyArg p ty
+      | isKnownType method ty = [|"«" ++ show $(varE p) ++ "»"|]
+      | otherwise = [|"«polymorphic»"|]
+
+defineMatchAction :: MockableOptions -> [Method] -> Q Dec
+defineMatchAction options methods =
+  funD 'matchAction (matchActionClause options <$> methods)
+
+matchActionClause :: MockableOptions -> Method -> Q Clause
+matchActionClause options method = do
+  argVars <-
+    replicateM
+      (length (methodArgs method))
+      ((,) <$> newName "p" <*> newName "a")
+  mmVar <- newName "mismatches"
+  clause
+    [ conP
+        (getMatcherName options method)
+        (varP . fst <$> argVars),
+      conP (getActionName options method) (varP . snd <$> argVars)
+    ]
+    ( guardedB
+        [ (,) <$> normalG [|$(varE mmVar) == 0|] <*> [|Match|],
+          (,) <$> normalG [|otherwise|] <*> [|NoMatch $(varE mmVar)|]
+        ]
+    )
+    [ valD
+        (varP mmVar)
+        (normalB [|length (filter not $(listE (mkAccept <$> argVars)))|])
+        []
+    ]
+  where
+    mkAccept (p, a) = [|accept $(return (VarE p)) $(return (VarE a))|]
+
+defineExpectableActions :: MockableOptions -> Instance -> Q [Dec]
+defineExpectableActions options inst =
+  concatMapM (defineExpectableAction options inst) (instMethods inst)
+
+defineExpectableAction :: MockableOptions -> Instance -> Method -> Q [Dec]
+defineExpectableAction options inst method = do
+  maybeCxt <- wholeCxt (methodArgs method)
+  argVars <- replicateM (length (methodArgs method)) (newName "a")
+  case maybeCxt of
+    Just cx -> do
+      (: [])
+        <$> instanceD
+          (pure (methodCxt method ++ cx))
+          ( appT
+              (withMethodParams inst method [t|Expectable|])
+              (withMethodParams inst method [t|Action|])
+          )
+          [ funD
+              'toRule
+              [ clause
+                  [conP (getActionName options method) (map varP argVars)]
+                  ( normalB $
+                      let matcherCon = conE (getMatcherName options method)
+                       in appE (varE 'toRule) (makeBody argVars matcherCon)
+                  )
+                  []
+              ]
+          ]
+    _ -> pure []
+  where
+    makeBody [] e = e
+    makeBody (v : vs) e = makeBody vs [|$e (eq $(varE v))|]
+
+    wholeCxt :: [Type] -> Q (Maybe Cxt)
+    wholeCxt (ty : ts) = do
+      thisCxt <- argCxt ty
+      otherCxt <- wholeCxt ts
+      return ((++) <$> thisCxt <*> otherCxt)
+    wholeCxt [] = return (Just [])
+
+    argCxt :: Type -> Q (Maybe Cxt)
+    argCxt argTy
+      | not (isKnownType method argTy) = return Nothing
+      | VarT v <- argTy =
+        Just <$> sequence [[t|Eq $(varT v)|], [t|Show $(varT v)|]]
+      | otherwise = do
+        eqCxt <- resolveInstance ''Eq argTy
+        showCxt <- resolveInstance ''Show argTy
+        return ((++) <$> eqCxt <*> showCxt)
+
+deriveForMockTImpl :: MockableOptions -> Q Type -> Q [Dec]
+deriveForMockTImpl options qt = do
+  inst <- getInstance options =<< qt
+
+  unless (null (instExtraMembers inst)) $
+    fail $
+      "Cannot derive MockT because " ++ pprint (instType inst)
+        ++ " has unmockable methods."
+
+  m <- newName "m"
+  let decs = map (implementMethod options) (instMethods inst)
+
+  let cx =
+        instRequiredContext inst
+          \\ [ AppT (ConT ''Typeable) (VarT (instMonadVar inst)),
+               AppT (ConT ''Functor) (VarT (instMonadVar inst)),
+               AppT (ConT ''Applicative) (VarT (instMonadVar inst)),
+               AppT (ConT ''Monad) (VarT (instMonadVar inst)),
+               AppT (ConT ''MonadIO) (VarT (instMonadVar inst))
+             ]
+
+  simplifyContext
+    (substTypeVar (instMonadVar inst) (AppT (ConT ''MockT) (VarT m)) <$> cx)
+    >>= \case
+      Just cxMockT ->
+        (: [])
+          <$> instanceD
+            ( concat
+                <$> sequence
+                  [ return cxMockT,
+                    constrainVars [[t|Typeable|]] (instGeneralParams inst),
+                    constrainVars [[t|Typeable|], [t|MonadIO|]] [m]
+                  ]
+            )
+            [t|$(pure (instType inst)) (MockT $(varT m))|]
+            decs
+      Nothing -> fail "Missing MockT instance for a superclass."
+
+implementMethod :: MockableOptions -> Method -> Q Dec
+implementMethod options method = do
+  argVars <- replicateM (length (methodArgs method)) (newName "a")
+  funD
+    (methodName method)
+    [clause (varP <$> argVars) (normalB (body argVars)) []]
+  where
+    actionExp [] e = e
+    actionExp (v : vs) e = actionExp vs [|$e $(varE v)|]
+
+    body argVars = do
+      defaultCxt <- resolveInstance ''Default (methodResult method)
+      let someMockMethod = case defaultCxt of
+            Just [] -> [|mockMethod|]
+            _ -> [|mockDefaultlessMethod|]
+      [|
+        $someMockMethod
+          $(actionExp argVars (conE (getActionName options method)))
+        |]
+
+checkExt :: Extension -> Q ()
+checkExt e = do
+  enabled <- isExtEnabled e
+  unless enabled $
+    fail $ "Please enable " ++ show e ++ " to generate this mock."
+
+internalError :: HasCallStack => Q a
+internalError = error "Internal error in HMock.  Please report this as a bug."
diff --git a/src/Test/HMock/Internal/TH/Util.hs b/src/Test/HMock/Internal/TH/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/TH/Util.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
+
+module Test.HMock.Internal.TH.Util
+  ( unappliedName,
+    tvName,
+    bindVar,
+    substTypeVar,
+    substTypeVars,
+    splitType,
+    freeTypeVars,
+    relevantContext,
+    constrainVars,
+    unifyTypes,
+    removeModNames,
+    hasPolyType,
+    hasNestedPolyType,
+    resolveInstance,
+    simplifyContext,
+    localizeMember,
+  )
+where
+
+import Control.Monad.Extra (mapMaybeM)
+import Data.Generics
+import Data.List ((\\))
+import Data.Maybe (catMaybes, fromMaybe)
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (NameFlavour (..))
+import Test.HMock.Internal.Util (choices)
+
+#if MIN_VERSION_template_haskell(2,17,0)
+
+tvName :: TyVarBndr flag -> Name
+tvName (PlainTV name _) = name
+tvName (KindedTV name _ _) = name
+
+bindVar :: Name -> TyVarBndr Specificity
+bindVar n = PlainTV n SpecifiedSpec
+
+#else
+
+tvName :: TyVarBndr -> Name
+tvName (PlainTV name) = name
+tvName (KindedTV name _) = name
+
+bindVar :: Name -> TyVarBndr
+bindVar = PlainTV
+
+#endif
+
+unappliedName :: Type -> Maybe Name
+unappliedName (AppT a _) = unappliedName a
+unappliedName (ConT a) = Just a
+unappliedName _ = Nothing
+
+substTypeVar :: Name -> Type -> Type -> Type
+substTypeVar n t = substTypeVars [(n, t)]
+
+substTypeVars :: [(Name, Type)] -> Type -> Type
+substTypeVars classVars = everywhere (mkT subst)
+  where
+    subst (VarT x) | Just t <- lookup x classVars = t
+    subst t = t
+
+splitType :: Type -> ([Name], Cxt, [Type])
+splitType (ForallT tv cx b) =
+  let (tvs, cxs, parts) = splitType b
+   in (map tvName tv ++ tvs, cx ++ cxs, parts)
+splitType (AppT (AppT ArrowT a) b) =
+  let (tvs, cx, parts) = splitType b in (tvs, cx, a : parts)
+splitType r = ([], [], [r])
+
+freeTypeVars :: Type -> [Name]
+freeTypeVars = everythingWithContext [] (++) (mkQ ([],) go)
+  where
+    go (VarT v) bound
+      | v `elem` bound = ([], bound)
+      | otherwise = ([v], bound)
+    go (ForallT vs _ _) bound = ([], map tvName vs ++ bound)
+    go _ bound = ([], bound)
+
+constrainVars :: [TypeQ] -> [Name] -> CxtQ
+constrainVars cs vs = sequence [appT c (varT v) | c <- cs, v <- vs]
+
+relevantContext :: Type -> ([Name], Cxt) -> ([Name], Cxt)
+relevantContext ty (tvs, cx) = (filter needsTv tvs, filteredCx)
+  where
+    filteredCx = filter (any (`elem` freeTypeVars ty) . freeTypeVars) cx
+    needsTv v = any ((v `elem`) . freeTypeVars) (ty : filteredCx)
+
+unifyTypes :: Type -> Type -> Q (Maybe [(Name, Type)])
+unifyTypes = unifyTypesWith []
+
+unifyTypesWith :: [(Name, Type)] -> Type -> Type -> Q (Maybe [(Name, Type)])
+unifyTypesWith tbl (VarT v) t2
+  | Just t1 <- lookup v tbl = unifyTypesWith tbl t1 t2
+  | otherwise = return (Just ((v, t2) : tbl))
+unifyTypesWith tbl (ConT a) (ConT b) | a == b = return (Just tbl)
+unifyTypesWith tbl a b = do
+  mbA <- replaceSyn a
+  mbB <- replaceSyn b
+  case (mbA, mbB) of
+    (Nothing, Nothing) -> unifyGen tbl a b
+    _ -> unifyTypesWith tbl (fromMaybe a mbA) (fromMaybe b mbB)
+
+replaceSyn :: Type -> Q (Maybe Type)
+replaceSyn (ConT n) = do
+  info <- reify n
+  case info of
+    TyConI (TySynD _ [] t) -> return (Just t)
+    _ -> return Nothing
+replaceSyn _ = return Nothing
+
+unifyGen ::
+  (Data a, Data b) => [(Name, Type)] -> a -> b -> Q (Maybe [(Name, Type)])
+unifyGen tbl a b
+  | toConstr a == toConstr b =
+    compose (gzipWithQ (\a' b' tbl' -> unify tbl' a' b') a b) tbl
+  | otherwise = return Nothing
+
+unify ::
+  (Data a, Data b) => [(Name, Type)] -> a -> b -> Q (Maybe [(Name, Type)])
+unify tbl a b = do
+  case (cast a, cast b) of
+    (Just a', Just b') -> unifyTypesWith tbl a' b'
+    _ -> unifyGen tbl a b
+
+compose :: Monad m => [t -> m (Maybe t)] -> t -> m (Maybe t)
+compose [] x = return (Just x)
+compose (f : fs) x = do
+  y <- f x
+  case y of
+    Just y' -> compose fs y'
+    _ -> return Nothing
+
+removeModNames :: Data a => a -> a
+removeModNames = everywhere (mkT unMod)
+  where
+    unMod NameG {} = NameS
+    unMod other = other
+
+hasNestedPolyType :: Type -> Bool
+hasNestedPolyType (ForallT _ _ t) = hasPolyType t
+hasNestedPolyType t = hasPolyType t
+
+hasPolyType :: Type -> Bool
+hasPolyType = everything (||) (mkQ False isPolyType)
+  where
+    isPolyType (ForallT tvs _ _) = not (null tvs)
+    isPolyType _ = False
+
+resolveInstance :: Name -> Type -> Q (Maybe Cxt)
+resolveInstance cls t@(VarT _) = return (Just [AppT (ConT cls) t])
+resolveInstance cls t = do
+  decs <- reifyInstances cls [t]
+  result <- traverse (tryInstance t) decs
+  case catMaybes result of
+    [cx] -> return (Just (filter (not . null . freeTypeVars) cx))
+    _ -> return Nothing
+  where
+    tryInstance :: Type -> InstanceDec -> Q (Maybe Cxt)
+    tryInstance actualTy (InstanceD _ cx (AppT (ConT cls') genTy) _)
+      | cls' == cls =
+        unifyTypes genTy actualTy >>= \case
+          Just tbl ->
+            let cx' = substTypeVars tbl <$> cx
+             in fmap concat . sequence <$> mapM resolveInstanceType cx'
+          Nothing -> return Nothing
+    tryInstance _ _ = return Nothing
+
+    resolveInstanceType :: Type -> Q (Maybe Cxt)
+    resolveInstanceType (AppT (ConT cls') t') = resolveInstance cls' t'
+    resolveInstanceType _ = return Nothing
+
+simplifyContext :: Cxt -> Q (Maybe Cxt)
+simplifyContext (AppT (ConT cls) t : preds) = resolveInstance cls t >>= \case
+  Just cxt' -> fmap (cxt' ++) <$> simplifyContext preds
+  Nothing -> return Nothing
+simplifyContext (otherPred : preds) = fmap (otherPred :) <$> simplifyContext preds
+simplifyContext [] = return (Just [])
+
+-- | Remove instance context from a method.
+--
+-- Some GHC versions report class members including the instance context (for
+-- example, @show :: Show a => a -> String@, instead of @show :: a -> String@).
+-- This looks for the instance context, and substitutes if needed to eliminate
+-- it.
+localizeMember :: Type -> Name -> Type -> Q Type
+localizeMember instTy m t@(ForallT tvs cx ty) = do
+  let fullConstraint = AppT instTy (VarT m)
+  let unifyLeft (c, cs) = fmap (,cs) <$> unifyTypes c fullConstraint
+  results <- mapMaybeM unifyLeft (choices cx)
+  case results of
+    ((tbl, remainingCx) : _) -> do
+      let cx' = substTypeVars tbl <$> remainingCx
+          ty' = substTypeVars tbl ty
+          (tvs', cx'') =
+            relevantContext
+              ty'
+              ((tvName <$> tvs) \\ (fst <$> tbl), cx')
+          t'
+            | null tvs' && null cx'' = ty'
+            | otherwise = ForallT (bindVar <$> tvs') cx'' ty'
+      return t'
+    _ -> return t
+localizeMember _ _ t = return t
diff --git a/src/Test/HMock/Internal/Util.hs b/src/Test/HMock/Internal/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/Internal/Util.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Test.HMock.Internal.Util where
+
+import Data.MonoTraversable (Element)
+import qualified Data.Sequences as Seq
+import GHC.Stack (CallStack, getCallStack, prettySrcLoc)
+
+data Located a = Loc (Maybe String) a deriving (Eq, Ord, Functor)
+
+locate :: CallStack -> a -> Located a
+locate stack = case map snd (getCallStack stack) of
+  (loc : _) -> Loc (Just (prettySrcLoc loc))
+  _ -> Loc Nothing
+
+withLoc :: Located String -> String
+withLoc (Loc Nothing s) = s
+withLoc (Loc (Just loc) s) = s ++ " at " ++ loc
+
+choices :: [a] -> [(a, [a])]
+choices [] = []
+choices (x : xs) = (x, xs) : (fmap (x :) <$> choices xs)
+
+isSubsequenceOf :: (Seq.IsSequence t, Eq (Element t)) => t -> t -> Bool
+xs `isSubsequenceOf` ys = case Seq.uncons xs of
+  Nothing -> True
+  Just (x, xs') -> case Seq.uncons (snd (Seq.break (== x) ys)) of
+    Nothing -> False
+    Just (_, ys') -> xs' `isSubsequenceOf` ys'
diff --git a/src/Test/HMock/TH.hs b/src/Test/HMock/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/HMock/TH.hs
@@ -0,0 +1,40 @@
+{- |
+
+This module provides Template Haskell splices that can be used to derive
+boilerplate instances for HMock.
+
+There are 12 splices described here, based on all combinations of three choices:
+
+* Whether to generate a 'Test.HMock.Mockable' instance, an instance for
+  'Test.HMock.MockT', or both.
+* Whether the argument is a class name, or a type which may be partially applied
+  to concrete arguments.
+* Whether options are passed to customize the behavior.
+-}
+
+module Test.HMock.TH
+  ( makeMockable,
+    makeMockableWithOptions,
+    makeMockableBase,
+    makeMockableBaseWithOptions,
+    deriveMockable,
+    deriveMockableWithOptions,
+    deriveMockableBase,
+    deriveMockableBaseWithOptions,
+    deriveForMockT,
+    deriveForMockTWithOptions,
+    makeMockableType,
+    makeMockableTypeWithOptions,
+    makeMockableBaseType,
+    makeMockableBaseTypeWithOptions,
+    deriveMockableType,
+    deriveMockableTypeWithOptions,
+    deriveMockableBaseType,
+    deriveMockableBaseTypeWithOptions,
+    deriveTypeForMockT,
+    deriveTypeForMockTWithOptions,
+    MockableOptions (..),
+  )
+where
+
+import Test.HMock.Internal.TH
diff --git a/test/Classes.hs b/test/Classes.hs
new file mode 100644
--- /dev/null
+++ b/test/Classes.hs
@@ -0,0 +1,787 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Classes where
+
+import Control.DeepSeq (NFData (rnf))
+import Control.Exception (evaluate)
+import Control.Monad.Trans (MonadIO, liftIO)
+import Data.Default (Default (def))
+import Data.Dynamic (Typeable)
+import Data.Kind (Type)
+import Language.Haskell.TH.Syntax hiding (Type)
+import QuasiMock (Action (..), Matcher (..))
+import Test.HMock
+import Test.HMock.TH
+import Test.Hspec
+import Util.TH (deriveRecursive, reifyInstancesStatic, reifyStatic)
+
+#if !MIN_VERSION_base(4, 13, 0)
+import Control.Monad.Fail (MonadFail)
+#endif
+
+#if MIN_VERSION_template_haskell(2, 16, 0)
+-- Pre-define low-level instance to prevent deriveRecursive from trying.
+instance NFData Bytes where rnf = undefined
+#endif
+
+deriveRecursive (Just AnyclassStrategy) ''NFData ''Dec
+
+class MonadSimple m where
+  simple :: String -> m ()
+
+makeMockable ''MonadSimple
+
+simpleTests :: SpecWith ()
+simpleTests = describe "MonadSimple" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadSimple |-> $(reifyStatic ''MonadSimple)
+
+        runQ (makeMockable ''MonadSimple)
+      evaluate (rnf decs)
+
+  it "doesn't require unnecessary extensions for simple cases" $
+    example . runMockT $ do
+      expectAny $ QReify ''MonadSimple |-> $(reifyStatic ''MonadSimple)
+      expectAny $ QIsExtEnabled ScopedTypeVariables |-> False
+      expectAny $ QIsExtEnabled RankNTypes |-> False
+
+      _ <- runQ (makeMockable ''MonadSimple)
+      return ()
+
+  it "fails when GADTs is disabled" $
+    example $ do
+      let missingGADTs = runMockT $ do
+            expectAny $ QIsExtEnabled GADTs |-> False
+            expect $ QReport_ anything (hasSubstr "Please enable GADTs") |-> ()
+
+            _ <- runQ (makeMockable ''MonadSimple)
+            return ()
+
+      missingGADTs `shouldThrow` anyIOException
+
+  it "fails when TypeFamilies is disabled" $
+    example $ do
+      let missingTypeFamilies = runMockT $ do
+            expectAny $ QIsExtEnabled TypeFamilies |-> False
+            expect $
+              QReport_ anything (hasSubstr "Please enable TypeFamilies") |-> ()
+
+            _ <- runQ (makeMockable ''MonadSimple)
+            return ()
+
+      missingTypeFamilies `shouldThrow` anyIOException
+
+  it "fails when DataKinds is disabled" $
+    example $ do
+      let missingDataKinds = runMockT $ do
+            expectAny $ QIsExtEnabled DataKinds |-> False
+            expect $
+              QReport_ anything (hasSubstr "Please enable DataKinds") |-> ()
+
+            _ <- runQ (makeMockable ''MonadSimple)
+            return ()
+
+      missingDataKinds `shouldThrow` anyIOException
+
+  it "fails when FlexibleInstances is disabled" $
+    example $ do
+      let missingDataKinds = runMockT $ do
+            expectAny $ QIsExtEnabled FlexibleInstances |-> False
+            expect $
+              QReport_ anything (hasSubstr "Please enable FlexibleInstances")
+                |-> ()
+
+            _ <- runQ (makeMockable ''MonadSimple)
+            return ()
+
+      missingDataKinds `shouldThrow` anyIOException
+
+  it "fails when MultiParamTypeClasses is disabled" $
+    example $ do
+      let missingDataKinds = runMockT $ do
+            expectAny $ QIsExtEnabled MultiParamTypeClasses |-> False
+            expect $
+              QReport_
+                anything
+                (hasSubstr "Please enable MultiParamTypeClasses")
+                |-> ()
+
+            _ <- runQ (makeMockable ''MonadSimple)
+            return ()
+
+      missingDataKinds `shouldThrow` anyIOException
+
+  it "fails when too many params are given" $
+    example $ do
+      let tooManyParams = runMockT $ do
+            expectAny $ QReify ''MonadSimple |-> $(reifyStatic ''MonadSimple)
+            expect $
+              QReport_ anything (hasSubstr "is applied to too many arguments")
+                |-> ()
+
+            _ <- runQ (makeMockableType [t|MonadSimple IO|])
+            return ()
+
+      tooManyParams `shouldThrow` anyIOException
+
+  it "is mockable" $
+    example $ do
+      let success = runMockT $ do
+            expect $ Simple "foo" |-> ()
+            simple "foo"
+
+          failure = runMockT $ do
+            expect $ Simple "foo" |-> ()
+            simple "bar"
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadSuffix m where
+  suffix :: String -> m ()
+
+makeMockableWithOptions def {mockSuffix = "Blah"} ''MonadSuffix
+
+suffixTests :: SpecWith ()
+suffixTests = describe "MonadSuffix" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadSuffix |-> $(reifyStatic ''MonadSuffix)
+
+        runQ (makeMockableWithOptions def {mockSuffix = "Blah"} ''MonadSuffix)
+      evaluate (rnf decs)
+
+  it "is mockable" $
+    example $ do
+      let success = runMockT $ do
+            expect $ SuffixBlah "foo" |-> ()
+            suffix "foo"
+
+          failure = runMockT $ do
+            expect $ SuffixBlah "foo" |-> ()
+            suffix "bar"
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadWithSetup m where
+  withSetup :: m String
+
+makeMockableBase ''MonadWithSetup
+
+instance Mockable MonadWithSetup where
+  setupMockable _ = do
+    byDefault $ WithSetup |-> "custom default"
+
+setupTests :: SpecWith ()
+setupTests = describe "MonadWithSetup" $ do
+  it "generates mock impl" $ do
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadWithSetup |-> $(reifyStatic ''MonadWithSetup)
+
+        runQ (makeMockableBase ''MonadWithSetup)
+      evaluate (rnf decs)
+
+  it "returns the customized default value" $ do
+    example $
+      runMockT $ do
+        expectAny WithSetup
+
+        result <- withSetup
+        liftIO (result `shouldBe` "custom default")
+
+class SuperClass (m :: Type -> Type)
+
+instance SuperClass m
+
+class (SuperClass m, Monad m, Typeable m) => MonadSuper m where
+  withSuper :: m ()
+
+makeMockable ''MonadSuper
+
+superTests :: SpecWith ()
+superTests = describe "MonadSuper" $ do
+  it "generated mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadSuper |-> $(reifyStatic ''MonadSuper)
+        expectAny $
+          QReifyInstances_
+            (eq ''SuperClass)
+            $(qMatch [p|[AppT (ConT (Name (OccName "MockT") _)) (VarT _)]|])
+            |-> $( do
+                     v <- runQ (newName "m")
+                     reifyInstancesStatic
+                       ''SuperClass
+                       [AppT (ConT ''MockT) (VarT v)]
+                 )
+
+        runQ (makeMockable ''MonadSuper)
+      evaluate (rnf decs)
+
+  it "is mockable" $
+    example $ do
+      let success = runMockT $ do
+            expect $ WithSuper |-> ()
+            withSuper
+
+          failure = runMockT withSuper
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadMPTC a m where
+  mptc :: a -> m ()
+  mptcList :: [a] -> m ()
+
+makeMockable ''MonadMPTC
+
+mptcTests :: SpecWith ()
+mptcTests = describe "MonadMPTC" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadMPTC |-> $(reifyStatic ''MonadMPTC)
+
+        runQ (makeMockable ''MonadMPTC)
+      evaluate (rnf decs)
+
+  it "is mockable" $
+    example $ do
+      let success = runMockT $ do
+            expect $ Mptc "foo" |-> ()
+            mptc "foo"
+
+          failure = runMockT $ do
+            expect $ Mptc "foo" |-> ()
+            mptc "bar"
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadFDSpecialized a m | m -> a where
+  fdSpecialized :: a -> m a
+
+makeMockableType [t|MonadFDSpecialized String|]
+
+fdSpecializedTests :: SpecWith ()
+fdSpecializedTests = describe "MonadFDSpecialized" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $
+          QReify ''MonadFDSpecialized
+            |-> $(reifyStatic ''MonadFDSpecialized)
+
+        runQ (makeMockableType [t|MonadFDSpecialized String|])
+      evaluate (rnf decs)
+
+  it "is mockable" $
+    example $ do
+      let success = runMockT $ do
+            expect $ FdSpecialized "foo" |-> "bar"
+            r <- fdSpecialized "foo"
+            liftIO $ r `shouldBe` "bar"
+
+          failure = runMockT $ do
+            expect $ FdSpecialized "foo" |-> "bar"
+            fdSpecialized "bar"
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadFDGeneral a m | m -> a where
+  fdGeneral :: a -> m a
+
+deriveMockable ''MonadFDGeneral
+
+newtype MyBase m a = MyBase {runMyBase :: m a}
+  deriving newtype (Functor, Applicative, Monad, MonadIO)
+
+instance
+  (MonadIO m, Typeable m) =>
+  MonadFDGeneral String (MockT (MyBase m))
+  where
+  fdGeneral x = mockMethod (FdGeneral x)
+
+fdGeneralTests :: SpecWith ()
+fdGeneralTests = describe "MonadFDGeneral" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadFDGeneral |-> $(reifyStatic ''MonadFDGeneral)
+
+        runQ (deriveMockable ''MonadFDGeneral)
+      evaluate (rnf decs)
+
+  it "is mockable" $
+    example $ do
+      let success = runMyBase . runMockT $ do
+            expect $ FdGeneral "foo" |-> "bar"
+            r <- fdGeneral "foo"
+            liftIO $ r `shouldBe` "bar"
+
+          failure = runMyBase . runMockT $ do
+            expect $ FdGeneral "foo" |-> "bar"
+            fdGeneral "bar"
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadFDMixed a b c d m | m -> a b c d where
+  fdMixed :: a -> b -> c -> m d
+
+deriveMockableType [t|MonadFDMixed String Int|]
+deriveTypeForMockT [t|MonadFDMixed String Int String String|]
+
+fdMixedTests :: SpecWith ()
+fdMixedTests = describe "MonadFDMixed" $ do
+  it "generates mock impl" $
+    example . runMockT $ do
+      expectAny $ QReify ''MonadFDMixed |-> $(reifyStatic ''MonadFDMixed)
+
+      decs1 <- runQ (deriveMockableType [t|MonadFDMixed String Int|])
+      decs2 <-
+        runQ (deriveTypeForMockT [t|MonadFDMixed String Int String Int|])
+      _ <- liftIO $ evaluate (rnf (decs1 ++ decs2))
+      return ()
+
+  it "is mockable" $
+    example $ do
+      let success = runMockT $ do
+            expect $ FdMixed "foo" 1 "bar" |-> "qux"
+            r <- fdMixed "foo" 1 "bar"
+            liftIO $ r `shouldBe` "qux"
+
+          failure = runMockT $ do
+            expect $ FdMixed "foo" 1 "bar" |-> "qux"
+            _ <- fdMixed "bar" 1 "foo"
+            return ()
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadPolyArg m where
+  polyArg :: Enum a => String -> a -> b -> m ()
+
+makeMockable ''MonadPolyArg
+
+polyArgTests :: SpecWith ()
+polyArgTests = describe "MonadPolyArg" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadPolyArg |-> $(reifyStatic ''MonadPolyArg)
+
+        runQ (makeMockable ''MonadPolyArg)
+      evaluate (rnf decs)
+
+  it "fails without ScopedTypeVariables" $
+    example $ do
+      let missingScopedTypeVariables = runMockT $ do
+            expectAny $
+              QReify ''MonadPolyArg |-> $(reifyStatic ''MonadPolyArg)
+            expectAny $ QIsExtEnabled ScopedTypeVariables |-> False
+            expect $
+              QReport_ anything (hasSubstr "Please enable ScopedTypeVariables")
+                |-> ()
+
+            _ <- runQ (makeMockable ''MonadPolyArg)
+            return ()
+
+      missingScopedTypeVariables `shouldThrow` anyException
+
+  it "fails without RankNTypes" $
+    example $ do
+      let missingRankNTypes = runMockT $ do
+            expectAny $ QReify ''MonadPolyArg |-> $(reifyStatic ''MonadPolyArg)
+            expectAny $ QIsExtEnabled RankNTypes |-> False
+            expect $
+              QReport_ anything (hasSubstr "Please enable RankNTypes") |-> ()
+
+            _ <- runQ (makeMockable ''MonadPolyArg)
+            return ()
+
+      missingRankNTypes `shouldThrow` anyException
+
+  it "is mockable" $
+    example $ do
+      let success = runMyBase . runMockT $ do
+            expect $
+              PolyArg_ (eq "foo") (with fromEnum (eq 1)) anything |-> ()
+            polyArg "foo" (toEnum 1 :: Bool) "hello"
+
+          failure = runMyBase . runMockT $ do
+            expect $
+              PolyArg_ (eq "foo") (with fromEnum (eq 1)) anything |-> ()
+            polyArg "foo" (toEnum 2 :: Bool) "hello"
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadUnshowableArg m where
+  unshowableArg :: (Int -> Int) -> m ()
+
+makeMockable ''MonadUnshowableArg
+
+unshowableArgTests :: SpecWith ()
+unshowableArgTests = describe "MonadUnshowableArg" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $
+          QReify ''MonadUnshowableArg |-> $(reifyStatic ''MonadUnshowableArg)
+
+        runQ (makeMockable ''MonadUnshowableArg)
+      evaluate (rnf decs)
+
+  it "is mockable" $
+    example $ do
+      let success = runMyBase . runMockT $ do
+            expect $ UnshowableArg_ anything |-> ()
+            unshowableArg (+ 1)
+
+          failure = runMyBase . runMockT $ do
+            expect $ UnshowableArg_ anything |-> ()
+
+            unshowableArg (+ 1)
+            unshowableArg (+ 1)
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadInArg m where
+  monadInArg :: (Int -> m ()) -> m ()
+
+makeMockable ''MonadInArg
+
+monadInArgTests :: SpecWith ()
+monadInArgTests = describe "MonadInArg" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadInArg |-> $(reifyStatic ''MonadInArg)
+
+        runQ (makeMockable ''MonadInArg)
+      evaluate (rnf decs)
+
+  it "is mockable" $
+    example $ do
+      let success = runMyBase . runMockT $ do
+            expect $ MonadInArg_ anything |-> ()
+            monadInArg (const (return ()))
+
+          failure = runMyBase . runMockT $ do
+            expect $ UnshowableArg_ anything |-> ()
+
+            monadInArg (const (return ()))
+            monadInArg (const (return ()))
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadExtraneousMembers m where
+  data SomeDataType m
+  favoriteNumber :: SomeDataType m -> Int
+  wrongMonad :: Monad n => m Int -> n Int
+  polyResult :: a -> m a
+  nestedRankN :: ((forall a. a -> Bool) -> Bool) -> m ()
+
+  mockableMethod :: Int -> m ()
+
+deriveMockable ''MonadExtraneousMembers
+
+instance (Typeable m, MonadIO m) => MonadExtraneousMembers (MockT m) where
+  data SomeDataType (MockT m) = SomeCon
+  favoriteNumber SomeCon = 42
+  wrongMonad _ = return 42
+  polyResult = return
+  nestedRankN _ = return ()
+
+  mockableMethod a = mockMethod (MockableMethod a)
+
+extraneousMembersTests :: SpecWith ()
+extraneousMembersTests = describe "MonadExtraneousMembers" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $
+          QReify ''MonadExtraneousMembers
+            |-> $(reifyStatic ''MonadExtraneousMembers)
+
+        runQ (deriveMockable ''MonadExtraneousMembers)
+      evaluate (rnf decs)
+
+  it "warns about non-methods" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $
+          QReify ''MonadExtraneousMembers
+            |-> $(reifyStatic ''MonadExtraneousMembers)
+        expect $ QReport False "A non-value member cannot be mocked." |-> ()
+        expect $
+          QReport False "favoriteNumber can't be mocked: non-monadic result."
+            |-> ()
+        expect $
+          QReport
+            False
+            "wrongMonad can't be mocked: return value in wrong monad."
+            |-> ()
+        expect $
+          QReport False "polyResult can't be mocked: polymorphic return value."
+            |-> ()
+        expect $
+          QReport
+            False
+            "nestedRankN can't be mocked: rank-n types nested in arguments."
+            |-> ()
+
+        runQ
+          ( deriveMockableWithOptions
+              def {mockVerbose = True}
+              ''MonadExtraneousMembers
+          )
+      evaluate (rnf decs)
+
+  it "fails to derive MockT when class has extra methods" $
+    example $ do
+      let unmockableMethods = runMockT $ do
+            expectAny $
+              QReify ''MonadExtraneousMembers
+                |-> $(reifyStatic ''MonadExtraneousMembers)
+            expect $
+              QReport_ anything (hasSubstr "has unmockable methods") |-> ()
+
+            _ <- runQ (makeMockable ''MonadExtraneousMembers)
+            return ()
+
+      unmockableMethods `shouldThrow` anyIOException
+
+  it "is mockable" $
+    example $ do
+      let success = runMyBase . runMockT $ do
+            expect $ MockableMethod 42 |-> ()
+            mockableMethod (favoriteNumber (SomeCon @(MockT IO)))
+
+          failure = runMyBase . runMockT $ do
+            expect $ MockableMethod 42 |-> ()
+            mockableMethod 12
+
+      success
+      failure `shouldThrow` anyException
+
+class MonadRankN m where
+  rankN :: (forall a. a -> Bool) -> Bool -> m ()
+
+makeMockable ''MonadRankN
+
+rankNTests :: SpecWith ()
+rankNTests = describe "MonadRankN" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $ QReify ''MonadRankN |-> $(reifyStatic ''MonadRankN)
+
+        runQ (deriveMockable ''MonadRankN)
+      evaluate (rnf decs)
+
+  it "is mockable" $
+    example $ do
+      let success = runMockT $ do
+            expect $ RankN_ anything (eq True) |-> ()
+            rankN (const True) True
+
+          failure = runMockT $ do
+            expect $ RankN_ anything (eq True) |-> ()
+            rankN (const True) False
+
+      success
+      failure `shouldThrow` anyException
+
+-- | Type with no Default instance.
+data NoDefault = NoDefault
+
+class MonadManyReturns m where
+  returnsUnit :: m ()
+  returnsInt :: m Int
+  returnsString :: m String
+  returnsMaybe :: m (Maybe Bool)
+  returnsNoDefault :: m NoDefault
+
+makeMockable ''MonadManyReturns
+
+defaultReturnTests :: SpecWith ()
+defaultReturnTests = do
+  describe "MonadManyReturns" $ do
+    it "generates mock impl" $
+      example $ do
+        decs <- runMockT $ do
+          expectAny $
+            QReify ''MonadManyReturns |-> $(reifyStatic ''MonadManyReturns)
+          expectAny $
+            QReifyInstances ''Default [ConT ''NoDefault]
+              |-> $(reifyInstancesStatic ''Default [ConT ''NoDefault])
+
+          runQ (makeMockable ''MonadManyReturns)
+        evaluate (rnf decs)
+
+    it "fails when there's an unexpected method" $
+      example $ runMockT returnsUnit `shouldThrow` anyException
+
+    it "succeeds when there's an expected method with default response" $
+      example $ do
+        result <- runMockT $ do
+          expect ReturnsUnit
+          expect ReturnsInt
+          expect ReturnsString
+          expect ReturnsMaybe
+
+          (,,,)
+            <$> returnsUnit
+            <*> returnsInt
+            <*> returnsString
+            <*> returnsMaybe
+
+        result `shouldBe` ((), 0, "", Nothing)
+
+    it "overrides default when response is specified" $
+      example $ do
+        result <- runMockT $ do
+          expect ReturnsInt
+          expect $ ReturnsString |-> "non-default"
+
+          (,)
+            <$> returnsInt
+            <*> returnsString
+
+        result `shouldBe` (0, "non-default")
+
+    it "returns undefined when response isn't given for defaultless method" $
+      example $ do
+        let test = runMockT $ do
+              expect ReturnsNoDefault
+              returnsNoDefault
+        _ <- test
+        (test >>= evaluate) `shouldThrow` anyException
+
+class MonadNestedNoDef m where
+  nestedNoDef :: m (NoDefault, String)
+
+$(return []) -- Hack to get types into the TH environment.
+
+nestedNoDefTests :: SpecWith ()
+nestedNoDefTests = describe "MonadNestedNoDef" $ do
+  it "generates mock impl" $
+    example $ do
+      decs <- runMockT $ do
+        expectAny $
+          QReify ''MonadNestedNoDef |-> $(reifyStatic ''MonadNestedNoDef)
+        expectAny $
+          QReifyInstances
+            ''Default
+            [AppT (AppT (TupleT 2) (ConT ''NoDefault)) (ConT ''String)]
+            |-> $( reifyInstancesStatic
+                     ''Default
+                     [AppT (AppT (TupleT 2) (ConT ''NoDefault)) (ConT ''String)]
+                 )
+        expectAny $
+          QReifyInstances ''Default [ConT ''NoDefault]
+            |-> $(reifyInstancesStatic ''Default [ConT ''NoDefault])
+
+        runQ (makeMockable ''MonadNestedNoDef)
+      evaluate (rnf decs)
+
+class ClassWithNoParams
+
+$(return []) -- Hack to get types into the TH environment.
+
+errorTests :: SpecWith ()
+errorTests = describe "errors" $ do
+  it "fails when given a type instead of a class" $
+    example $ do
+      let wrongKind = runMockT $ do
+            expect $
+              QReport_
+                anything
+                (hasSubstr "Expected GHC.Types.Int to be a class")
+                |-> ()
+
+            _ <- runQ (makeMockable ''Int)
+            return ()
+
+      wrongKind `shouldThrow` anyIOException
+
+  it "fails when given an unexpected type construct" $
+    example $ do
+      let notClass = runMockT $ do
+            expect $ QReport_ anything (hasSubstr "Expected a class") |-> ()
+
+            _ <- runQ (makeMockableType [t|(Int, String)|])
+            return ()
+
+      notClass `shouldThrow` anyIOException
+
+  it "fails when class has no params" $
+    example $ do
+      let tooManyParams = runMockT $ do
+            expectAny $
+              QReify ''ClassWithNoParams |-> $(reifyStatic ''ClassWithNoParams)
+            expect $
+              QReport_
+                anything
+                (hasSubstr "ClassWithNoParams has no type parameters")
+                |-> ()
+
+            _ <- runQ (makeMockable ''ClassWithNoParams)
+            return ()
+
+      tooManyParams `shouldThrow` anyIOException
+
+  it "fails when class has no mockable methods" $
+    example $ do
+      let noMockableMethods = runMockT $ do
+            expectAny $ QReify ''Show |-> $(reifyStatic ''Show)
+            expect $
+              QReport_ anything (hasSubstr "has no mockable methods") |-> ()
+
+            _ <- runQ (deriveMockable ''Show)
+            return ()
+
+      noMockableMethods `shouldThrow` anyIOException
+
+classTests :: SpecWith ()
+classTests = describe "makeMockable" $ do
+  simpleTests
+  suffixTests
+  setupTests
+  superTests
+  mptcTests
+  fdSpecializedTests
+  fdGeneralTests
+  fdMixedTests
+  polyArgTests
+  unshowableArgTests
+  monadInArgTests
+  extraneousMembersTests
+  rankNTests
+  defaultReturnTests
+  nestedNoDefTests
+  errorTests
diff --git a/test/Core.hs b/test/Core.hs
new file mode 100644
--- /dev/null
+++ b/test/Core.hs
@@ -0,0 +1,615 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Core where
+
+import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
+import Control.DeepSeq (rnf)
+import Control.Exception (SomeException, evaluate)
+import Control.Monad (replicateM_)
+import Control.Monad.Reader (MonadReader (local), ask, runReaderT)
+import Control.Monad.State (execStateT, modify)
+import Control.Monad.Trans (liftIO)
+import Data.IORef (newIORef, readIORef, writeIORef)
+import Data.List (isInfixOf, isPrefixOf)
+import Test.HMock
+import Test.HMock.TH (makeMockable)
+import Test.Hspec
+import qualified UnliftIO.Concurrent as UnliftIO
+import Prelude hiding (readFile, writeFile)
+import qualified Prelude
+
+class Monad m => MonadFilesystem m where
+  readFile :: FilePath -> m String
+  writeFile :: FilePath -> String -> m ()
+
+-- | This is not used by tests.  It's just an illustration of how you'd use
+-- 'MonadFilesystem' in production.
+instance MonadFilesystem IO where
+  readFile = Prelude.readFile
+  writeFile = Prelude.writeFile
+
+makeMockable ''MonadFilesystem
+
+newtype SocketHandle = Handle Int deriving (Eq, Show)
+
+class Monad m => MonadSocket m where
+  openSocket :: Int -> m SocketHandle
+  closeSocket :: SocketHandle -> m ()
+
+makeMockable ''MonadSocket
+
+coreTests :: SpecWith ()
+coreTests = do
+  describe "HMock core" $ do
+    it "verifies a file copy" $
+      example $ do
+        let copyFile :: MonadFilesystem m => FilePath -> FilePath -> m ()
+            copyFile a b = readFile a >>= writeFile b
+
+        runMockT $ do
+          expect $ ReadFile "foo.txt" |-> "lorem ipsum"
+          expect $ WriteFile "bar.txt" "lorem ipsum"
+
+          copyFile "foo.txt" "bar.txt"
+
+    it "rejects an incorrect file copy" $
+      example $ do
+        let badCopyFile :: MonadFilesystem m => FilePath -> FilePath -> m ()
+            badCopyFile a b = readFile b >>= writeFile a
+
+            failure = runMockT $ do
+              expect $ ReadFile "foo.txt" |-> "lorem ipsum"
+              expect $ WriteFile "bar.txt" "lorem ipsum"
+
+              badCopyFile "foo.txt" "bar.txt"
+
+        failure `shouldThrow` anyException
+
+    it "uses default responses when no explicit response given" $
+      example $ do
+        let test = runMockT $ do
+              expect $ WriteFile "file.txt" "contents"
+              expect $ ReadFile "file.txt"
+              writeFile "file.txt" "contents"
+              readFile "file.txt"
+
+        test `shouldReturn` ""
+
+    it "shares expectations using withMockT" $
+      example $
+        withMockT $ \inMockT -> do
+          expect $ ReadFile "foo.txt" |-> "lorem ipsum"
+          expect $ WriteFile "bar.txt" "lorem ipsum"
+
+          var <- liftIO newEmptyMVar
+
+          _ <-
+            liftIO $
+              forkIO $ inMockT $ readFile "foo.txt" >>= liftIO . putMVar var
+          writeFile "bar.txt" =<< liftIO (takeMVar var)
+
+    it "shares expectations across threads using MonadUnliftIO" $
+      example $
+        runMockT $ do
+          expect $ ReadFile "foo.txt" |-> "lorem ipsum"
+          expect $ WriteFile "bar.txt" "lorem ipsum"
+
+          var <- liftIO newEmptyMVar
+          _ <- UnliftIO.forkIO $ readFile "foo.txt" >>= liftIO . putMVar var
+          writeFile "bar.txt" =<< liftIO (takeMVar var)
+
+    it "tracks expectations across multiple classes" $
+      example $ do
+        let setExpectations =
+              inSequence
+                [ expect $ ReadFile "code.txt" |-> "alpha",
+                  expect $ OpenSocket 80 |-> Handle 80,
+                  expect $ WriteFile "code.txt" "alpha+",
+                  expect $ CloseSocket (Handle 80)
+                ]
+
+            success = runMockT $ do
+              setExpectations
+
+              code <- readFile "code.txt"
+              h <- openSocket 80
+              writeFile "code.txt" (code ++ "+")
+              closeSocket h
+
+            failure = runMockT $ do
+              setExpectations
+
+              h <- openSocket 80
+              code <- readFile "code.txt"
+              closeSocket h
+              writeFile "code.txt" (code ++ "+")
+
+        success
+
+        failure
+          `shouldThrow` errorWith ("Unexpected action: openSocket" `isInfixOf`)
+
+    it "returns multiple responses" $
+      example $ do
+        let test = runMockT $ do
+              expect $
+                ReadFile "foo.txt"
+                  |-> "a"
+                  |-> "b"
+                  |-> "c"
+              (,,)
+                <$> readFile "foo.txt"
+                <*> readFile "foo.txt"
+                <*> readFile "foo.txt"
+
+        test `shouldReturn` ("a", "b", "c")
+
+    it "catches expectN with too many expectations" $
+      example $ do
+        let test = runMockT $ do
+              expectN once $
+                ReadFile "foo.txt"
+                  |-> "a"
+                  |-> "b"
+
+        test `shouldThrow` errorWith ("2 responses is too many" `isInfixOf`)
+
+    it "catches unmet expectations" $
+      example $ do
+        let test = runMockT $ do
+              expect $ WriteFile "bar.txt" "bar"
+
+              -- Don't write the file.
+              return ()
+
+        test
+          `shouldThrow` errorWith
+            (("Unmet expectations" `isInfixOf`) <&&> ("Core.hs:" `isInfixOf`))
+
+    it "catches partially unmet expectations" $
+      example $ do
+        let test = runMockT $ do
+              expect $ WriteFile "foo.txt" "foo"
+              expect $ WriteFile "bar.txt" "bar"
+
+              writeFile "foo.txt" "foo"
+
+        test `shouldThrow` errorWith ("Unmet expectations" `isInfixOf`)
+
+    it "catches partially unmet sequences" $
+      example $ do
+        let test = runMockT $ do
+              inSequence
+                [ expect $ WriteFile "foo.txt" "foo",
+                  expect $ WriteFile "bar.txt" "bar",
+                  expect $ WriteFile "baz.txt" "baz"
+                ]
+
+              writeFile "foo.txt" "foo"
+
+        test `shouldThrow` errorWith ("Unmet expectations" `isInfixOf`)
+
+    it "catches unexpected actions" $
+      example $
+        runMockT (writeFile "bar.txt" "bar")
+          `shouldThrow` errorWith ("Unexpected action: writeFile" `isInfixOf`)
+
+    it "catches incorrect arguments" $
+      example $ do
+        let test = runMockT $ do
+              expect $ WriteFile "bar.txt" "bar"
+              writeFile "bar.txt" "incorrect"
+
+        test
+          `shouldThrow` errorWith
+            (("Wrong arguments" `isInfixOf`) <&&> ("Core.hs:" `isInfixOf`))
+
+    it "matches with imprecise predicates" $
+      example . runMockT $ do
+        expect $ WriteFile_ (hasSubstr "bar") anything
+        writeFile "bar.txt" "unknown contents"
+
+    it "stores source location in suchThat predicate" $
+      example $ do
+        let test = runMockT $ do
+              expect $ ReadFile_ (is ("foo" `isPrefixOf`)) |-> "foo"
+              readFile "bar.txt"
+
+        test `shouldThrow` errorWith ("Core.hs" `isInfixOf`)
+
+    it "prefers most recent method match" $
+      example . runMockT $ do
+        expectAny $ ReadFile "foo.txt" |-> "a"
+        expectAny $ ReadFile "foo.txt" |-> "b"
+        expect $ ReadFile "foo.txt" |-> "c"
+        expect $ ReadFile "foo.txt" |-> "d"
+
+        r1 <- readFile "foo.txt"
+        r2 <- readFile "foo.txt"
+        r3 <- readFile "foo.txt"
+        r4 <- readFile "foo.txt"
+
+        liftIO $ r1 `shouldBe` "d"
+        liftIO $ r2 `shouldBe` "c"
+        liftIO $ r3 `shouldBe` "b"
+        liftIO $ r4 `shouldBe` "b"
+
+    it "matches flexible multiplicity" $
+      example $ do
+        let setExpectations = do
+              expectN (atLeast 3) $ ReadFile "foo.txt" |-> "foo"
+              expectN (atMost 2) $ ReadFile "bar.txt" |-> "bar"
+              expectAny $ ReadFile "baz.txt" |-> "baz"
+
+            success1 = runMockT $ do
+              setExpectations
+              replicateM_ 3 $ readFile "foo.txt"
+
+            success2 = runMockT $ do
+              setExpectations
+              replicateM_ 4 $ readFile "foo.txt"
+
+            success3 = runMockT $ do
+              setExpectations
+              replicateM_ 3 $ readFile "foo.txt"
+              replicateM_ 2 $ readFile "bar.txt"
+
+            success4 = runMockT $ do
+              setExpectations
+              replicateM_ 3 $ readFile "foo.txt"
+              replicateM_ 2 $ readFile "bar.txt"
+              replicateM_ 5 $ readFile "baz.txt"
+
+            failure1 = runMockT $ do
+              setExpectations
+              replicateM_ 1 $ readFile "foo.txt"
+
+            failure2 = runMockT $ do
+              setExpectations
+              replicateM_ 3 $ readFile "foo.txt"
+              replicateM_ 3 $ readFile "bar.txt"
+
+        success1
+        success2
+        success3
+        success4
+        failure1 `shouldThrow` anyException
+        failure2 `shouldThrow` anyException
+
+    it "enforces nested sequences" $
+      example $ do
+        let setExpectations =
+              inSequence
+                [ inAnyOrder
+                    [ expect $ ReadFile "1.txt" |-> "1",
+                      expect $ ReadFile "2.txt" |-> "2"
+                    ],
+                  expect $ ReadFile "3.txt" |-> "3"
+                ]
+
+            success1 = runMockT $ do
+              setExpectations
+              _ <- readFile "1.txt"
+              _ <- readFile "2.txt"
+              _ <- readFile "3.txt"
+              return ()
+
+            success2 = runMockT $ do
+              setExpectations
+              _ <- readFile "2.txt"
+              _ <- readFile "1.txt"
+              _ <- readFile "3.txt"
+              return ()
+
+            failure = runMockT $ do
+              setExpectations
+              _ <- readFile "2.txt"
+              _ <- readFile "3.txt"
+              _ <- readFile "1.txt"
+              return ()
+
+        success1
+        success2
+        failure `shouldThrow` anyException
+
+    it "handles nested sequences" $
+      example . runMockT $ do
+        inSequence
+          [ inSequence
+              [ expect $ ReadFile "a" |-> "a",
+                expect $ ReadFile "b" |-> "b"
+              ],
+            expect $ ReadFile "c" |-> "c"
+          ]
+
+        _ <- readFile "a"
+        _ <- readFile "b"
+        _ <- readFile "c"
+        return ()
+
+    it "consumes optional calls in sequences" $
+      example $ do
+        let setExpectations =
+              inSequence
+                [ expectAny $ WriteFile "foo.txt" "foo",
+                  expectAny $ WriteFile "foo.txt" "bar"
+                ]
+
+            success = runMockT $ do
+              setExpectations
+              writeFile "foo.txt" "foo"
+              writeFile "foo.txt" "bar"
+
+            failure = runMockT $ do
+              setExpectations
+              writeFile "foo.txt" "foo"
+              writeFile "foo.txt" "bar"
+              writeFile "foo.txt" "foo"
+
+        success
+        failure `shouldThrow` errorWith ("Wrong arguments:" `isInfixOf`)
+
+    it "implements choice" $
+      example $ do
+        let setExpectations =
+              anyOf
+                [ expect $ WriteFile "status.txt" "all systems go",
+                  expect $ WriteFile "status.txt" "we have a problem"
+                ]
+
+            success1 = runMockT $ do
+              setExpectations
+              writeFile "status.txt" "all systems go"
+
+            success2 = runMockT $ do
+              setExpectations
+              writeFile "status.txt" "we have a problem"
+
+            failure1 = runMockT $ do
+              setExpectations
+              return ()
+
+            failure2 = runMockT $ do
+              setExpectations
+              writeFile "status.txt" "not sure"
+
+        success1
+        success2
+        failure1 `shouldThrow` anyException
+        failure2 `shouldThrow` anyException
+
+    it "implements interleaved repetition" $
+      example $ do
+        let setExpectations =
+              times (atLeast 2) $
+                inAnyOrder
+                  [ expect $ WriteFile "foo.txt" "a",
+                    expect $ WriteFile "bar.txt" "b"
+                  ]
+
+            success1 = runMockT $ do
+              setExpectations
+
+              writeFile "foo.txt" "a"
+              writeFile "bar.txt" "b"
+
+              writeFile "bar.txt" "b"
+              writeFile "foo.txt" "a"
+
+            success2 = runMockT $ do
+              setExpectations
+
+              writeFile "foo.txt" "a"
+              writeFile "foo.txt" "a"
+
+              writeFile "bar.txt" "b"
+              writeFile "bar.txt" "b"
+
+            tooFew = runMockT $ do
+              setExpectations
+
+              writeFile "foo.txt" "a"
+              writeFile "bar.txt" "b"
+
+            incomplete = runMockT $ do
+              setExpectations
+
+              writeFile "foo.txt" "a"
+              writeFile "bar.txt" "b"
+
+              writeFile "foo.txt" "a"
+              writeFile "bar.txt" "b"
+
+              writeFile "foo.txt" "a"
+
+        success1
+        success2
+        tooFew `shouldThrow` anyException
+        incomplete `shouldThrow` anyException
+
+    it "implements consecutive repetition" $
+      example $ do
+        let setExpectations =
+              consecutiveTimes (atLeast 2) $
+                inAnyOrder
+                  [ expect $ WriteFile "foo.txt" "a",
+                    expect $ WriteFile "bar.txt" "b"
+                  ]
+
+            success1 = runMockT $ do
+              setExpectations
+
+              writeFile "foo.txt" "a"
+              writeFile "bar.txt" "b"
+
+              writeFile "bar.txt" "b"
+              writeFile "foo.txt" "a"
+
+            interleaved = runMockT $ do
+              setExpectations
+
+              writeFile "foo.txt" "a"
+              writeFile "foo.txt" "a"
+
+              writeFile "bar.txt" "b"
+              writeFile "bar.txt" "b"
+
+            tooFew = runMockT $ do
+              setExpectations
+
+              writeFile "foo.txt" "a"
+              writeFile "bar.txt" "b"
+
+            incomplete = runMockT $ do
+              setExpectations
+
+              writeFile "foo.txt" "a"
+              writeFile "bar.txt" "b"
+
+              writeFile "foo.txt" "a"
+              writeFile "bar.txt" "b"
+
+              writeFile "foo.txt" "a"
+
+        success1
+        interleaved `shouldThrow` anyException
+        tooFew `shouldThrow` anyException
+        incomplete `shouldThrow` anyException
+
+    it "repeats response sequences during repetition" $
+      example $ do
+        runMockT $ do
+          times 2 $ expect $ ReadFile "foo.txt" |-> "A" |-> "B"
+
+          result <-
+            (,,,) <$> readFile "foo.txt"
+              <*> readFile "foo.txt"
+              <*> readFile "foo.txt"
+              <*> readFile "foo.txt"
+          liftIO $ result `shouldBe` ("A", "B", "A", "B")
+
+        runMockT $ do
+          consecutiveTimes 2 $ expect $ ReadFile "foo.txt" |-> "A" |-> "B"
+
+          result <-
+            (,,,) <$> readFile "foo.txt"
+              <*> readFile "foo.txt"
+              <*> readFile "foo.txt"
+              <*> readFile "foo.txt"
+          liftIO $ result `shouldBe` ("A", "B", "A", "B")
+
+    it "gives access to method arguments in the response" $
+      example $ do
+        let test = runMockT $ do
+              expect $
+                ReadFile_ anything
+                  |=> \(ReadFile f) -> return ("contents of " ++ f)
+
+              readFile "foo.txt"
+
+        test `shouldReturn` "contents of foo.txt"
+
+    it "allows responses to run in the underlying monad" $
+      example $ do
+        ref <- newIORef ""
+        runMockT $ do
+          expectAny $
+            WriteFile_ (eq "foo.txt") anything
+              |=> \(WriteFile _ c) -> liftIO (writeIORef ref c)
+          writeFile "foo.txt" "open sesame"
+        readIORef ref `shouldReturn` "open sesame"
+
+    it "respects expectations added by a response" $
+      example $ do
+        let setExpectations = do
+              expectAny $
+                OpenSocket_ anything |=> \(OpenSocket n) -> do
+                  expect $ CloseSocket (Handle n)
+                  return (Handle n)
+
+            success = runMockT $ do
+              setExpectations
+
+              h <- openSocket 80
+              closeSocket h
+
+            failure = runMockT $ do
+              setExpectations
+
+              _ <- openSocket 80
+              return ()
+
+        success
+        failure `shouldThrow` anyException
+
+    it "has a correct implementation of MonadReader" $
+      example $ do
+        flip runReaderT "read me" $
+          runMockT $ do
+            expectAny $ ReadFile_ anything |=> const ask
+
+            a <- readFile ""
+            liftIO (a `shouldBe` "read me")
+
+            local (++ " too") $ do
+              b <- readFile ""
+              liftIO (b `shouldBe` "read me too")
+
+    it "has a correct implementation of MonadState" $
+      example $ do
+        filesRead <- flip execStateT (0 :: Int) $
+          runMockT $ do
+            expectAny $
+              ReadFile_ anything
+                |=> \_ -> modify (+ 1) >> return ""
+
+            _ <- readFile "foo.txt"
+            _ <- readFile "bar.txt"
+            return ()
+
+        filesRead `shouldBe` 2
+
+    it "describes expectations when asked" $
+      example . runMockT $ do
+        expectAny $ ReadFile_ anything
+        expectations <- describeExpectations
+
+        -- Format is deliberately unspecified.  We're forcing it here so that
+        -- test coverage doesn't flag the formatting code as untested.
+        liftIO $ evaluate (rnf expectations)
+
+    it "verifies expectations early" $
+      example $ do
+        let test = runMockT $ do
+              expect $ ReadFile "foo.txt" |-> "lorem ipsum"
+              verifyExpectations
+              _ <- readFile "foo.txt"
+              return ()
+
+        test `shouldThrow` anyException
+
+    it "allows the user to override a default" $
+      example $
+        runMockT $ do
+          expectAny $ ReadFile_ anything
+
+          r1 <- readFile "foo.txt"
+
+          byDefault $ ReadFile "foo.txt" |-> "foo"
+          r2 <- readFile "foo.txt"
+          r3 <- readFile "bar.txt"
+
+          liftIO (r1 `shouldBe` "")
+          liftIO (r2 `shouldBe` "foo")
+          liftIO (r3 `shouldBe` "")
+
+errorWith :: (String -> Bool) -> SomeException -> Bool
+errorWith p e = p (show e)
+
+(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool
+x <&&> y = (&&) <$> x <*> y
diff --git a/test/Demo.hs b/test/Demo.hs
new file mode 100644
--- /dev/null
+++ b/test/Demo.hs
@@ -0,0 +1,244 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Demo where
+
+import Control.Exception (Exception)
+import Control.Monad (unless, when)
+import Control.Monad.Catch (MonadMask, catch, finally, throwM)
+import Data.Char (isLetter)
+import Test.HMock
+  ( Mockable (..),
+    anything,
+    expect,
+    expectAny,
+    runMockT,
+    (|->),
+    (|=>),
+  )
+import Test.HMock.TH (makeMockable, makeMockableBase)
+import Test.Hspec (SpecWith, describe, example, it)
+import Prelude hiding (appendFile, readFile, writeFile)
+
+-- This is an in-depth example of using HMock to test a system with dependencies
+-- on external systems.  The application here is a chat bot, which needs to
+-- be able to talk to services for authentication, communication, and storage.
+
+-------------------------------------------------------------------------------
+-- PART 1: TYPES AND CLASSES
+
+-- We start with some basic types.
+
+-- | Represents a user in the system.
+newtype User = User String deriving (Eq, Show)
+
+-- | Represents a permission level.  The Guest level is given to users who are
+-- not logged in.  NormalUser requires being logged in.  Admin requires being
+-- logged in with elevated permissions.
+data PermLevel = Guest | NormalUser | Admin deriving (Eq, Show)
+
+-- | Represents a chat room.
+newtype Room = Room String deriving (Eq, Show)
+
+-- HMock needs MTL-style type classes to mock.  Here, we implement a number of
+-- these classes.
+
+-- | An MTL-style type class to capture authentication.  This can be used in two
+-- ways.
+--
+-- 1. Using the 'login' and 'logout' actions to start and end an authenticated
+--    session.  While the user is logged in, 'getUser' and 'hasPermission' will
+--    return appropriate responses for that user.  Remember to log out!
+--
+-- 2. Using the 'withLogin' action to run an action as a user.  The user will
+--    be logged out automatically when the action finishes.
+class Monad m => MonadAuth m where
+  login :: String -> String -> m ()
+  logout :: m ()
+  hasPermission :: PermLevel -> m Bool
+
+-- | An MTL-style type class for sending and receiving chat messages.  We can
+-- start and close sessions, send messages, poll for messages (blocking for a
+-- period of time if desired), and ban other users (probably only if we're an
+-- admin!)
+class MonadAuth m => MonadChat m where
+  joinRoom :: String -> m Room
+  leaveRoom :: Room -> m ()
+  sendChat :: Room -> String -> m ()
+  pollChat :: Room -> m (User, String)
+  ban :: Room -> User -> m ()
+
+-- | An MTL-style type class for accessing the filesystem.  It wouldn't be a
+-- good idea to write mock-style tests for all uses of the filesystem, but we
+-- can use HMock to set up a lightweight fake.
+class Monad m => MonadBugReport m where
+  reportBug :: String -> m ()
+
+-- | An exception thrown when a banned user attempts to join a room.
+data BannedException = BannedException deriving (Show)
+
+instance Exception BannedException
+
+-------------------------------------------------------------------------------
+-- PART 2: IMPLEMENTATION
+
+-- We will now implement a simple chatbot, which joins a chat room and responds
+-- to messages.
+
+type MonadChatBot m = (MonadChat m, MonadBugReport m)
+
+chatbot :: (MonadMask m, MonadChatBot m) => String -> m ()
+chatbot roomName = do
+  login "HMockBot" "secretish"
+  handleRoom roomName `finally` logout
+
+handleRoom :: (MonadMask m, MonadChatBot m) => String -> m ()
+handleRoom roomName = do
+  room <- joinRoom roomName
+  listenAndReply room `finally` leaveRoom room
+
+listenAndReply :: MonadChatBot m => Room -> m ()
+listenAndReply room = do
+  (user, msg) <- pollChat room
+  finished <- case words msg of
+    ["!leave"] -> return True
+    ("!bug" : ws) -> reportBug (unwords ws) >> return False
+    ws | any isFourLetterWord ws -> banIfAdmin room user >> return False
+    _ -> return False
+  unless finished (listenAndReply room)
+
+isFourLetterWord :: [Char] -> Bool
+isFourLetterWord = (== 4) . length . filter isLetter
+
+sendBugReport :: MonadChatBot m => Room -> String -> m ()
+sendBugReport room bug = do
+  reportBug bug
+  sendChat room "Thanks for the bug report!"
+
+banIfAdmin :: MonadChat m => Room -> User -> m ()
+banIfAdmin room user = do
+  isAdmin <- hasPermission Admin
+  when isAdmin $ do
+    ban room user
+    sendChat room "Sorry for the disturbance!"
+
+-------------------------------------------------------------------------------
+-- PART 3: MOCKS
+
+-- Set up the mocks for the three classes.  makeMockable is the first step to
+-- using HMock, and defines a number of boilerplate types and instances that are
+-- used by the framework and your tests.
+--
+-- How we do this depends on whether there is setup we want to package with the
+-- class:
+
+-- Since there is no setup for MonadBugReport, it's easiest to use makeMockable
+-- to derive all instances needed to mock this class.
+makeMockable ''MonadBugReport
+
+-- For MonadAuth and MonadChat, we have default behaviors we'd like to offer
+-- to all tests.  So instead of makeMockable, we use makeMockableBase to derive
+-- MockableBase, which contains all the boilerplate.  We can then write a
+-- Mockable instance with setup steps.
+
+makeMockableBase ''MonadAuth
+
+instance Mockable MonadAuth where
+  setupMockable _ = do
+    -- Ensure that when the chatbot logs in with the right username and
+    -- password.
+    expectAny $
+      Login "HMockBot" "secretish"
+        |=> \_ -> do
+          -- Every login should be accompanied by a logout
+          expect Logout
+
+    -- By default, assume that the bot has all permissions.  Individual tests
+    -- can override this assumption.
+    expectAny $ HasPermission_ anything |-> True
+
+makeMockableBase ''MonadChat
+
+instance Mockable MonadChat where
+  setupMockable _ = do
+    expectAny $
+      JoinRoom_ anything
+        |=> \(JoinRoom room) -> do
+          -- The bot should leave every room it joins.
+          expect $ LeaveRoom (Room room)
+          return (Room room)
+
+    -- Our tests aren't generally concerned with what the bot says.  Individual
+    -- tests can add expectations to check for specific messages.
+    expectAny $ SendChat_ anything anything
+
+-------------------------------------------------------------------------------
+-- PART 4: TESTS
+
+-- We're now ready to write tests for the behavior of our chat bot.  We'll just
+-- write a few representative tests to see how things work.  I'm using Hspec for
+-- the test framework, but you can use your favorite framework.
+
+demoSpec :: SpecWith ()
+demoSpec = describe "chatbot" $ do
+  it "bans users who use four-letter words" $
+    example $
+      runMockT $ do
+        -- Set up some chat messages to be received.
+        expectAny $
+          PollChat_ anything
+            |-> (User "A", "I love Haskell")
+            |-> (User "B", "Lovin' the ass. candies")
+            |-> (User "B", "!leave")
+
+        -- User A should be banned for using a four-letter word ("love").  User
+        -- B should not be banned for using an abbreviation for "assorted."
+        expect $ Ban (Room "#haskell") (User "A")
+
+        -- Finally, run the system under test.
+        chatbot "#haskell"
+
+  it "still logs out cleanly when there are errors" $ do
+    example $
+      runMockT $ do
+        expectAny $ JoinRoom "#haskell" |=> \_ -> throwM BannedException
+
+        -- An exception will be thrown when attempting to read chat.  The bot
+        -- is still expected to log out.
+        chatbot "#haskell" `catch` \BannedException -> return ()
+
+  it "doesn't ban if it doesn't have permission" $ do
+    example $
+      runMockT $ do
+        -- Override the earlier default behavior, returning False for the Admin
+        -- permission level.
+        expectAny $ HasPermission Admin |-> False
+        expectAny $
+          PollChat_ anything
+            |-> (User "A", "I love Haskell")
+            |-> (User "A", "!leave")
+
+        chatbot "#haskell"
+
+  it "doesn't ban people for using four-letter words in big reports" $ do
+    example $
+      runMockT $ do
+        -- A four letter word is used in a bug report.  This is understandable,
+        -- so the user shouldn't be banned.  The bug should be reported,
+        -- instead.
+        expectAny $
+          PollChat_ anything
+            |-> (User "A", "!bug Fix the damn website!")
+            |-> (User "A", "!leave")
+        expect $ ReportBug "Fix the damn website!"
+
+        chatbot "#haskell"
diff --git a/test/DocTests/All.hs b/test/DocTests/All.hs
new file mode 100644
--- /dev/null
+++ b/test/DocTests/All.hs
@@ -0,0 +1,12 @@
+-- Do not edit! Automatically created with doctest-extract.
+module DocTests.All where
+
+import qualified DocTests.Test.HMock.Internal.Predicates
+import qualified DocTests.Test.HMock.Internal.Multiplicity
+
+import qualified Test.DocTest.Driver as DocTest
+
+main :: DocTest.T ()
+main = do
+    DocTests.Test.HMock.Internal.Predicates.test
+    DocTests.Test.HMock.Internal.Multiplicity.test
diff --git a/test/DocTests/Test/HMock/Internal/Multiplicity.hs b/test/DocTests/Test/HMock/Internal/Multiplicity.hs
new file mode 100644
--- /dev/null
+++ b/test/DocTests/Test/HMock/Internal/Multiplicity.hs
@@ -0,0 +1,166 @@
+-- Do not edit! Automatically created with doctest-extract from src/Test/HMock/Internal/Multiplicity.hs
+module DocTests.Test.HMock.Internal.Multiplicity where
+
+import Test.HMock.Internal.Multiplicity
+import Test.DocTest.Base
+import qualified Test.DocTest.Driver as DocTest
+
+
+test :: DocTest.T ()
+test = do
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:33: "
+{-# LINE 33 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 33 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity 5 4)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:35: "
+{-# LINE 35 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 35 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity 5 5)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:37: "
+{-# LINE 37 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 37 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (between 4 6 - between 1 2)
+  [ExpectedLine [LineChunk "2 to 5 times"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:75: "
+{-# LINE 75 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 75 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity once 0)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:77: "
+{-# LINE 77 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 77 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity once 1)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:79: "
+{-# LINE 79 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 79 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity once 2)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:85: "
+{-# LINE 85 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 85 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity anyMultiplicity 0)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:87: "
+{-# LINE 87 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 87 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity anyMultiplicity 1)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:89: "
+{-# LINE 89 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 89 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity anyMultiplicity 10)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:96: "
+{-# LINE 96 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 96 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (atLeast 2) 1)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:98: "
+{-# LINE 98 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 98 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (atLeast 2) 2)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:100: "
+{-# LINE 100 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 100 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (atLeast 2) 3)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:107: "
+{-# LINE 107 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 107 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (atMost 2) 1)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:109: "
+{-# LINE 109 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 109 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (atMost 2) 2)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:111: "
+{-# LINE 111 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 111 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (atMost 2) 3)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:120: "
+{-# LINE 120 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 120 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (between 2 3) 1)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:122: "
+{-# LINE 122 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 122 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (between 2 3) 2)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:124: "
+{-# LINE 124 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 124 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (between 2 3) 3)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:126: "
+{-# LINE 126 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 126 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (meetsMultiplicity (between 2 3) 4)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:133: "
+{-# LINE 133 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 133 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (exhaustable anyMultiplicity)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:135: "
+{-# LINE 135 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 135 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (exhaustable (atLeast 2))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:137: "
+{-# LINE 137 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 137 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (exhaustable (atMost 3))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:139: "
+{-# LINE 139 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 139 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (exhaustable (between 0 2))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:146: "
+{-# LINE 146 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 146 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (feasible once)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:148: "
+{-# LINE 148 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 148 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (feasible 0)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Multiplicity:150: "
+{-# LINE 150 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+ DocTest.example
+{-# LINE 150 "src/Test/HMock/Internal/Multiplicity.hs" #-}
+      (feasible (once - 2))
+  [ExpectedLine [LineChunk "False"]]
diff --git a/test/DocTests/Test/HMock/Internal/Predicates.hs b/test/DocTests/Test/HMock/Internal/Predicates.hs
new file mode 100644
--- /dev/null
+++ b/test/DocTests/Test/HMock/Internal/Predicates.hs
@@ -0,0 +1,898 @@
+-- Do not edit! Automatically created with doctest-extract from src/Test/HMock/Internal/Predicates.hs
+{-# LINE 24 "src/Test/HMock/Internal/Predicates.hs" #-}
+
+{-# OPTIONS_GHC -XTemplateHaskell #-}
+{-# OPTIONS_GHC -XTypeApplications #-}
+{-# OPTIONS_GHC -Wno-type-defaults #-}
+module DocTests.Test.HMock.Internal.Predicates where
+
+import Test.HMock.Internal.Predicates
+import Test.DocTest.Base
+import qualified Test.DocTest.Driver as DocTest
+
+{-# LINE 28 "src/Test/HMock/Internal/Predicates.hs" #-}
+
+test :: DocTest.T ()
+test = do
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:44: "
+{-# LINE 44 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 44 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept anything "foo")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:46: "
+{-# LINE 46 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 46 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept anything undefined)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:57: "
+{-# LINE 57 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 57 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (eq "foo") "foo")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:59: "
+{-# LINE 59 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 59 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (eq "foo") "bar")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:70: "
+{-# LINE 70 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 70 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (neq "foo") "foo")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:72: "
+{-# LINE 72 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 72 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (neq "foo") "bar")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:83: "
+{-# LINE 83 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 83 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (gt 5) 4)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:85: "
+{-# LINE 85 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 85 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (gt 5) 5)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:87: "
+{-# LINE 87 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 87 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (gt 5) 6)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:99: "
+{-# LINE 99 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 99 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (geq 5) 4)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:101: "
+{-# LINE 101 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 101 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (geq 5) 5)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:103: "
+{-# LINE 103 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 103 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (geq 5) 6)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:114: "
+{-# LINE 114 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 114 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt 5) 4)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:116: "
+{-# LINE 116 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 116 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt 5) 5)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:118: "
+{-# LINE 118 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 118 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt 5) 6)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:129: "
+{-# LINE 129 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 129 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (leq 5) 4)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:131: "
+{-# LINE 131 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 131 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (leq 5) 5)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:133: "
+{-# LINE 133 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 133 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (leq 5) 6)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:144: "
+{-# LINE 144 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 144 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept true True)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:146: "
+{-# LINE 146 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 146 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept true False)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:153: "
+{-# LINE 153 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 153 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept false True)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:155: "
+{-# LINE 155 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 155 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept false False)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:163: "
+{-# LINE 163 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 163 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (just (eq "value")) Nothing)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:165: "
+{-# LINE 165 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 165 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (just (eq "value")) (Just "value"))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:167: "
+{-# LINE 167 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 167 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (just (eq "value")) (Just "wrong value"))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:179: "
+{-# LINE 179 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 179 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (left (eq "value")) (Left "value"))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:181: "
+{-# LINE 181 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 181 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (left (eq "value")) (Right "value"))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:183: "
+{-# LINE 183 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 183 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (left (eq "value")) (Left "wrong value"))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:195: "
+{-# LINE 195 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 195 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (right (eq "value")) (Right "value"))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:197: "
+{-# LINE 197 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 197 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (right (eq "value")) (Right "wrong value"))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:199: "
+{-# LINE 199 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 199 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (right (eq "value")) (Left "value"))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:211: "
+{-# LINE 211 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 211 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (zipP (eq "foo") (eq "bar")) ("foo", "bar"))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:213: "
+{-# LINE 213 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 213 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (zipP (eq "foo") (eq "bar")) ("bar", "foo"))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:225: "
+{-# LINE 225 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 225 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("foo", "bar", "qux"))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:227: "
+{-# LINE 227 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 227 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("qux", "bar", "foo"))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:239: "
+{-# LINE 239 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 239 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (1, 2, 3, 4))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:241: "
+{-# LINE 241 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 241 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (4, 3, 2, 1))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:259: "
+{-# LINE 259 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 259 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5)) (1, 2, 3, 4, 5))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:261: "
+{-# LINE 261 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 261 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5)) (5, 4, 3, 2, 1))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:280: "
+{-# LINE 280 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 280 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt "foo" `andP` gt "bar") "eta")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:282: "
+{-# LINE 282 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 282 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt "foo" `andP` gt "bar") "quz")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:284: "
+{-# LINE 284 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 284 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt "foo" `andP` gt "bar") "alpha")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:295: "
+{-# LINE 295 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 295 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt "bar" `orP` gt "foo") "eta")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:297: "
+{-# LINE 297 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 297 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt "bar" `orP` gt "foo") "quz")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:299: "
+{-# LINE 299 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 299 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (lt "bar" `orP` gt "foo") "alpha")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:311: "
+{-# LINE 311 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 311 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (notP (eq "negative")) "positive")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:313: "
+{-# LINE 313 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 313 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (notP (eq "negative")) "negative")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:324: "
+{-# LINE 324 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 324 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (startsWith "fun") "fungible")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:326: "
+{-# LINE 326 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 326 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (startsWith "gib") "fungible")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:337: "
+{-# LINE 337 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 337 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (endsWith "ow") "crossbow")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:339: "
+{-# LINE 339 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 339 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (endsWith "ow") "trebuchet")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:351: "
+{-# LINE 351 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 351 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (hasSubstr "i") "team")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:353: "
+{-# LINE 353 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 353 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (hasSubstr "i") "partnership")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:365: "
+{-# LINE 365 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 365 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (hasSubsequence [1..5]) [1, 2, 3, 4, 5])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:367: "
+{-# LINE 367 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 367 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (hasSubsequence [1..5]) [0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:369: "
+{-# LINE 369 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 369 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (hasSubsequence [1..5]) [2, 3, 5, 7, 11])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:381: "
+{-# LINE 381 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 381 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (caseInsensitive startsWith "foo") "FOOTBALL!")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:383: "
+{-# LINE 383 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 383 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (caseInsensitive endsWith "ball") "soccer")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:385: "
+{-# LINE 385 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 385 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (caseInsensitive eq "time") "TIME")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:387: "
+{-# LINE 387 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 387 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (caseInsensitive gt "NOTHING") "everything")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:412: "
+{-# LINE 412 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 412 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (matchesRegex "x{2,5}y?") "xxxy")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:414: "
+{-# LINE 414 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 414 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (matchesRegex "x{2,5}y?") "xyy")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:416: "
+{-# LINE 416 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 416 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (matchesRegex "x{2,5}y?") "wxxxyz")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:439: "
+{-# LINE 439 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 439 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XXXY")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:441: "
+{-# LINE 441 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 441 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XYY")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:443: "
+{-# LINE 443 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 443 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:472: "
+{-# LINE 472 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 472 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsRegex "x{2,5}y?") "xxxy")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:474: "
+{-# LINE 474 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 474 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsRegex "x{2,5}y?") "xyy")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:476: "
+{-# LINE 476 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 476 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsRegex "x{2,5}y?") "wxxxyz")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:497: "
+{-# LINE 497 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 497 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsCaseInsensitiveRegex "x{2,5}y?") "XXXY")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:499: "
+{-# LINE 499 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 499 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsCaseInsensitiveRegex "x{2,5}y?") "XYY")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:501: "
+{-# LINE 501 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 501 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:522: "
+{-# LINE 522 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 522 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept isEmpty [])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:524: "
+{-# LINE 524 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 524 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept isEmpty [1, 2, 3])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:526: "
+{-# LINE 526 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 526 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept isEmpty "")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:528: "
+{-# LINE 528 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 528 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept isEmpty "gas tank")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:539: "
+{-# LINE 539 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 539 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept nonEmpty [])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:541: "
+{-# LINE 541 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 541 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept nonEmpty [1, 2, 3])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:543: "
+{-# LINE 543 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 543 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept nonEmpty "")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:545: "
+{-# LINE 545 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 545 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept nonEmpty "gas tank")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:557: "
+{-# LINE 557 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 557 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (sizeIs (lt 3)) ['a' .. 'f'])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:559: "
+{-# LINE 559 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 559 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (sizeIs (lt 3)) ['a' .. 'b'])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:571: "
+{-# LINE 571 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 571 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:573: "
+{-# LINE 573 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 573 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4, 5])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:575: "
+{-# LINE 575 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 575 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 10, 4])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:589: "
+{-# LINE 589 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 589 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:591: "
+{-# LINE 591 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 591 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [2, 3, 1])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:593: "
+{-# LINE 593 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 593 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3, 4])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:595: "
+{-# LINE 595 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 595 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 3])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:611: "
+{-# LINE 611 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 611 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (each (gt 5)) [4, 5, 6])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:613: "
+{-# LINE 613 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 613 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (each (gt 5)) [6, 7, 8])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:615: "
+{-# LINE 615 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 615 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (each (gt 5)) [])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:627: "
+{-# LINE 627 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 627 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (contains (gt 5)) [3, 4, 5])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:629: "
+{-# LINE 629 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 629 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (contains (gt 5)) [4, 5, 6])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:631: "
+{-# LINE 631 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 631 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (contains (gt 5)) [])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:645: "
+{-# LINE 645 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 645 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsAll [eq "foo", eq "bar"]) ["bar", "foo"])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:647: "
+{-# LINE 647 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 647 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsAll [eq "foo", eq "bar"]) ["foo"])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:649: "
+{-# LINE 649 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 649 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsAll [eq "foo", eq "bar"]) ["foo", "bar", "qux"])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:662: "
+{-# LINE 662 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 662 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "foo"])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:664: "
+{-# LINE 664 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 664 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "bar"])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:666: "
+{-# LINE 666 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 666 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "qux"])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:678: "
+{-# LINE 678 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 678 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsKey (eq "foo")) [("foo", 1), ("bar", 2)])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:680: "
+{-# LINE 680 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 680 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsKey (eq "foo")) [("bar", 1), ("qux", 2)])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:693: "
+{-# LINE 693 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 693 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsEntry (eq "foo") (gt 10)) [("foo", 12), ("bar", 5)])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:695: "
+{-# LINE 695 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 695 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsEntry (eq "foo") (gt 10)) [("foo", 5), ("bar", 12)])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:697: "
+{-# LINE 697 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 697 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (containsEntry (eq "foo") (gt 10)) [("bar", 12)])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:710: "
+{-# LINE 710 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 710 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (keysAre [eq "a", eq "b", eq "c"]) [("a", 1), ("b", 2), ("c", 3)])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:712: "
+{-# LINE 712 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 712 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (keysAre [eq "a", eq "b", eq "c"]) [("c", 1), ("b", 2), ("a", 3)])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:714: "
+{-# LINE 714 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 714 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (keysAre [eq "a", eq "b", eq "c"]) [("a", 1), ("c", 3)])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:716: "
+{-# LINE 716 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 716 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (keysAre [eq "a", eq "b"]) [("a", 1), ("b", 2), ("c", 3)])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:732: "
+{-# LINE 732 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 732 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(1, 2), (3, 4)])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:734: "
+{-# LINE 734 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 734 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(3, 4), (1, 2)])
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:736: "
+{-# LINE 736 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 736 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(1, 4), (3, 2)])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:738: "
+{-# LINE 738 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 738 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(1, 2), (3, 4), (5, 6)])
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:759: "
+{-# LINE 759 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 759 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (eq 1.0) (sum (replicate 100 0.01)))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:766: "
+{-# LINE 766 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 766 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (approxEq 1.0) (sum (replicate 100 0.01)))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:768: "
+{-# LINE 768 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 768 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (approxEq 1.0) (sum (replicate 100 0.009999)))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:781: "
+{-# LINE 781 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 781 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept finite 1.0)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:783: "
+{-# LINE 783 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 783 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept finite (0 / 0))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:785: "
+{-# LINE 785 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 785 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept finite (1 / 0))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:796: "
+{-# LINE 796 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 796 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept infinite 1.0)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:798: "
+{-# LINE 798 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 798 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept infinite (0 / 0))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:800: "
+{-# LINE 800 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 800 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept infinite (1 / 0))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:811: "
+{-# LINE 811 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 811 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept nAn 1.0)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:813: "
+{-# LINE 813 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 813 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept nAn (0 / 0))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:815: "
+{-# LINE 815 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 815 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept nAn (1 / 0))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:828: "
+{-# LINE 828 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 828 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (is even) 3)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:830: "
+{-# LINE 830 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 830 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (is even) 4)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:843: "
+{-# LINE 843 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 843 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept $(qIs [| even |]) 3)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:845: "
+{-# LINE 845 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 845 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept $(qIs [| even |]) 4)
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:848: "
+{-# LINE 848 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 848 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (show $(qIs [| even |]))
+  [ExpectedLine [LineChunk "\"even\""]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:862: "
+{-# LINE 862 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 862 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (with abs (gt 5)) (-6))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:864: "
+{-# LINE 864 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 864 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (with abs (gt 5)) (-5))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:866: "
+{-# LINE 866 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 866 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (with reverse (eq "olleh")) "hello")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:868: "
+{-# LINE 868 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 868 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (with reverse (eq "olleh")) "goodbye")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:882: "
+{-# LINE 882 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 882 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept ($(qWith [| abs |]) (gt 5)) (-6))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:884: "
+{-# LINE 884 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 884 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept ($(qWith [| abs |]) (gt 5)) (-5))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:886: "
+{-# LINE 886 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 886 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept ($(qWith [| reverse |]) (eq "olleh")) "hello")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:888: "
+{-# LINE 888 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 888 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept ($(qWith [| reverse |]) (eq "olleh")) "goodbye")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:891: "
+{-# LINE 891 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 891 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (show ($(qWith [| abs |]) (gt 5)))
+  [ExpectedLine [LineChunk "\"abs: > 5\""]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:907: "
+{-# LINE 907 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 907 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept $(qMatch [p| Just (Left _) |]) Nothing)
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:909: "
+{-# LINE 909 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 909 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept $(qMatch [p| Just (Left _) |]) (Just (Left 5)))
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:911: "
+{-# LINE 911 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 911 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept $(qMatch [p| Just (Left _) |]) (Just (Right 5)))
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:914: "
+{-# LINE 914 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 914 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (show $(qMatch [p| Just (Left _) |]))
+  [ExpectedLine [LineChunk "\"Just (Left _)\""]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:930: "
+{-# LINE 930 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 930 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (typed @String anything) "foo")
+  [ExpectedLine [LineChunk "True"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:932: "
+{-# LINE 932 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 932 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (typed @String (sizeIs (gt 5))) "foo")
+  [ExpectedLine [LineChunk "False"]]
+ DocTest.printPrefix "Test.HMock.Internal.Predicates:934: "
+{-# LINE 934 "src/Test/HMock/Internal/Predicates.hs" #-}
+ DocTest.example
+{-# LINE 934 "src/Test/HMock/Internal/Predicates.hs" #-}
+      (accept (typed @String anything) (42 :: Int))
+  [ExpectedLine [LineChunk "False"]]
diff --git a/test/ExpectSet.hs b/test/ExpectSet.hs
new file mode 100644
--- /dev/null
+++ b/test/ExpectSet.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module ExpectSet where
+
+import Control.Arrow (second)
+import Data.List (foldl')
+import Test.HMock.Internal.ExpectSet
+import Test.HMock.Internal.Multiplicity
+import Test.Hspec
+import Test.Hspec.QuickCheck (modifyMaxSuccess)
+import Test.QuickCheck
+
+instance Arbitrary (ExpectSet Int) where
+  arbitrary = do
+    n <- getSize
+    frequency
+      [ (1, return ExpectNothing),
+        (5, ExpectStep <$> choose (1, 100)),
+        (n, scale (`div` 2) $ ExpectSequence <$> arbitrary <*> arbitrary),
+        (n, scale (`div` 2) $ ExpectInterleave <$> arbitrary <*> arbitrary),
+        (n, scale (`div` 2) $ ExpectEither <$> arbitrary <*> arbitrary),
+        (n, scale (subtract 1) $ ExpectMulti <$> arbitrary <*> arbitrary),
+        (n, scale (subtract 1) $ ExpectConsecutive <$> arbitrary <*> arbitrary)
+      ]
+
+  shrink ExpectNothing = []
+  shrink (ExpectStep _) = [ExpectNothing]
+  shrink (ExpectSequence e f) =
+    [ExpectSequence e' f | e' <- shrink e]
+      ++ [ExpectSequence e f' | f' <- shrink f]
+      ++ [e, f]
+  shrink (ExpectInterleave e f) =
+    [ExpectSequence e' f | e' <- shrink e]
+      ++ [ExpectSequence e f' | f' <- shrink f]
+      ++ [e, f]
+  shrink (ExpectEither e f) =
+    [ExpectSequence e' f | e' <- shrink e]
+      ++ [ExpectSequence e f' | f' <- shrink f]
+      ++ [e, f]
+  shrink (ExpectMulti mult e) =
+    [ExpectMulti mult' e | mult' <- shrink mult]
+      ++ [ExpectMulti mult e' | e' <- shrink e]
+      ++ [e]
+  shrink (ExpectConsecutive mult e) =
+    [ExpectConsecutive mult' e | mult' <- shrink mult]
+      ++ [ExpectConsecutive mult e' | e' <- shrink e]
+      ++ [e]
+
+instance Arbitrary Multiplicity where
+  arbitrary = normalize <$> (Multiplicity <$> arbitrary <*> arbitrary)
+
+liveSteps' :: ExpectSet step -> [(step, ExpectSet step)]
+liveSteps' = map (second simplify) . liveSteps
+
+expectSetSpec :: SpecWith ()
+expectSetSpec = modifyMaxSuccess (const 1000) $ do
+  describe "ExpectSet" $ do
+    describe "satisfied" $ do
+      it "agrees with excess" $
+        property $
+          \(es :: ExpectSet Int) ->
+            if satisfied es
+              then excess es === ExpectNothing
+              else excess es =/= ExpectNothing
+
+    let sameBehavior ::
+          (Show a, Eq a) => Int -> ExpectSet a -> ExpectSet a -> Property
+        sameBehavior 0 e f = satisfied e === satisfied f
+        sameBehavior d e f =
+          satisfied e === satisfied f
+            .&&. foldl' (.&&.) (property True) (zipWith (===) esteps fsteps)
+            .&&. foldl'
+              (.&&.)
+              (property True)
+              (zipWith (sameBehavior (d - 1)) econts fconts)
+          where
+            (esteps, econts) = unzip (liveSteps e)
+            (fsteps, fconts) = unzip (liveSteps f)
+
+    describe "simplify" $ do
+      it "always terminates" $
+        property $
+          \(es :: ExpectSet Int) ->
+            -- Hack to force deep evaluation
+            let es' = simplify es in formatExpectSet es' == formatExpectSet es'
+
+      it "preserves behavior" $
+        property $
+          \(es :: ExpectSet Int) -> sameBehavior 3 es (simplify es)
+
+    describe "liveSteps" $ do
+      it "expects nothing" $
+        example $ liveSteps' (ExpectNothing :: ExpectSet Int) `shouldBe` []
+
+      it "expects a step" $
+        example $
+          liveSteps' (ExpectStep 42)
+            `shouldBe` [(42 :: Int, ExpectNothing)]
+
+      it "expects the first step in a sequence" $
+        example $ do
+          let input = ExpectSequence (ExpectStep 1) (ExpectStep 2)
+          liveSteps' input `shouldBe` [(1 :: Int, ExpectStep 2)]
+
+      it "skips an exhaustable first step in a sequence" $
+        example $ do
+          let input = ExpectSequence ExpectNothing (ExpectStep 2)
+          liveSteps' input `shouldBe` [(2 :: Int, ExpectNothing)]
+
+      it "skips an exhaustable first step in a sequence" $
+        example $ do
+          let input = ExpectSequence ExpectNothing (ExpectStep 2)
+          liveSteps' input `shouldBe` [(2 :: Int, ExpectNothing)]
+
+      it "expects either step in an interleave" $
+        example $ do
+          let input = ExpectInterleave (ExpectStep 1) (ExpectStep 2)
+          liveSteps' input
+            `shouldBe` [(1 :: Int, ExpectStep 2), (2, ExpectStep 1)]
+
+      it "optional has same behavior as or-empty" $
+        property $
+          \(es :: ExpectSet Int) ->
+            let a = ExpectEither ExpectNothing es
+                b = ExpectMulti (atMost 1) es
+             in sameBehavior 3 a b
diff --git a/test/Extras.hs b/test/Extras.hs
new file mode 100644
--- /dev/null
+++ b/test/Extras.hs
@@ -0,0 +1,165 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Extras where
+
+import Data.List (isPrefixOf)
+import Data.Typeable (Typeable)
+import Test.HMock
+import Test.HMock.Internal.Multiplicity
+import Test.Hspec
+import Test.QuickCheck hiding (once)
+
+instance Arbitrary Multiplicity where
+  arbitrary = normalize <$> (Multiplicity <$> arbitrary <*> arbitrary)
+
+multiplicityTests :: SpecWith ()
+multiplicityTests = do
+  describe "Multiplicity" $ do
+    it "describes itself" $
+      example $ do
+        show once `shouldBe` "once"
+        show anyMultiplicity `shouldBe` "any number of times"
+        show (2 :: Multiplicity) `shouldBe` "twice"
+        show (3 :: Multiplicity) `shouldBe` "3 times"
+        show (atLeast 1) `shouldBe` "at least once"
+        show (atLeast 2) `shouldBe` "at least twice"
+        show (atLeast 3) `shouldBe` "at least 3 times"
+        show (atMost 1) `shouldBe` "at most once"
+        show (atMost 2) `shouldBe` "at most twice"
+        show (atMost 3) `shouldBe` "at most 3 times"
+        show (between 2 3) `shouldBe` "2 or 3 times"
+        show (between 2 5) `shouldBe` "2 to 5 times"
+
+    it "correctly implements sum" $
+      property $
+        \m1 m2 (NonNegative n) ->
+          let natSums k = [(i, k - i) | i <- [0 .. k]]
+           in meetsMultiplicity (m1 + m2) n
+                == any
+                  (\(j, k) -> meetsMultiplicity m1 j && meetsMultiplicity m2 k)
+                  (natSums n)
+
+predicateTests :: SpecWith ()
+predicateTests = do
+  describe "Predicate" $ do
+    it "describes itself" $
+      example $ do
+        show anything `shouldBe` "anything"
+        show (eq "foo") `shouldBe` "\"foo\""
+        show (neq "foo") `shouldBe` "≠ \"foo\""
+        show (gt "foo") `shouldBe` "> \"foo\""
+        show (geq "foo") `shouldBe` "≥ \"foo\""
+        show (lt "foo") `shouldBe` "< \"foo\""
+        show (leq "foo") `shouldBe` "≤ \"foo\""
+        show (just (gt "foo")) `shouldBe` "Just (> \"foo\")"
+        show (left (gt "foo")) `shouldBe` "Left (> \"foo\")"
+        show (right (gt "foo")) `shouldBe` "Right (> \"foo\")"
+        show (zipP (eq 1) (eq 2) :: Predicate (Int, Int)) `shouldBe` "(1,2)"
+        show (zip3P (eq 1) (eq 2) (eq 3) :: Predicate (Int, Int, Int))
+          `shouldBe` "(1,2,3)"
+        show
+          ( zip4P (eq 1) (eq 2) (eq 3) (eq 4) ::
+              Predicate (Int, Int, Int, Int)
+          )
+          `shouldBe` "(1,2,3,4)"
+        show
+          ( zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5) ::
+              Predicate (Int, Int, Int, Int, Int)
+          )
+          `shouldBe` "(1,2,3,4,5)"
+        show (lt "foo" `andP` gt "bar")
+          `shouldBe` "< \"foo\" and > \"bar\""
+        show (lt "bar" `orP` gt "foo")
+          `shouldBe` "< \"bar\" or > \"foo\""
+        show (notP (gt "foo")) `shouldBe` "not > \"foo\""
+        show (startsWith "fun") `shouldBe` "starts with \"fun\""
+        show (endsWith "ing") `shouldBe` "ends with \"ing\""
+        show (hasSubstr "i") `shouldBe` "has substring \"i\""
+        show (hasSubsequence "abc") `shouldBe` "has subsequence \"abc\""
+        show (caseInsensitive eq "foo") `shouldBe` "(case insensitive) \"foo\""
+        show (caseInsensitive startsWith "foo")
+          `shouldBe` "(case insensitive) starts with \"foo\""
+        show (caseInsensitive endsWith "foo")
+          `shouldBe` "(case insensitive) ends with \"foo\""
+        show (matchesRegex "foo" :: Predicate String)
+          `shouldBe` "/foo/"
+        show (matchesCaseInsensitiveRegex "foo" :: Predicate String)
+          `shouldBe` "/foo/i"
+        show (containsRegex "foo" :: Predicate String)
+          `shouldBe` "contains /foo/"
+        show (containsCaseInsensitiveRegex "foo" :: Predicate String)
+          `shouldBe` "contains /foo/i"
+        show (isEmpty :: Predicate [()]) `shouldBe` "empty"
+        show (nonEmpty :: Predicate [()]) `shouldBe` "nonempty"
+        show (sizeIs (gt 5) :: Predicate [()]) `shouldBe` "size > 5"
+        show (elemsAre [gt 5, eq 5] :: Predicate [Int]) `shouldBe` "[> 5,5]"
+        show (unorderedElemsAre [gt 5, eq 5] :: Predicate [Int])
+          `shouldBe` "(any order) [> 5,5]"
+        show (each (gt 5) :: Predicate [Int]) `shouldBe` "each (> 5)"
+        show (contains (gt 5) :: Predicate [Int]) `shouldBe` "contains (> 5)"
+        show (containsAll [gt 5] :: Predicate [Int])
+          `shouldBe` "contains all of [> 5]"
+        show (containsOnly [gt 5] :: Predicate [Int])
+          `shouldBe` "contains only [> 5]"
+        show (containsKey (eq "foo") :: Predicate [(String, String)])
+          `shouldBe` "contains key \"foo\""
+        show
+          ( containsEntry (eq "foo") (eq "bar") ::
+              Predicate [(String, String)]
+          )
+          `shouldBe` "contains entry (\"foo\",\"bar\")"
+        show (keysAre [eq 1, eq 2, eq 3] :: Predicate [(Int, String)])
+          `shouldBe` "keys are [1,2,3]"
+        show
+          ( entriesAre [(eq 1, eq "one"), (eq 2, eq "two")] ::
+              Predicate [(Int, String)]
+          )
+          `shouldBe` "entries are [(1,\"one\"),(2,\"two\")]"
+        show (approxEq 1.0 :: Predicate Double) `shouldBe` "≈ 1.0"
+        show (finite :: Predicate Double) `shouldBe` "finite"
+        show (infinite :: Predicate Double) `shouldBe` "infinite"
+        show (nAn :: Predicate Double) `shouldBe` "NaN"
+        show (is even :: Predicate Int)
+          `shouldSatisfy` ("custom predicate at " `isPrefixOf`)
+        show ($(qIs [|even|]) :: Predicate Int) `shouldBe` "even"
+        show (with length (gt 5) :: Predicate String)
+          `shouldSatisfy` ("property at " `isPrefixOf`)
+        show ($(qWith [|length|]) (gt 5) :: Predicate String)
+          `shouldBe` "length: > 5"
+
+    it "matches patterns" $
+      example $ do
+        let p = $(qMatch [p|Just (Left _)|])
+        show p `shouldBe` "Just (Left _)"
+
+        accept p (Just (Left "foo")) `shouldBe` True
+        accept p (Just (Right "foo")) `shouldBe` False
+        accept p Nothing `shouldBe` False
+
+    it "checks types" $
+      example $ do
+        let p1 :: Typeable a => Predicate a
+            p1 = typed @String anything
+
+            p2 :: Typeable a => Predicate a
+            p2 = typed @String (eq "foo")
+
+        show (p1 :: Predicate String)
+          `shouldBe` "anything :: [Char]"
+        show (p1 :: Predicate Int)
+          `shouldBe` "anything :: [Char]"
+
+        accept p1 "foo" `shouldBe` True
+        accept p1 "bar" `shouldBe` True
+        accept p1 () `shouldBe` False
+        accept p1 (5 :: Int) `shouldBe` False
+
+        show (p2 :: Predicate String)
+          `shouldBe` "\"foo\" :: [Char]"
+        show (p2 :: Predicate Int)
+          `shouldBe` "\"foo\" :: [Char]"
+
+        accept p2 "foo" `shouldBe` True
+        accept p2 "bar" `shouldBe` False
+        accept p2 (5 :: Int) `shouldBe` False
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,21 @@
+import Classes (classTests)
+import Core (coreTests)
+import Demo (demoSpec)
+import qualified DocTests.All
+import ExpectSet
+import Extras (multiplicityTests, predicateTests)
+import qualified Test.DocTest.Driver as DocTest
+import Test.Hspec (hspec)
+import TH
+
+main :: IO ()
+main = do
+  hspec $ do
+    multiplicityTests
+    predicateTests
+    expectSetSpec
+    coreTests
+    classTests
+    thUtilSpec
+    demoSpec
+  DocTest.run DocTests.All.main
diff --git a/test/PolysemyTest.hs b/test/PolysemyTest.hs
new file mode 100644
--- /dev/null
+++ b/test/PolysemyTest.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
+
+module PolysemyTest where
+
+import Data.Kind (Type)
+import Data.Typeable (Typeable)
+import Polysemy
+
+data FileSystem (m :: Type -> Type) a where
+  ReadFile :: FilePath -> FileSystem m String
+  WriteFile :: FilePath -> String -> FileSystem m ()
+
+makeSem ''FileSystem
+
+class Mockable (eff :: Effect) where
+  data Action eff :: (Type -> Type) -> Type -> Type
+
+instance Mockable FileSystem where
+  data Action FileSystem m a where
+    ReadFile_ :: FilePath -> Action FileSystem m String
+    WriteFile_ :: FilePath -> String -> Action FileSystem m ()
+
+data Step (m :: Type -> Type) where
+  Step ::
+    (Mockable eff, Typeable eff, Typeable m, Typeable a) =>
+    Action eff m a ->
+    m a ->
+    Step m
+
+type ExpectSet m = [Step m]
+
+data Mock m a where
+  Expect :: ExpectSet m -> Mock m ()
+  MockAction :: Mockable eff => Action eff m a -> Mock m a
+
+makeSem ''Mock
+
+interpretFSToMock :: Member Mock r => Sem (FileSystem ': r) a -> Sem r a
+interpretFSToMock = interpret $ \case
+  ReadFile f -> mockAction (ReadFile_ f)
+  WriteFile f s -> mockAction (WriteFile_ f s)
+
+{-
+interpretMock :: forall r a. Sem (Mock ': r) a -> Sem r a
+interpretMock = do
+    (finalES, r) <- runState [] $ reinterpretH $ \case
+        Expect es -> do
+            es' <- get
+            put (es ++ es')
+            return ()
+        MockAction a -> error "Unimplemented"
+    unless (null finalES) $ error "Unmet expectations"
+    return r
+-}
diff --git a/test/QuasiMock.hs b/test/QuasiMock.hs
new file mode 100644
--- /dev/null
+++ b/test/QuasiMock.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module QuasiMock where
+
+import Control.Monad.Trans (MonadIO, liftIO)
+import Data.Default (Default (..))
+import Data.Generics (Typeable, everything, mkQ)
+import Language.Haskell.TH hiding (Match)
+import Language.Haskell.TH.Syntax hiding (Match)
+import Test.HMock
+import Test.HMock.TH (deriveMockableBase)
+import Util.TH (reifyInstancesStatic, reifyStatic)
+
+#if !MIN_VERSION_base(4, 13, 0)
+import Control.Monad.Fail (MonadFail)
+#endif
+
+deriveMockableBase ''Quasi
+
+-- Because not all methods of Quasi are mockable, the instance must be written
+-- by hand.
+instance (Typeable m, MonadFail m, MonadIO m) => Quasi (MockT m) where
+  -- Mocks
+  qReport b s = mockMethod (QReport b s)
+  qLookupName b s = mockMethod (QLookupName b s)
+  qReify n = mockDefaultlessMethod (QReify n)
+  qReifyFixity n = mockMethod (QReifyFixity n)
+  qReifyInstances n ts = mockMethod (QReifyInstances n ts)
+  qReifyRoles n = mockMethod (QReifyRoles n)
+  qReifyModule m = mockDefaultlessMethod (QReifyModule m)
+  qReifyConStrictness n = mockMethod (QReifyConStrictness n)
+  qLocation = mockDefaultlessMethod QLocation
+  qAddDependentFile f = mockMethod (QAddDependentFile f)
+  qAddTopDecls ds = mockMethod (QAddTopDecls ds)
+  qAddModFinalizer f = mockMethod (QAddModFinalizer f)
+  qAddCorePlugin s = mockMethod (QAddCorePlugin s)
+  qPutQ a = mockMethod (QPutQ a)
+  qIsExtEnabled e = mockDefaultlessMethod (QIsExtEnabled e)
+  qExtsEnabled = mockMethod QExtsEnabled
+
+#if MIN_VERSION_template_haskell(2, 14, 0)
+  qAddTempFile s = mockMethod (QAddTempFile s)
+  qAddForeignFilePath l s = mockMethod (QAddForeignFilePath l s)
+#else
+  qAddForeignFile l s = mockMethod (QAddForeignFile l s)
+#endif
+
+#if MIN_VERSION_template_haskell(2, 16, 0)
+  qReifyType n = mockDefaultlessMethod (QReifyType n)
+#endif
+
+  -- Methods delegated to IO
+  qNewName s = liftIO (qNewName s)
+
+  -- Non-mockable methods that cannot be lifted to IO
+  qGetQ = error "qGetQ"
+  qRecover = error "qRecover"
+  qReifyAnnotations = error "qReifyAnnotations"
+
+functionType :: [Type] -> Bool
+functionType = everything (||) (mkQ False isArrow)
+  where
+    isArrow ArrowT = True
+    isArrow _ = False
+
+instance Mockable Quasi where
+  setupMockable _ = do
+    expectAny $ QIsExtEnabled_ anything |-> True
+
+    expectAny $ QReify ''String |-> $(reifyStatic ''String)
+    expectAny $ QReify ''Char |-> $(reifyStatic ''Char)
+    expectAny $ QReify ''Int |-> $(reifyStatic ''Int)
+    expectAny $ QReify ''Bool |-> $(reifyStatic ''Bool)
+    expectAny $ QReify ''Enum |-> $(reifyStatic ''Enum)
+    expectAny $ QReify ''Monad |-> $(reifyStatic ''Monad)
+    expectAny $
+      QReifyInstances ''Show [ConT ''String]
+        |-> $(reifyInstancesStatic ''Show [ConT ''String])
+    expectAny $
+      QReifyInstances ''Eq [ConT ''String]
+        |-> $(reifyInstancesStatic ''Eq [ConT ''String])
+    expectAny $
+      QReifyInstances ''Show [ConT ''Char]
+        |-> $(reifyInstancesStatic ''Show [ConT ''Char])
+    expectAny $
+      QReifyInstances ''Eq [ConT ''Char]
+        |-> $(reifyInstancesStatic ''Eq [ConT ''Char])
+    expectAny $
+      QReifyInstances ''Show [ConT ''Int]
+        |-> $(reifyInstancesStatic ''Show [ConT ''Int])
+    expectAny $
+      QReifyInstances ''Eq [ConT ''Int]
+        |-> $(reifyInstancesStatic ''Eq [ConT ''Int])
+    expectAny $
+      QReifyInstances ''Show [ConT ''Bool]
+        |-> $(reifyInstancesStatic ''Show [ConT ''Bool])
+    expectAny $
+      QReifyInstances ''Eq [ConT ''Bool]
+        |-> $(reifyInstancesStatic ''Eq [ConT ''Bool])
+    expectAny $
+      QReifyInstances ''Default [TupleT 0]
+        |-> $(reifyInstancesStatic ''Default [TupleT 0])
+    expectAny $
+      QReifyInstances ''Default [ConT ''String]
+        |-> $(reifyInstancesStatic ''Default [ConT ''String])
+    expectAny $
+      QReifyInstances ''Default [ConT ''Int]
+        |-> $(reifyInstancesStatic ''Default [ConT ''Int])
+    expectAny $
+      QReifyInstances ''Default [AppT (ConT ''Maybe) (ConT ''Bool)]
+        |-> $(reifyInstancesStatic ''Default [AppT (ConT ''Maybe) (ConT ''Bool)])
+    expectAny $
+      QReifyInstances_ (eq ''Show) (is functionType) |-> []
+    expectAny $
+      QReifyInstances_ (eq ''Eq) (is functionType) |-> []
+
+    expectAny $
+      QReifyInstances_ (eq ''Show) (elemsAre [$(qMatch [p|AppT ListT (VarT _)|])])
+        |-> $(reifyInstancesStatic ''Show [AppT ListT (VarT (mkName "a_0"))])
+    expectAny $
+      QReifyInstances_ (eq ''Eq) (elemsAre [$(qMatch [p|AppT ListT (VarT _)|])])
+        |-> $(reifyInstancesStatic ''Eq [AppT ListT (VarT (mkName "a_0"))])
diff --git a/test/TH.hs b/test/TH.hs
new file mode 100644
--- /dev/null
+++ b/test/TH.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module TH where
+
+import Control.Monad.Trans (liftIO)
+import Language.Haskell.TH
+import QuasiMock
+import Test.HMock
+import Test.HMock.Internal.TH.Util (resolveInstance, unifyTypes)
+import Test.Hspec
+import Util.TH (reifyInstancesStatic, reifyStatic)
+
+data NotShowable
+
+$(pure [])
+
+thUtilSpec :: SpecWith ()
+thUtilSpec = do
+  describe "unifyTypes" $ do
+    it "accepts identical types" $
+      example $
+        runMockT $ do
+          result <- runQ $ unifyTypes (ConT ''Bool) (ConT ''Bool)
+          liftIO $ result `shouldBe` Just []
+
+    it "rejects different types" $
+      example $
+        runMockT $ do
+          result <- runQ $ unifyTypes (ConT ''Bool) (ConT ''Int)
+          liftIO $ result `shouldBe` Nothing
+
+    it "unifies patterns with variables" $
+      example $
+        runMockT $ do
+          v <- runQ $ newName "a"
+          t1 <- runQ [t|Maybe ($(varT v), Int)|]
+          t2 <- runQ [t|Maybe (Bool, Int)|]
+          result <- runQ $ unifyTypes t1 t2
+          liftIO $ result `shouldBe` Just [(v, ConT ''Bool)]
+
+    it "substitutes synonyms" $
+      example $
+        runMockT $ do
+          v <- runQ $ newName "a"
+          t1 <- runQ [t|[$(varT v)]|]
+          t2 <- runQ [t|String|]
+          result <- runQ $ unifyTypes t1 t2
+          liftIO $ result `shouldBe` Just [(v, ConT ''Char)]
+
+  describe "resolveInstance" $ do
+    it "finds unrestricted instances" $
+      example $
+        runMockT $ do
+          result <- runQ $ resolveInstance ''Show (ConT ''String)
+          liftIO $ result `shouldBe` Just []
+
+    it "finds context on nested vars" $
+      example $
+        runMockT $ do
+          v <- runQ $ newName "a"
+          result <- runQ $ resolveInstance ''Show (AppT ListT (VarT v))
+          liftIO $ result `shouldBe` Just [AppT (ConT ''Show) (VarT v)]
+
+    it "recognizes when a nested type lacks instance" $
+      example $
+        runMockT $ do
+          expectAny $ QReify ''NotShowable |-> $(reifyStatic ''NotShowable)
+          expectAny $
+            QReifyInstances ''Show [ConT ''NotShowable]
+              |-> $(reifyInstancesStatic ''Show [ConT ''NotShowable])
+          expectAny $
+            QReifyInstances
+              ''Show
+              [AppT (AppT (TupleT 2) (ConT ''Int)) (ConT ''NotShowable)]
+              |-> $( reifyInstancesStatic
+                       ''Show
+                       [ AppT
+                           (AppT (TupleT 2) (ConT ''Int))
+                           (ConT ''NotShowable)
+                       ]
+                   )
+
+          t <- runQ [t|(Int, NotShowable)|]
+          result <- runQ $ resolveInstance ''Show t
+          liftIO $ result `shouldBe` Nothing
diff --git a/test/Util/DeriveRecursive.hs b/test/Util/DeriveRecursive.hs
new file mode 100644
--- /dev/null
+++ b/test/Util/DeriveRecursive.hs
@@ -0,0 +1,58 @@
+module Util.DeriveRecursive where
+
+import Control.Monad (replicateM)
+import Control.Monad.Extra (concatMapM)
+import Control.Monad.State (StateT, evalStateT, gets, modify)
+import Control.Monad.Trans (MonadTrans (lift))
+import Language.Haskell.TH
+import Data.List (foldl')
+
+deriveRecursive :: Maybe DerivStrategy -> Name -> Name -> Q [Dec]
+deriveRecursive strat cls ty = evalStateT (concatMapM defineIfNeeded [ty]) []
+  where
+    defineIfNeeded :: Name -> StateT [Name] Q [Dec]
+    defineIfNeeded t = do
+      done <- gets (t `elem`)
+      if done then return [] else modify (t :) >> defineInstance t
+
+    defineInstance :: Name -> StateT [Name] Q [Dec]
+    defineInstance t = do
+      info <- lift (reify t)
+      case info of
+        TyConI (DataD _ n vs _ cons _)
+          | n == t -> defineTypeAndCons t (length vs) cons
+        TyConI (NewtypeD _ n vs _ con _)
+          | n == t -> defineTypeAndCons t (length vs) [con]
+        TyConI (TySynD _ _ t') -> concatMapM defineIfNeeded (typeToCons t')
+        _ -> return []
+
+    defineTypeAndCons :: Name -> Int -> [Con] -> StateT [Name] Q [Dec]
+    defineTypeAndCons t nvars cons = do
+      vs <- replicateM nvars (lift (newName "v"))
+      let fullType = foldl' (\t' v -> AppT t' (VarT v)) (ConT t) vs
+      let cx = AppT (ConT cls) . VarT <$> vs
+      hasInstance <- lift (isInstance cls [fullType])
+      if hasInstance
+        then return []
+        else do
+          fieldDecls <-
+            concatMapM defineIfNeeded $
+              concatMap typeToCons $ concatMap conFieldTypes cons
+          return
+            ( StandaloneDerivD strat cx (AppT (ConT cls) fullType) :
+              fieldDecls
+            )
+
+    conFieldTypes :: Con -> [Type]
+    conFieldTypes (NormalC _ bts) = snd <$> bts
+    conFieldTypes (RecC _ vbts) = (\(_, _, t) -> t) <$> vbts
+    conFieldTypes (InfixC t1 _ t2) = [snd t1, snd t2]
+    conFieldTypes (ForallC _ _ con) = conFieldTypes con
+    conFieldTypes (GadtC _ bts _) = snd <$> bts
+    conFieldTypes (RecGadtC _ vbts _) = (\(_, _, t) -> t) <$> vbts
+
+    typeToCons :: Type -> [Name]
+    typeToCons (ConT c) = [c]
+    typeToCons (AppT ListT t) = typeToCons t
+    typeToCons (AppT t1 t2) = typeToCons t1 ++ typeToCons t2
+    typeToCons _ = []
diff --git a/test/Util/TH.hs b/test/Util/TH.hs
new file mode 100644
--- /dev/null
+++ b/test/Util/TH.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Util.TH (deriveRecursive, reifyStatic, reifyInstancesStatic) where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Util.DeriveRecursive (deriveRecursive)
+
+#if MIN_VERSION_template_haskell(2, 16, 0)
+-- Pre-define low-level instance to prevent deriveRecursive from trying.
+instance Lift Bytes where lift = undefined; liftTyped = undefined
+#endif
+
+deriveRecursive Nothing ''Lift ''Info
+
+reifyStatic :: Name -> Q Exp
+reifyStatic n = reify n >>= lift
+
+deriveRecursive Nothing ''Lift ''InstanceDec
+
+reifyInstancesStatic :: Name -> [Type] -> Q Exp
+reifyInstancesStatic n ts = reifyInstances n ts >>= lift