HMock 0.3.0.0 → 0.4.0.0

raw patch · 24 files changed

+2003/−1224 lines, 24 filesdep +arrayPVP ok

version bump matches the API change (PVP)

Dependencies added: array

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−1
• HMock.cabal +5/−2
• src/Test/HMock/Internal/FlowMatcher.hs +88/−0
• src/Test/HMock/Internal/Rule.hs +6/−3
• src/Test/HMock/Internal/State.hs +103/−8
• src/Test/HMock/Internal/TH.hs +69/−43
• src/Test/HMock/Internal/Util.hs +1/−1
• src/Test/HMock/MockMethod.hs +75/−31
• src/Test/HMock/MockT.hs +59/−10
• src/Test/HMock/Mockable.hs +5/−5
• src/Test/HMock/Multiplicity.hs +1/−1
• src/Test/HMock/Predicates.hs +508/−192
• src/Test/HMock/Rule.hs +2/−2
• src/Test/HMock/TH.hs +256/−301
• test/Classes.hs +119/−79
• test/Core.hs +49/−4
• test/Demo.hs +8/−6
• test/DocTests/All.hs +2/−0
• test/DocTests/Test/HMock/Internal/FlowMatcher.hs +20/−0
• test/DocTests/Test/HMock/Multiplicity.hs +66/−66
• test/DocTests/Test/HMock/Predicates.hs +507/−453
• test/Extras.hs +15/−10
• test/QuasiMockBase.hs +9/−3
• test/TH.hs +3/−3

@@ -1,5 +1,31 @@ # Revision history for hmock +## 0.4.0.0 -- 2021-08-22++* Dramatically simplified the Template Haskell API.+  * `makeMockable` now expects a Type instead of a Name.  Use `[t|MyClass|]`.+  * Most other variants of `makeMockable` have been removed.  Use+    `makeMockableWithOptions` instead.+  * `makeMockable` will now detect when instances already exist and won't+    redefine them.+  * `makeMockable [t|MyClass ConcreteType|]` now defines `Mockable` and+    `MockableBase` for any `MyClass` type.  Only `MockT` instances use the+    concrete type.  In some cases, you may need to add type annotations to your+    expectations.+* `MockSetup` can now add expectations.+* Added a lot more configuration for severity of faults:+  * `setAmbiguityCheck` can now set to ignore, warning, or error.+  * Added `setUninterestingActionCheck` for actions with no expectations.+  * Added `setUnexpectedActionCheck` for actions that don't match expectations.+  * Added `setUnmetExpectationCheck` for expectations that aren't met.+* Predicates have undergone major updates.+  * Predicates now show more detailed messages when they fail.+  * New `keys` and `values` predicates accept any child predicate.+  * Removed `containsKey`, `containsEntry`, `keysAre`, and `entriesAre`+    * Instead of `containsEntry` or `entriesAre`, use `contains` or+      `unorderedElemsAre` with `zipP`.+  * New predicates: `positive`, `negative`, `nonPositive`, `nonNegative`.+ ## 0.3.0.0 -- 2021-06-30  * Methods with polymorphic return types can now be mocked if the return type has@@ -14,7 +40,7 @@   * This is an optional feature, which is off by default.   * To make it easier to avoid ambiguity, there is now an `allowUnexpected` that   * causes unexpected calls to be ignored and optionally provide a response, but-    doesn't comflict with expectations that override it.  Ambiuguous uses of+    doesn't conflict with expectations that override it.  Ambiuguous uses of     `expectAny` can often be replaced with `allowUnexpected`. * Restricted mockable setup to defaults to avoid race conditions.   * Setup handlers now run in the `MockSetup` monad.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               HMock-version:            0.3.0.0+version:            0.4.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@@ -38,12 +38,14 @@                       Test.HMock.Rule,                       Test.HMock.TH,                       Test.HMock.Internal.ExpectSet,+                      Test.HMock.Internal.FlowMatcher,                       Test.HMock.Internal.Rule,                       Test.HMock.Internal.State,                       Test.HMock.Internal.Step,                       Test.HMock.Internal.TH,                       Test.HMock.Internal.Util-    build-depends:    base >=4.11.0 && < 4.16,+    build-depends:    array >= 0.5.2 && < 0.6,+                      base >=4.11.0 && < 4.16,                       constraints >= 0.13 && < 0.14,                       containers >= 0.6.2 && < 0.7,                       data-default >= 0.7.1 && < 0.8,@@ -69,6 +71,7 @@                       Core,                       Demo,                       DocTests.All,+                      DocTests.Test.HMock.Internal.FlowMatcher,                       DocTests.Test.HMock.Multiplicity,                       DocTests.Test.HMock.Predicates,                       ExpectSet,

@@ -0,0 +1,88 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | An implementation of bipartite matching using the Ford-Fulkerson algorithm.+module Test.HMock.Internal.FlowMatcher where++import Control.Monad (forM_, when)+import Control.Monad.ST (ST)+import Data.Array.IArray (Array, assocs, elems)+import Data.Array.ST+import Data.List ((\\))+import Data.Maybe (catMaybes)++-- $setup+-- >>> :set -Wno-type-defaults++-- | Computes the best bipartite matching of the elements in the two lists,+-- given the compatibility function.+--+-- Returns matched pairs, then unmatched lhs elements, then unmatched rhs+-- elements.+--+-- >>> bipartiteMatching (==) [1 .. 5] [6, 5 .. 2]+-- ([(2,2),(3,3),(4,4),(5,5)],[1],[6])+bipartiteMatching ::+  forall a b. (a -> b -> Bool) -> [a] -> [b] -> ([(a, b)], [a], [b])+bipartiteMatching compatible xs ys = (matchedPairs, unmatchedX, unmatchedY)+  where+    matchedPairs :: [(a, b)]+    matchedPairs = [(xs !! i, ys !! j) | (i, Just j) <- assocs matches]++    unmatchedX :: [a]+    unmatchedX = [xs !! i | (i, Nothing) <- assocs matches]++    unmatchedY :: [b]+    unmatchedY = [ys !! j | j <- [0 .. numYs - 1] \\ catMaybes (elems matches)]++    matches :: Array Int (Maybe Int)+    matches = runSTArray st++    st :: forall s. ST s (STArray s Int (Maybe Int))+    st = do+      compatArray <-+        newListArray+          ((0, 0), (numXs - 1, numYs - 1))+          [compatible x y | x <- xs, y <- ys] ::+          ST s (STArray s (Int, Int) Bool)+      matchArray <-+        newArray (0, numXs - 1) Nothing ::+          ST s (STArray s Int (Maybe Int))+      forM_ [0 .. numYs - 1] $ \j -> do+        seen <-+          newArray (0, numXs - 1) False :: ST s (STArray s Int Bool)+        _ <- go compatArray j matchArray seen+        return ()++      return matchArray++    numXs, numYs :: Int+    numXs = length xs+    numYs = length ys++    go ::+      forall s.+      STArray s (Int, Int) Bool ->+      Int ->+      STArray s Int (Maybe Int) ->+      STArray s Int Bool ->+      ST s Bool+    go compatArray j matchArray seen = loop False 0+      where+        loop True _ = return True+        loop _ i+          | i == numXs = return False+          | otherwise = do+            compat <- readArray compatArray (i, j)+            isSeen <- readArray seen i+            replace <-+              if isSeen || not compat+                then return False+                else do+                  writeArray seen i True+                  matchNum <- readArray matchArray i+                  case matchNum of+                    Nothing -> return True+                    Just n -> go compatArray n matchArray seen+            when replace $ writeArray matchArray i (Just j)+            loop replace (i + 1)

@@ -13,9 +13,12 @@  -- | A way to match an entire action, using conditions that might depend on the -- relationship between arguments.-data WholeMethodMatcher cls name m r-  = JustMatcher (Matcher cls name m r)-  | Matcher cls name m r `SuchThat` (Action cls name m r -> Bool)+data WholeMethodMatcher cls name m r where+  JustMatcher :: Matcher cls name m r -> WholeMethodMatcher cls name m r+  SuchThat ::+    Matcher cls name m r ->+    (Action cls name m r -> Bool) ->+    WholeMethodMatcher cls name m r  -- | Displays a WholeMethodMatcher.  The predicate isn't showable, but we can at -- least indicate whether there is one present.

@@ -5,6 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE KindSignatures #-}  -- | This module contains MockT and SetupMockT state functions. module Test.HMock.Internal.State where@@ -15,6 +16,7 @@ import Control.Monad.Cont (MonadCont) import Control.Monad.Except (MonadError) import Control.Monad.Extra (maybeM)+import Control.Monad.IO.Class (liftIO) import Control.Monad.RWS (MonadRWS) import Control.Monad.Reader (MonadReader (..), ReaderT, mapReaderT, runReaderT) import Control.Monad.State (MonadState)@@ -24,7 +26,9 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Typeable (TypeRep, Typeable, typeRep)-import GHC.Stack (withFrozenCallStack)+import GHC.Stack (withFrozenCallStack, HasCallStack)+import GHC.TypeLits (KnownSymbol, symbolVal)+import System.IO (hPutStrLn, stderr) import Test.HMock.ExpectContext (ExpectContext (..)) import Test.HMock.Internal.ExpectSet (ExpectSet (..), getSteps) import Test.HMock.Internal.Step (SingleRule, Step (..), unwrapExpected)@@ -41,19 +45,33 @@     readTVar,     readTVarIO,   )+import Data.Kind (Type, Constraint)  #if !MIN_VERSION_base(4, 13, 0) import Control.Monad.Fail (MonadFail) #endif +-- | The severity for a possible problem.+data Severity+  = -- | Fail the test.+    Error+  | -- | Print a message, but continue the test.+    Warning+  | -- | Don't do anything.+    Ignore+ -- | Full state of a mock. data MockState m = MockState   { mockExpectSet :: TVar (ExpectSet (Step m)),     mockDefaults :: TVar [Step m],     mockAllowUnexpected :: TVar [Step m],     mockSideEffects :: TVar [Step m],-    mockCheckAmbiguity :: TVar Bool,+    mockAmbiguitySeverity :: TVar Severity,+    mockUnexpectedSeverity :: TVar Severity,+    mockUninterestingSeverity :: TVar Severity,+    mockUnmetSeverity :: TVar Severity,     mockClasses :: TVar (Set TypeRep),+    mockInterestingMethods :: TVar (Set (TypeRep, String)),     mockParent :: Maybe (MockState m)   } @@ -67,10 +85,23 @@     <*> newTVarIO []     <*> newTVarIO []     <*> maybeM-      (newTVarIO False)-      (newTVarIO <=< readTVarIO . mockCheckAmbiguity)+      (newTVarIO Ignore)+      (newTVarIO <=< readTVarIO . mockAmbiguitySeverity)       (return parent)+    <*> maybeM+      (newTVarIO Error)+      (newTVarIO <=< readTVarIO . mockUnexpectedSeverity)+      (return parent)+    <*> maybeM+      (newTVarIO Error)+      (newTVarIO <=< readTVarIO . mockUninterestingSeverity)+      (return parent)+    <*> maybeM+      (newTVarIO Error)+      (newTVarIO <=< readTVarIO . mockUnmetSeverity)+      (return parent)     <*> maybe (newTVarIO Set.empty) (return . mockClasses) parent+    <*> maybe (newTVarIO Set.empty) (return . mockInterestingMethods) parent     <*> pure parent  -- | Gets a list of all states, starting with the innermost.@@ -114,13 +145,41 @@   where     t = typeRep proxy +-- | Marks a method as "interesting".  This can have implications for what+-- happens to calls to that method.+markInteresting ::+  forall (cls :: (Type -> Type) -> Constraint) name m proxy1 proxy2.+  (Typeable cls, KnownSymbol name) =>+  proxy1 cls ->+  proxy2 name ->+  MockSetup m ()+markInteresting proxyCls proxyName = runInRootState $ do+  state <- MockSetup ask+  mockSetupSTM $+    modifyTVar+      (mockInterestingMethods state)+      (Set.insert (typeRep proxyCls, symbolVal proxyName))++-- | Determines whether a method is "interesting".+isInteresting :: +  forall (cls :: (Type -> Type) -> Constraint) name m proxy1 proxy2.+  (Typeable cls, KnownSymbol name) =>+  proxy1 cls ->+  proxy2 name ->+  MockSetup m Bool+isInteresting proxyCls proxyName = runInRootState $ do+  state <- MockSetup ask+  interesting <- mockSetupSTM $ readTVar (mockInterestingMethods state)+  return ((typeRep proxyCls, symbolVal proxyName) `Set.member` interesting)+ -- | Runs class initialization for all uninitialized 'Mockable' classes in the -- given 'ExpectSet'. initClassesAsNeeded :: MonadIO m => ExpectSet (Step m) -> MockSetup m () initClassesAsNeeded es = runInRootState $   forM_ (getSteps es) $-    \(Step (_ :: Located (SingleRule cls name m r))) ->+    \(Step (_ :: Located (SingleRule cls name m r))) -> do       initClassIfNeeded (Proxy :: Proxy cls)+      markInteresting (Proxy :: Proxy cls) (Proxy :: Proxy name)  -- | Monad transformer for running mocks. newtype MockT m a where@@ -171,13 +230,16 @@  -- | Adds an expectation to the 'MockState' for the given 'ExpectSet', -- interleaved with any existing expectations.-expectThisSet :: MonadIO m => ExpectSet (Step m) -> MockT m ()-expectThisSet e = fromMockSetup $ do+expectThisSet :: MonadIO m => ExpectSet (Step m) -> MockSetup m ()+expectThisSet e = do   initClassesAsNeeded e   state <- MockSetup ask   mockSetupSTM $ modifyTVar (mockExpectSet state) (e `ExpectInterleave`) -instance ExpectContext MockT where+-- | This instance allows you to add expectations from 'MockSetup' actions.+-- This is an unusual thing to do.  Consider using+-- 'Test.HMock.MockT.allowUnexpected', instead.+instance ExpectContext MockSetup where   expect e =     withFrozenCallStack $ expectThisSet $ unwrapExpected $ expect e   expectN mult e =@@ -195,3 +257,36 @@   consecutiveTimes mult es =     withFrozenCallStack $       expectThisSet $ unwrapExpected $ consecutiveTimes mult es++instance ExpectContext MockT where+  expect e =+    withFrozenCallStack $+      fromMockSetup $ expectThisSet $ unwrapExpected $ expect e+  expectN mult e =+    withFrozenCallStack $+      fromMockSetup $ expectThisSet $ unwrapExpected $ expectN mult e+  expectAny e =+    withFrozenCallStack $+      fromMockSetup $ expectThisSet $ unwrapExpected $ expectAny e+  inSequence es =+    withFrozenCallStack $+      fromMockSetup $ expectThisSet $ unwrapExpected $ inSequence es+  inAnyOrder es =+    withFrozenCallStack $+      fromMockSetup $ expectThisSet $ unwrapExpected $ inAnyOrder es+  anyOf es =+    withFrozenCallStack $+      fromMockSetup $ expectThisSet $ unwrapExpected $ anyOf es+  times mult es =+    withFrozenCallStack $+      fromMockSetup $ expectThisSet $ unwrapExpected $ times mult es+  consecutiveTimes mult es =+    withFrozenCallStack $+      fromMockSetup $ expectThisSet $ unwrapExpected $ consecutiveTimes mult es++-- | Reports a potential problem with the given 'Severity'.+reportFault :: (HasCallStack, MonadIO m) => Severity -> String -> MockT m ()+reportFault severity msg = case severity of+  Ignore -> return ()+  Warning -> liftIO $ hPutStrLn stderr msg+  Error -> error msg

@@ -18,6 +18,7 @@     hasPolyType,     hasNestedPolyType,     resolveInstance,+    resolveInstanceType,     simplifyContext,     localizeMember,   )@@ -30,6 +31,7 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax (NameFlavour (..)) import Test.HMock.Internal.Util (choices)+import Data.Foldable (foldl')  #if MIN_VERSION_template_haskell(2,17,0) @@ -72,6 +74,13 @@     subst (VarT x) | Just t <- lookup x classVars = t     subst t = t +-- | Splits a type application into a top-level constructor and a list of its+-- type arguments.+splitTypeApp :: Type -> Maybe (Name, [Type])+splitTypeApp (ConT name) = Just (name, [])+splitTypeApp (AppT a b) = fmap (++ [b]) <$> splitTypeApp a+splitTypeApp _ = Nothing+ -- | Splits a function type into a list of bound type vars, context, parameter -- types, and return value type. splitType :: Type -> ([Name], Cxt, [Type], Type)@@ -109,19 +118,20 @@ -- for the variables of the left type that obtain the right one. unifyTypes :: Type -> Type -> Q (Maybe [(Name, Type)]) unifyTypes = unifyTypesWith []-  where-    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) +-- | Unify types, but starting with a table of substitutions.+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) -> unifyWithin tbl a b+    _ -> unifyTypesWith tbl (fromMaybe a mbA) (fromMaybe b mbB)+  where     replaceSyn :: Type -> Q (Maybe Type)     replaceSyn (ConT n) = do       info <- reify n@@ -130,19 +140,21 @@         _ -> 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-+-- Unifies the types that occur within the arguments, starting with a table of+-- substitutions.+unifyWithin ::+  (Data a, Data b) => [(Name, Type)] -> a -> b -> Q (Maybe [(Name, Type)])+unifyWithin tbl a b+  | toConstr a == toConstr b =+    compose (gzipWithQ (\a' b' tbl' -> unify tbl' a' b') a b) tbl+  | otherwise = return Nothing+  where     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+    unify tbl' a' b' = do+      case (cast a', cast b') of+        (Just a'', Just b'') -> unifyTypesWith tbl' a'' b''+        _ -> unifyWithin tbl' a' b'      compose :: Monad m => [t -> m (Maybe t)] -> t -> m (Maybe t)     compose [] x = return (Just x)@@ -175,36 +187,50 @@  -- | Attempts to produce sufficient constraints for the given 'Type' to be an -- instance of the given class 'Name'.-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+resolveInstance :: Name -> [Type] -> Q (Maybe Cxt)+resolveInstance cls args+  | all isTypeVar args = return (Just [foldl' AppT (ConT cls) args])+  where+    isTypeVar :: Type -> Bool+    isTypeVar (VarT _) = True+    isTypeVar _ = False+resolveInstance cls args = do+  decs <- reifyInstances cls args+  result <- traverse (tryInstance args) 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 :: [Type] -> InstanceDec -> Q (Maybe Cxt)+    tryInstance actualArgs (InstanceD _ cx instType _) =+      case splitTypeApp instType of+        Just (cls', instArgs) | cls' == cls ->+          unifyWithin [] instArgs actualArgs >>= \case+            Just tbl ->+              let cx' = substTypeVars tbl <$> cx+              in fmap concat . sequence <$> mapM resolveInstanceType cx'+            Nothing -> return Nothing+        _ -> return Nothing     tryInstance _ _ = return Nothing -    resolveInstanceType :: Type -> Q (Maybe Cxt)-    resolveInstanceType (AppT (ConT cls') t') = resolveInstance cls' t'-    resolveInstanceType _ = return Nothing+-- | Attempts to produce sufficient constraints for the given 'Type' to be a+-- satisfied constraint.  The type should be a class applied to its type+-- parameters.+resolveInstanceType :: Type -> Q (Maybe Cxt)+resolveInstanceType t = case splitTypeApp t of+  Just (cls, args) -> resolveInstance cls args+  Nothing -> return Nothing  -- | Simplifies a context with complex types (requiring FlexibleContexts) to try -- to obtain one with all constraints applied to variables. 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 (p : preds) =+  case splitTypeApp p of+    Just (cls, args) ->+      resolveInstance cls args >>= \case+        Just cxt' -> fmap (cxt' ++) <$> simplifyContext preds+        Nothing -> return Nothing+    _ -> fmap (p :) <$> simplifyContext preds simplifyContext [] = return (Just [])  -- | Remove instance context from a method.

@@ -9,7 +9,7 @@ import GHC.Stack (CallStack, getCallStack, prettySrcLoc)  -- | A value together with its source location.-data Located a = Loc (Maybe String) a deriving (Eq, Ord, Functor)+data Located a = Loc (Maybe String) a deriving (Functor)  -- | Annotates a value with its source location from the call stack. locate :: CallStack -> a -> Located a

@@ -11,7 +11,7 @@ where  import Control.Concurrent.STM (TVar, readTVar, writeTVar)-import Control.Monad (forM, forM_, join, void)+import Control.Monad (forM, forM_, join, unless, void) import Control.Monad.Extra (concatMapM) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (ask)@@ -21,7 +21,7 @@ import Data.Function (on) import Data.Functor (($>)) import Data.List (intercalate, sortBy)-import Data.Maybe (catMaybes)+import Data.Maybe (catMaybes, fromMaybe) import Data.Proxy (Proxy (Proxy)) import Data.Typeable (cast) import GHC.Stack (HasCallStack, withFrozenCallStack)@@ -33,14 +33,21 @@     MockSetup (..),     MockState (..),     MockT,+    Severity (..),     allStates,     initClassIfNeeded,+    isInteresting,     mockSetupSTM,+    reportFault,   ) import Test.HMock.Internal.Step (SingleRule ((:->)), Step (Step)) import Test.HMock.Internal.Util (Located (Loc), withLoc) import Test.HMock.MockT (describeExpectations)-import Test.HMock.Mockable (MatchResult (..), Mockable (..), MockableBase (..))+import Test.HMock.Mockable+  ( MatchResult (..),+    Mockable (..),+    MockableBase (..),+  )  matchWholeAction ::   MockableBase cls =>@@ -52,7 +59,7 @@   NoMatch n -> NoMatch n   Match     | p a -> Match-    | otherwise -> NoMatch 0+    | otherwise -> NoMatch []  -- | Implements mock delegation for actions. mockMethodImpl ::@@ -71,7 +78,7 @@         return $           partitionEithers             (tryMatch (mockExpectSet state) <$> liveSteps expectSet)-    let orderedPartial = snd <$> sortBy (compare `on` fst) (catMaybes partial)+    let orderedPartial = sortBy (compare `on` (length . fst)) (catMaybes partial)     defaults <- concatMapM (mockSetupSTM . readTVar . mockDefaults) states     unexpected <-       concatMapM@@ -80,29 +87,37 @@     sideEffect <-       getSideEffect         <$> concatMapM (mockSetupSTM . readTVar . mockSideEffects) states-    checkAmbig <- mockSetupSTM $ readTVar . mockCheckAmbiguity . head $ states+    ambigSev <- mockSetupSTM $ readTVar . mockAmbiguitySeverity . head $ states+    unintSev <-+      mockSetupSTM $ readTVar . mockUninterestingSeverity . head $ states+    unexpSev <- mockSetupSTM $ readTVar . mockUnexpectedSeverity . head $ states     case ( full,            orderedPartial,            allowedUnexpected unexpected,            findDefault defaults          ) of-      (opts@(_ : _ : _), _, _, _)-        | checkAmbig ->-          return $ ambiguityError action ((\(s, _, _) -> s) <$> opts)-      ((_, choose, Just response) : _, _, _, _) ->-        choose >> return (sideEffect >> response)-      ((_, choose, Nothing) : _, _, _, d) ->-        choose >> return (sideEffect >> d)-      ([], _, Just (Just resp), _) -> return (sideEffect >> resp)-      ([], _, Just Nothing, d) -> return (sideEffect >> d)-      ([], [], _, _) -> return (noMatchError action)-      ([], _, _, _) -> return (partialMatchError action orderedPartial)+      (opts@((_, choose, response) : rest), _, _, d) -> do+        choose+        return $ do+          unless (null rest) $+            ambiguityError ambigSev action ((\(s, _, _) -> s) <$> opts)+          sideEffect+          fromMaybe d response+      ([], _, Just response, d) -> return (sideEffect >> fromMaybe d response)+      ([], [], _, d) -> do+        interesting <- isInteresting (Proxy :: Proxy cls) (Proxy :: Proxy name)+        case (interesting, unintSev) of+          (True, _) -> return (noMatchError unexpSev action >> d)+          (False, Error) -> return (noMatchError unexpSev action >> d)+          _ -> return (uninterestingError unintSev action >> d)+      ([], _, _, d) ->+        return (partialMatchError unexpSev action orderedPartial >> d)   where     tryMatch ::       TVar (ExpectSet (Step m)) ->       (Step m, ExpectSet (Step m)) ->       Either-        (Maybe (Int, String))+        (Maybe ([(Int, String)], String))         (String, MockSetup m (), Maybe (MockT m r))     tryMatch tvar (Step expected, e)       | Just lrule@(Loc _ (m :-> impl)) <- cast expected =@@ -170,12 +185,25 @@ mockDefaultlessMethod action =   withFrozenCallStack $ mockMethodImpl undefined action +-- | An error for an action that matches no expectations at all.  This is only+-- used if severity is Ignore or Warning.+uninterestingError ::+  (HasCallStack, Mockable cls, MonadIO m) =>+  Severity ->+  Action cls name m r ->+  MockT m ()+uninterestingError severity a =+  reportFault severity $ "Uninteresting action: " ++ showAction a+ -- | An error for an action that matches no expectations at all. noMatchError ::-  (Mockable cls, MonadIO m) => Action cls name m r -> MockT m a-noMatchError a = do+  (HasCallStack, Mockable cls, MonadIO m) =>+  Severity ->+  Action cls name m r ->+  MockT m ()+noMatchError severity a = do   fullExpectations <- describeExpectations-  error $+  reportFault severity $     "Unexpected action: " ++ showAction a       ++ "\n\nFull expectations:\n"       ++ fullExpectations@@ -183,30 +211,46 @@ -- | An error for an action that doesn't match the argument predicates for any -- of the method's expectations. partialMatchError ::-  (Mockable cls, MonadIO m) =>+  (HasCallStack, Mockable cls, MonadIO m) =>+  Severity ->   Action cls name m r ->-  [String] ->-  MockT m a-partialMatchError a partials = do+  [([(Int, String)], String)] ->+  MockT m ()+partialMatchError severity a partials = do   fullExpectations <- describeExpectations-  error $+  reportFault severity $     "Wrong arguments: "       ++ showAction a       ++ "\n\nClosest matches:\n - "-      ++ intercalate "\n - " (take 5 partials)+      ++ intercalate "\n - " (map formatPartial $ take 5 partials)       ++ "\n\nFull expectations:\n"       ++ fullExpectations+  where+    formatPartial :: ([(Int, String)], String) -> String+    formatPartial (mismatches, matcher)+      | null mismatches = matcher ++ "\n   * Failed whole-method matcher"+      | otherwise =+        matcher ++ "\n   * "+          ++ intercalate+            "\n   * "+            ( map+                ( \(i, mm) ->+                    "Arg #" ++ show i ++ ": " ++ mm+                )+                mismatches+            )  -- | An error for an 'Action' that matches more than one 'Matcher'.  This only -- triggers an error if ambiguity checks are on. ambiguityError ::-  (Mockable cls, MonadIO m) =>+  (HasCallStack, Mockable cls, MonadIO m) =>+  Severity ->   Action cls name m r ->   [String] ->-  MockT m a-ambiguityError a choices = do+  MockT m ()+ambiguityError severity a choices = do   fullExpectations <- describeExpectations-  error $+  reportFault severity $     "Ambiguous action matched multiple expectations: "       ++ showAction a       ++ "\n\nMatches:\n - "

@@ -17,7 +17,11 @@     withMockT,     nestMockT,     withNestedMockT,+    Severity (..),     setAmbiguityCheck,+    setUninterestingActionCheck,+    setUnexpectedActionCheck,+    setUnmetExpectationCheck,     describeExpectations,     verifyExpectations,     MockSetup,@@ -28,6 +32,7 @@   ) where +import Control.Monad (join) import Control.Monad.Reader   ( MonadReader (..),     runReaderT,@@ -115,14 +120,53 @@   where     withState state = MockT . local (const state) . unMockT --- | Sets whether to check for ambiguous actions.  If 'True', then actions that--- match expectations in more than one way will fail.  If 'False', then the--- most recently added action will take precedence.  This defaults to 'False'.-setAmbiguityCheck :: MonadIO m => Bool -> MockT m ()-setAmbiguityCheck flag = fromMockSetup $ do+-- | Sets the severity for ambiguous actions.  An ambiguous action is one that+-- matches expectations in more than one way.  If this is not set to `Error`,+-- the most recently added expectation will take precedence.+--+-- This defaults to 'Ignore'.+setAmbiguityCheck :: MonadIO m => Severity -> MockT m ()+setAmbiguityCheck severity = fromMockSetup $ do   state <- MockSetup ask-  mockSetupSTM $ writeTVar (mockCheckAmbiguity state) flag+  mockSetupSTM $ writeTVar (mockAmbiguitySeverity state) severity +-- | Sets the severity for uninteresting actions.  An uninteresting action is+-- one for which no expectations or other configuration have been added that+-- mention the method at all.  If this is not set to `Error`, then uninteresting+-- methods are treated just like unexpected methods.+--+-- Before you weaken this check, consider that the labeling of methods as+-- "uninteresting" is non-compositional.  A change in one part of your test can+-- result in a formerly uninteresting action being considered interesting in a+-- different part of the test.+--+-- This defaults to 'Error'.+setUninterestingActionCheck :: MonadIO m => Severity -> MockT m ()+setUninterestingActionCheck severity = fromMockSetup $ do+  state <- MockSetup ask+  mockSetupSTM $ writeTVar (mockUninterestingSeverity state) severity++-- | Sets the severity for unexpected actions.  An unexpected action is one that+-- doesn't match any expectations *and* isn't explicitly allowed by+-- `allowUnexpected`.  If this is not set to `Error`, the action returns its+-- default response.+--+-- This defaults to 'Error'.+setUnexpectedActionCheck :: MonadIO m => Severity -> MockT m ()+setUnexpectedActionCheck severity = fromMockSetup $ do+  state <- MockSetup ask+  mockSetupSTM $ writeTVar (mockUnexpectedSeverity state) severity++-- | Sets the severity for unmet expectations.  An unmet expectation happens+-- when an expectation is added, but either the test (or nesting level) ends or+-- 'verifyExpectations' is used before a matching action takes place.+--+-- This defaults to 'Error'.+setUnmetExpectationCheck :: MonadIO m => Severity -> MockT m ()+setUnmetExpectationCheck severity = fromMockSetup $ do+  state <- MockSetup ask+  mockSetupSTM $ writeTVar (mockUnmetSeverity state) severity+ -- | 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.@@ -144,12 +188,17 @@ -- in a single test.  Consider splitting large tests into a separate test for -- each case. verifyExpectations :: MonadIO m => MockT m ()-verifyExpectations = do+verifyExpectations = join $ do   fromMockSetup $ do-    expectSet <- MockSetup ask >>= mockSetupSTM . readTVar . mockExpectSet+    states <- MockSetup ask+    expectSet <- mockSetupSTM $ readTVar $ mockExpectSet states+    missingSev <- mockSetupSTM $ readTVar $ mockUnmetSeverity states     case excess expectSet of-      ExpectNothing -> return ()-      missing -> error $ "Unmet expectations:\n" ++ formatExpectSet missing+      ExpectNothing -> return (return ())+      missing ->+        return $+          reportFault missingSev $+            "Unmet expectations:\n" ++ formatExpectSet missing  -- | Adds a handler for unexpected actions.  Matching calls will not fail, but -- will use a default response instead.  The rule passed in must have zero or

@@ -27,15 +27,15 @@ -- 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+  -- | No match.  The arg is explanations of mismatch.+  NoMatch :: [(Int, String)] -> 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.+-- 'Test.HMock.TH.makeMockable', or 'Test.HMock.TH.makeMockableWithOptions',+-- since 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.@@ -59,7 +59,7 @@ -- 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+  -- | 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.   --

@@ -71,7 +71,7 @@   (*) = error "Multiplicities are not closed under multiplication"    abs = id-  signum = id+  signum x = if x == 0 then 0 else 1  normalize :: Multiplicity -> Multiplicity normalize m@(Multiplicity a b)

@@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ParallelListComp #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}@@ -18,6 +20,7 @@     lt,     leq,     just,+    nothing,     left,     right,     zipP,@@ -45,11 +48,13 @@     contains,     containsAll,     containsOnly,-    containsKey,-    containsEntry,-    keysAre,-    entriesAre,+    keys,+    values,     approxEq,+    positive,+    negative,+    nonPositive,+    nonNegative,     finite,     infinite,     nAn,@@ -63,7 +68,8 @@ where  import Data.Char (toUpper)-import Data.Maybe (isJust)+import Data.List (intercalate)+import Data.Maybe (catMaybes, isJust, isNothing) import Data.MonoTraversable import qualified Data.Sequences as Seq import Data.Typeable (Proxy (..), Typeable, cast, typeRep)@@ -71,9 +77,10 @@ import GHC.Stack (HasCallStack, callStack) import Language.Haskell.TH (ExpQ, PatQ, pprint) import Language.Haskell.TH.Syntax (lift)+import Test.HMock.Internal.FlowMatcher (bipartiteMatching) import Test.HMock.Internal.TH (removeModNames)-import Test.HMock.Internal.Util (choices, isSubsequenceOf, locate, withLoc)-import Text.Regex.TDFA hiding (match)+import Test.HMock.Internal.Util (isSubsequenceOf, locate, withLoc)+import Text.Regex.TDFA hiding (match, matchAll)  -- $setup -- >>> :set -XTemplateHaskell@@ -88,11 +95,22 @@ -- accept. data Predicate a = Predicate   { showPredicate :: String,-    accept :: a -> Bool+    showNegation :: String,+    accept :: a -> Bool,+    explain :: a -> String   }  instance Show (Predicate a) where show = showPredicate +withDefaultExplain ::+  (a -> String) -> String -> ((a -> String) -> Predicate a) -> Predicate a+withDefaultExplain format connector mk = p+  where+    p = mk $ \x ->+      if accept p x+        then format x ++ connector ++ showPredicate p+        else format x ++ connector ++ showNegation p+ -- | A 'Predicate' that accepts anything at all. -- -- >>> accept anything "foo"@@ -103,7 +121,9 @@ anything =   Predicate     { showPredicate = "anything",-      accept = const True+      showNegation = "nothing",+      accept = const True,+      explain = const "always matches"     }  -- | A 'Predicate' that accepts only the given value.@@ -116,7 +136,12 @@ eq x =   Predicate     { showPredicate = show x,-      accept = (== x)+      showNegation = "≠ " ++ show x,+      accept = (== x),+      explain = \y ->+        if y == x+          then show y ++ " = " ++ show x+          else show y ++ " ≠ " ++ show x     }  -- | A 'Predicate' that accepts anything but the given value.@@ -126,11 +151,7 @@ -- >>> accept (neq "foo") "bar" -- True neq :: (Show a, Eq a) => a -> Predicate a-neq x =-  Predicate-    { showPredicate = "≠ " ++ show x,-      accept = (/= x)-    }+neq = notP . eq  -- | A 'Predicate' that accepts anything greater than the given value. --@@ -141,10 +162,12 @@ -- >>> accept (gt 5) 6 -- True gt :: (Show a, Ord a) => a -> Predicate a-gt x =+gt x = withDefaultExplain show " " $ \explainImpl ->   Predicate     { showPredicate = "> " ++ show x,-      accept = (> x)+      showNegation = "≤ " ++ show x,+      accept = (> x),+      explain = explainImpl     }  -- | A 'Predicate' that accepts anything greater than or equal to the given@@ -157,10 +180,12 @@ -- >>> accept (geq 5) 6 -- True geq :: (Show a, Ord a) => a -> Predicate a-geq x =+geq x = withDefaultExplain show " " $ \explainImpl ->   Predicate     { showPredicate = "≥ " ++ show x,-      accept = (>= x)+      showNegation = "< " ++ show x,+      accept = (>= x),+      explain = explainImpl     }  -- | A 'Predicate' that accepts anything less than the given value.@@ -172,11 +197,7 @@ -- >>> accept (lt 5) 6 -- False lt :: (Show a, Ord a) => a -> Predicate a-lt x =-  Predicate-    { showPredicate = "< " ++ show x,-      accept = (< x)-    }+lt = notP . geq  -- | A 'Predicate' that accepts anything less than or equal to the given value. --@@ -187,11 +208,7 @@ -- >>> accept (leq 5) 6 -- False leq :: (Show a, Ord a) => a -> Predicate a-leq x =-  Predicate-    { showPredicate = "≤ " ++ show x,-      accept = (<= x)-    }+leq = notP . gt  -- | A 'Predicate' that accepts 'Maybe' values of @'Just' x@, where @x@ matches -- the given child 'Predicate'.@@ -206,9 +223,28 @@ just p =   Predicate     { showPredicate = "Just (" ++ showPredicate p ++ ")",-      accept = \case Just x -> accept p x; _ -> False+      showNegation = "not Just (" ++ showPredicate p ++ ")",+      accept = \case Just x -> accept p x; _ -> False,+      explain = \case Just x -> explain p x; _ -> "Nothing ≠ Just _"     } +-- | A Predicate that accepts 'Maybe' values of @'Nothing'@.  Unlike 'eq', this+-- doesn't require 'Eq' or 'Show' instances.+--+-- >>> accept nothing Nothing+-- True+--+-- >>> accept nothing (Just "something")+-- False+nothing :: Predicate (Maybe a)+nothing =+  Predicate+    { showPredicate = "Nothing",+      showNegation = "Just anything",+      accept = isNothing,+      explain = \case Nothing -> "Nothing = Nothing"; _ -> "Just _ ≠ Nothing"+    }+ -- | A 'Predicate' that accepts an 'Either' value of @'Left' x@, where @x@ -- matches the given child 'Predicate'. --@@ -222,7 +258,9 @@ left p =   Predicate     { showPredicate = "Left (" ++ showPredicate p ++ ")",-      accept = \case Left x -> accept p x; _ -> False+      showNegation = "not Left (" ++ showPredicate p ++ ")",+      accept = \case Left x -> accept p x; _ -> False,+      explain = \case Left x -> explain p x; _ -> "Right _ ≠ Left _"     }  -- | A 'Predicate' that accepts an 'Either' value of @'Right' x@, where @x@@@ -238,7 +276,9 @@ right p =   Predicate     { showPredicate = "Right (" ++ showPredicate p ++ ")",-      accept = \case Right x -> accept p x; _ -> False+      showNegation = "not Right (" ++ showPredicate p ++ ")",+      accept = \case Right x -> accept p x; _ -> False,+      explain = \case Right x -> explain p x; _ -> "Left _ ≠ Right _"     }  -- | A 'Predicate' that accepts pairs whose elements satisfy the corresponding@@ -249,11 +289,23 @@ -- >>> accept (zipP (eq "foo") (eq "bar")) ("bar", "foo") -- False zipP :: Predicate a -> Predicate b -> Predicate (a, b)-zipP p q =+zipP p1 p2 =   Predicate-    { showPredicate = show (p, q),-      accept = \(x, y) -> accept p x && accept q y+    { showPredicate = show (p1, p2),+      showNegation = "not " ++ show (p1, p2),+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            significant+              | all fst results = results+              | otherwise = filter (not . fst) results+         in intercalate " and " $ map snd significant     }+  where+    acceptAndExplain = \(x1, x2) ->+      [ (accept p1 x1, explain p1 x1),+        (accept p2 x2, explain p2 x2)+      ]  -- | A 'Predicate' that accepts 3-tuples whose elements satisfy the -- corresponding child 'Predicate's.@@ -266,8 +318,21 @@ zip3P p1 p2 p3 =   Predicate     { showPredicate = show (p1, p2, p3),-      accept = \(x1, x2, x3) -> accept p1 x1 && accept p2 x2 && accept p3 x3+      showNegation = "not " ++ show (p1, p2, p3),+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            significant+              | all fst results = results+              | otherwise = filter (not . fst) results+         in intercalate " and " $ map snd significant     }+  where+    acceptAndExplain = \(x1, x2, x3) ->+      [ (accept p1 x1, explain p1 x1),+        (accept p2 x2, explain p2 x2),+        (accept p3 x3, explain p3 x3)+      ]  -- | A 'Predicate' that accepts 3-tuples whose elements satisfy the -- corresponding child 'Predicate's.@@ -285,9 +350,22 @@ 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+      showNegation = "not " ++ show (p1, p2, p3, p4),+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            significant+              | all fst results = results+              | otherwise = filter (not . fst) results+         in intercalate " and " $ map snd significant     }+  where+    acceptAndExplain = \(x1, x2, x3, x4) ->+      [ (accept p1 x1, explain p1 x1),+        (accept p2 x2, explain p2 x2),+        (accept p3 x3, explain p3 x3),+        (accept p4 x4, explain p4 x4)+      ]  -- | A 'Predicate' that accepts 3-tuples whose elements satisfy the -- corresponding child 'Predicate's.@@ -306,10 +384,23 @@ 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+      showNegation = "not " ++ show (p1, p2, p3, p4, p5),+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            significant+              | all fst results = results+              | otherwise = filter (not . fst) results+         in intercalate " and " $ map snd significant     }+  where+    acceptAndExplain = \(x1, x2, x3, x4, x5) ->+      [ (accept p1 x1, explain p1 x1),+        (accept p2 x2, explain p2 x2),+        (accept p3 x3, explain p3 x3),+        (accept p4 x4, explain p4 x4),+        (accept p5 x5, explain p5 x5)+      ]  -- | A 'Predicate' that accepts anything accepted by both of its children. --@@ -323,7 +414,13 @@ p `andP` q =   Predicate     { showPredicate = showPredicate p ++ " and " ++ showPredicate q,-      accept = \x -> accept p x && accept q x+      showNegation = showNegation p ++ " or " ++ showNegation q,+      accept = \x -> accept p x && accept q x,+      explain = \x ->+        if+            | not (accept p x) -> explain p x+            | not (accept q x) -> explain q x+            | otherwise -> explain p x ++ " and " ++ explain q x     }  -- | A 'Predicate' that accepts anything accepted by either of its children.@@ -335,11 +432,7 @@ -- >>> 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-    }+p `orP` q = notP (notP p `andP` notP q)  -- | A 'Predicate' that inverts another 'Predicate', accepting whatever its -- child rejects, and rejecting whatever its child accepts.@@ -351,8 +444,10 @@ notP :: Predicate a -> Predicate a notP p =   Predicate-    { showPredicate = "not " ++ showPredicate p,-      accept = not . accept p+    { showPredicate = showNegation p,+      showNegation = showPredicate p,+      accept = not . accept p,+      explain = explain p     }  -- | A 'Predicate' that accepts sequences that start with the given prefix.@@ -362,10 +457,12 @@ -- >>> accept (startsWith "gib") "fungible" -- False startsWith :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t-startsWith pfx =+startsWith pfx = withDefaultExplain show " " $ \explainImpl ->   Predicate     { showPredicate = "starts with " ++ show pfx,-      accept = (pfx `Seq.isPrefixOf`)+      showNegation = "doesn't start with " ++ show pfx,+      accept = (pfx `Seq.isPrefixOf`),+      explain = explainImpl     }  -- | A 'Predicate' that accepts sequences that end with the given suffix.@@ -375,10 +472,12 @@ -- >>> accept (endsWith "ow") "trebuchet" -- False endsWith :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t-endsWith sfx =+endsWith sfx = withDefaultExplain show " " $ \explainImpl ->   Predicate     { showPredicate = "ends with " ++ show sfx,-      accept = (sfx `Seq.isSuffixOf`)+      showNegation = "doesn't end with " ++ show sfx,+      accept = (sfx `Seq.isSuffixOf`),+      explain = explainImpl     }  -- | A 'Predicate' that accepts sequences that contain the given (consecutive)@@ -389,10 +488,12 @@ -- >>> accept (hasSubstr "i") "partnership" -- True hasSubstr :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t-hasSubstr s =+hasSubstr s = withDefaultExplain show " " $ \explainImpl ->   Predicate     { showPredicate = "has substring " ++ show s,-      accept = (s `Seq.isInfixOf`)+      showNegation = "doesn't have substring " ++ show s,+      accept = (s `Seq.isInfixOf`),+      explain = explainImpl     }  -- | A 'Predicate' that accepts sequences that contain the given (not@@ -405,10 +506,12 @@ -- >>> accept (hasSubsequence [1..5]) [2, 3, 5, 7, 11] -- False hasSubsequence :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t-hasSubsequence s =+hasSubsequence s = withDefaultExplain show " " $ \explainImpl ->   Predicate     { showPredicate = "has subsequence " ++ show s,-      accept = (s `isSubsequenceOf`)+      showNegation = "doesn't have subsequence " ++ show s,+      accept = (s `isSubsequenceOf`),+      explain = explainImpl     }  -- | Transforms a 'Predicate' on 'String's or string-like types to match without@@ -433,7 +536,9 @@ caseInsensitive p s =   Predicate     { showPredicate = "(case insensitive) " ++ show (p s),-      accept = accept capP . omap toUpper+      showNegation = "(case insensitive) " ++ show (notP (p s)),+      accept = accept capP . omap toUpper,+      explain = explain capP . omap toUpper     }   where     capP = p (omap toUpper s)@@ -451,15 +556,22 @@ -- False -- >>> accept (matchesRegex "x{2,5}y?") "wxxxyz" -- False-matchesRegex :: (RegexLike Regex a, Eq a) => String -> Predicate a+matchesRegex :: (RegexLike Regex a, Eq a, Show 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+    { showPredicate = pat,+      showNegation = "not " ++ pat,+      accept = accepts,+      explain = \x ->+        if accepts x+          then show x ++ " matches " ++ pat+          else show x ++ " doesn't match " ++ pat     }   where+    pat = "/" ++ init (tail $ show s) ++ "/"+    accepts x = case matchOnceText r x of+      Just (a, _, b) -> a == empty && b == empty+      Nothing -> False     r = makeRegexOpts comp exec s :: Regex     comp = defaultCompOpt {newSyntax = True, lastStarGreedy = True}     exec = defaultExecOpt {captureGroups = False}@@ -479,15 +591,22 @@ -- >>> accept (matchesCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ" -- False matchesCaseInsensitiveRegex ::-  (RegexLike Regex a, Eq a) => String -> Predicate a+  (RegexLike Regex a, Eq a, Show 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+    { showPredicate = pat,+      showNegation = "not " ++ pat,+      accept = accepts,+      explain = \x ->+        if accepts x+          then show x ++ " matches " ++ pat+          else show x ++ " doesn't match " ++ pat     }   where+    pat = "/" ++ init (tail $ show s) ++ "/i"+    accepts x = case matchOnceText r x of+      Just (a, _, b) -> a == empty && b == empty+      Nothing -> False     r = makeRegexOpts comp exec s :: Regex     comp =       defaultCompOpt@@ -511,13 +630,16 @@ -- False -- >>> accept (containsRegex "x{2,5}y?") "wxxxyz" -- True-containsRegex :: (RegexLike Regex a, Eq a) => String -> Predicate a-containsRegex s =+containsRegex :: (RegexLike Regex a, Eq a, Show a) => String -> Predicate a+containsRegex s = withDefaultExplain show " " $ \explainImpl ->   Predicate-    { showPredicate = "contains /" ++ init (tail $ show s) ++ "/",-      accept = isJust . matchOnce r+    { showPredicate = "contains " ++ pat,+      showNegation = "doesn't contain " ++ pat,+      accept = isJust . matchOnce r,+      explain = explainImpl     }   where+    pat = "/" ++ init (tail $ show s) ++ "/"     r = makeRegexOpts comp exec s :: Regex     comp = defaultCompOpt {newSyntax = True, lastStarGreedy = True}     exec = defaultExecOpt {captureGroups = False}@@ -537,13 +659,16 @@ -- >>> accept (containsCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ" -- True containsCaseInsensitiveRegex ::-  (RegexLike Regex a, Eq a) => String -> Predicate a-containsCaseInsensitiveRegex s =+  (RegexLike Regex a, Eq a, Show a) => String -> Predicate a+containsCaseInsensitiveRegex s = withDefaultExplain show " " $ \explainImpl ->   Predicate-    { showPredicate = "contains /" ++ init (tail $ show s) ++ "/i",-      accept = isJust . matchOnce r+    { showPredicate = "contains " ++ pat,+      showNegation = "doesn't contain " ++ pat,+      accept = isJust . matchOnce r,+      explain = explainImpl     }   where+    pat = "/" ++ init (tail $ show s) ++ "/i"     r = makeRegexOpts comp exec s :: Regex     comp =       defaultCompOpt@@ -555,7 +680,7 @@  -- | A 'Predicate' that accepts empty data structures. ----- >>> accept isEmpty []+-- >>> accept isEmpty ([] :: [Int]) -- True -- >>> accept isEmpty [1, 2, 3] -- False@@ -563,16 +688,18 @@ -- True -- >>> accept isEmpty "gas tank" -- False-isEmpty :: MonoFoldable t => Predicate t-isEmpty =+isEmpty :: (MonoFoldable t, Show t) => Predicate t+isEmpty = withDefaultExplain show " is " $ \explainImpl ->   Predicate     { showPredicate = "empty",-      accept = onull+      showNegation = "non-empty",+      accept = onull,+      explain = explainImpl     }  -- | A 'Predicate' that accepts non-empty data structures. ----- >>> accept nonEmpty []+-- >>> accept nonEmpty ([] :: [Int]) -- False -- >>> accept nonEmpty [1, 2, 3] -- True@@ -580,12 +707,8 @@ -- False -- >>> accept nonEmpty "gas tank" -- True-nonEmpty :: MonoFoldable t => Predicate t-nonEmpty =-  Predicate-    { showPredicate = "nonempty",-      accept = not . onull-    }+nonEmpty :: (MonoFoldable t, Show t) => Predicate t+nonEmpty = notP isEmpty  -- | A 'Predicate' that accepts data structures whose number of elements match -- the child 'Predicate'.@@ -594,11 +717,20 @@ -- False -- >>> accept (sizeIs (lt 3)) ['a' .. 'b'] -- True-sizeIs :: MonoFoldable t => Predicate Int -> Predicate t+sizeIs :: (MonoFoldable t, Show t) => Predicate Int -> Predicate t sizeIs p =   Predicate     { showPredicate = "size " ++ showPredicate p,-      accept = accept p . olength+      showNegation = "size " ++ showNegation p,+      accept = accept p . olength,+      explain = \y ->+        let detail+              | accept p (olength y) = showPredicate p+              | otherwise = showNegation p+            detailStr+              | show (olength y) == detail = ""+              | otherwise = ", which is " ++ detail+         in show y ++ " has size " ++ show (olength y) ++ detailStr     }  -- | A 'Predicate' that accepts data structures whose contents each match the@@ -614,10 +746,28 @@ elemsAre ps =   Predicate     { showPredicate = show ps,+      showNegation = "not " ++ show ps,       accept = \xs ->         olength xs == olength ps-          && and (zipWith accept ps (otoList xs))+          && and (zipWith accept ps (otoList xs)),+      explain = \xs ->+        let results = acceptAndExplain (otoList xs)+         in if+                | olength xs /= length ps ->+                  "wrong size (got "+                    ++ show (olength xs)+                    ++ "; expected "+                    ++ show (length ps)+                    ++ ")"+                | all fst results -> "elements are " ++ show ps+                | otherwise ->+                  intercalate "; and " $+                    snd <$> filter (not . fst) results     }+  where+    acceptAndExplain xs = zipWith3 matchAndExplain [1 :: Int ..] ps xs+    matchAndExplain i p x =+      (accept p x, "in element #" ++ show i ++ ": " ++ explain p x)  -- | A 'Predicate' that accepts data structures whose contents each match the -- corresponding 'Predicate' in the given list, in any order.@@ -635,11 +785,42 @@   Predicate     { showPredicate =         "(any order) " ++ show ps,-      accept = matches ps . otoList+      showNegation =+        "not (in any order) " ++ show ps,+      accept = \xs ->+        let (_, orphanPs, orphanXs) = matchAll xs+         in null orphanPs && null orphanXs,+      explain = \xs ->+        let (matches, orphanPs, orphanXs) = matchAll xs+         in if null orphanPs && null orphanXs+              then intercalate "; and " (explainMatch <$> matches)+              else+                let missingExplanation =+                      if null orphanPs+                        then Nothing+                        else+                          Just+                            ( "Missing: "+                                ++ intercalate ", " (showPredicate <$> orphanPs)+                            )+                    extraExplanation =+                      if null orphanXs+                        then Nothing+                        else+                          Just+                            ( "Extra elements: "+                                ++ intercalate+                                  ", "+                                  (("#" ++) . show . fst <$> orphanXs)+                            )+                 in intercalate+                      "; "+                      (catMaybes [missingExplanation, extraExplanation])     }   where-    matches (q : qs) xs = or [matches qs ys | (y, ys) <- choices xs, accept q y]-    matches [] xs = null xs+    matchOne p (_, x) = accept p x+    matchAll xs = bipartiteMatching matchOne ps (zip [1 :: Int ..] (otoList xs))+    explainMatch (p, (j, x)) = "element #" ++ show j ++ ": " ++ explain p x  -- | A 'Predicate' that accepts data structures whose elements each match the -- child 'Predicate'.@@ -654,8 +835,21 @@ each p =   Predicate     { showPredicate = "each (" ++ showPredicate p ++ ")",-      accept = oall (accept p)+      showNegation = "contains (" ++ showNegation p ++ ")",+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            format (i, explanation) =+              "element #" ++ show i ++ ": " ++ explanation+         in if all fst results+              then "all elements " ++ showPredicate p+              else+                intercalate "; and " $+                  format . snd <$> filter (not . fst) results     }+  where+    acceptAndExplain xs =+      [(accept p x, (i, explain p x)) | i <- [1 :: Int ..] | x <- otoList xs]  -- | A 'Predicate' that accepts data structures which contain at least one -- element matching the child 'Predicate'.@@ -667,16 +861,10 @@ -- >>> accept (contains (gt 5)) [] -- False contains :: MonoFoldable t => Predicate (Element t) -> Predicate t-contains p =-  Predicate-    { showPredicate = "contains (" ++ showPredicate p ++ ")",-      accept = oany (accept p)-    }+contains = notP . each . notP --- | A 'Predicate' that accepts data structures which contain an element--- satisfying each of the child 'Predicate's.  @'containsAll' [p1, p2, ..., pn]@--- is equivalent to @'contains' p1 `'andP'` 'contains' p2 `'andP'` ... `'andP'`--- 'contains' pn@.+-- | A 'Predicate' that accepts data structures whose elements all satisfy the+-- given child 'Predicate's. -- -- >>> accept (containsAll [eq "foo", eq "bar"]) ["bar", "foo"] -- True@@ -684,106 +872,107 @@ -- False -- >>> accept (containsAll [eq "foo", eq "bar"]) ["foo", "bar", "qux"] -- True+--+-- Each child 'Predicate' must be satisfied by a different element, so repeating+-- a 'Predicate' requires that two different matching elements exist.  If you+-- want a 'Predicate' to match multiple elements, instead, you can accomplish+-- this with @'contains' p1 `'andP'` 'contains' p2 `'andP'` ...@.+--+-- >>> accept (containsAll [startsWith "f", endsWith "o"]) ["foo"]+-- False+-- >>> accept (contains (startsWith "f") `andP` contains (endsWith "o")) ["foo"]+-- 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+      showNegation = "not all of " ++ show ps,+      accept = \xs -> let (_, orphanPs, _) = matchAll xs in null orphanPs,+      explain = \xs ->+        let (matches, orphanPs, _) = matchAll xs+         in if null orphanPs+              then intercalate "; and " (explainMatch <$> matches)+              else "Missing: " ++ intercalate ", " (showPredicate <$> orphanPs)     }+  where+    matchOne p (_, x) = accept p x+    matchAll xs = bipartiteMatching matchOne ps (zip [1 :: Int ..] (otoList xs))+    explainMatch (p, (j, x)) = "element #" ++ show j ++ ": " ++ explain p x --- | A 'Predicate' that accepts data structures whose elements all satisfy at--- least one of the child 'Predicate's.  @'containsOnly' [p1, p2, ..., pn]@ is--- equivalent to @'each' (p1 `'orP'` p2 `'orP'` ... `'orP'` pn)@.+-- | A 'Predicate' that accepts data structures whose elements all satisfy one+-- of the child 'Predicate's. ----- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "foo"]+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo"] -- True -- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "bar"] -- True -- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "qux"] -- False+--+-- Each element must satisfy a different child 'Predicate'.  If you want+-- multiple elements to match the same 'Predicate', instead, you can accomplish+-- this with @'each' (p1 `'orP'` p2 `'orP'` ...)@.+--+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "foo"]+-- False+-- >>> accept (each (eq "foo" `orP` eq "bar")) ["foo", "foo"]+-- True containsOnly :: MonoFoldable t => [Predicate (Element t)] -> Predicate t containsOnly ps =   Predicate     { showPredicate = "contains only " ++ show ps,-      accept = oall (\x -> any (`accept` x) ps)+      showNegation = "not only " ++ show ps,+      accept = \xs -> let (_, _, orphanXs) = matchAll xs in null orphanXs,+      explain = \xs ->+        let (matches, _, orphanXs) = matchAll xs+         in if null orphanXs+              then intercalate "; and " (explainMatch <$> matches)+              else+                "Extra elements: "+                  ++ intercalate ", " (("#" ++) . show . fst <$> orphanXs)     }+  where+    matchOne p (_, x) = accept p x+    matchAll xs = bipartiteMatching matchOne ps (zip [1 :: Int ..] (otoList xs))+    explainMatch (p, (j, x)) = "element #" ++ show j ++ ": " ++ explain p x --- | A 'Predicate' that accepts map-like structures which contain a key matching--- the child 'Predicate'.+-- | Transforms a 'Predicate' on a list of keys into a 'Predicate' on map-like+-- data structures. ----- >>> 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).+-- This is equivalent to @'with' ('map' 'fst' '.' 'toList')@, but more readable. ----- >>> accept (containsEntry (eq "foo") (gt 10)) [("foo", 12), ("bar", 5)]+-- >>> accept (keys (each (eq "foo"))) [("foo", 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 'Predicate's, 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)]+-- >>> accept (keys (each (eq "foo"))) [("foo", 5), ("bar", 6)] -- False-keysAre ::-  (IsList t, Item t ~ (k, v)) => [Predicate k] -> Predicate t-keysAre ps =+keys :: (IsList t, Item t ~ (k, v)) => Predicate [k] -> Predicate t+keys p =   Predicate-    { showPredicate = "keys are " ++ show ps,-      accept = matches ps . map fst . toList+    { showPredicate = "keys (" ++ showPredicate p ++ ")",+      showNegation = "keys (" ++ showNegation p ++ ")",+      accept = accept p . map fst . toList,+      explain = ("in keys, " ++) . explain p . 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.+-- | Transforms a 'Predicate' on a list of values into a 'Predicate' on map-like+-- data structures. ----- >>> 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)]+-- This is equivalent to @'with' ('map' 'snd' '.' 'toList')@, but more readable.+--+-- >>> accept (values (each (eq 5))) [("foo", 5), ("bar", 5)] -- 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)]+--+-- >>> accept (values (each (eq 5))) [("foo", 5), ("bar", 6)] -- False-entriesAre ::-  (IsList t, Item t ~ (k, v)) => [(Predicate k, Predicate v)] -> Predicate t-entriesAre ps =+values :: (IsList t, Item t ~ (k, v)) => Predicate [v] -> Predicate t+values p =   Predicate-    { showPredicate = "entries are " ++ show ps,-      accept = matches ps . toList+    { showPredicate = "values (" ++ showPredicate p ++ ")",+      showNegation = "values (" ++ showNegation p ++ ")",+      accept = accept p . map snd . toList,+      explain = ("in values, " ++) . explain p . map snd . 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@@ -804,14 +993,92 @@ -- >>> accept (approxEq 1.0) (sum (replicate 100 0.009999)) -- False approxEq :: (RealFloat a, Show a) => a -> Predicate a-approxEq x =+approxEq x = withDefaultExplain show " " $ \explainImpl ->   Predicate     { showPredicate = "≈ " ++ show x,-      accept = \y -> abs (x - y) < diff+      showNegation = "≇" ++ show x,+      accept = \y -> abs (x - y) < diff,+      explain = explainImpl     }   where     diff = encodeFloat 1 (snd (decodeFloat x) + floatDigits x `div` 2) +-- | A 'Predicate' that accepts positive numbers of any 'Ord'ered 'Num' type.+--+-- >>> accept positive 1+-- True+--+-- >>> accept positive 0+-- False+--+-- >>> accept positive (-1)+-- False+positive :: (Ord a, Num a) => Predicate a+positive =+  Predicate+    { showPredicate = "positive",+      showNegation = "non-positive",+      accept = \x -> signum x > 0,+      explain = \x ->+        if+            | signum x > 0 -> "value is positive"+            | x == 0 -> "value is zero"+            | signum x < 0 -> "value is negative"+            | otherwise -> "value has unknown sign"+    }++-- | A 'Predicate' that accepts negative numbers of any 'Ord'ered 'Num' type.+--+-- >>> accept negative 1+-- False+--+-- >>> accept negative 0+-- False+--+-- >>> accept negative (-1)+-- True+negative :: (Ord a, Num a) => Predicate a+negative =+  Predicate+    { showPredicate = "negative",+      showNegation = "non-negative",+      accept = \x -> signum x < 0,+      explain = \x ->+        if+            | signum x < 0 -> "value is negative"+            | x == 0 -> "value is zero"+            | signum x < 0 -> "value is positive"+            | otherwise -> "value has unknown sign"+    }++-- | A 'Predicate' that accepts non-positive numbers of any 'Ord'ered 'Num'+-- type.+--+-- >>> accept nonPositive 1+-- False+--+-- >>> accept nonPositive 0+-- True+--+-- >>> accept nonPositive (-1)+-- True+nonPositive :: (Ord a, Num a) => Predicate a+nonPositive = notP positive++-- | A 'Predicate' that accepts non-negative numbers of any 'Ord'ered 'Num'+-- type.+--+-- >>> accept nonNegative 1+-- True+--+-- >>> accept nonNegative 0+-- True+--+-- >>> accept nonNegative (-1)+-- False+nonNegative :: (Ord a, Num a) => Predicate a+nonNegative = notP negative+ -- | A 'Predicate' that accepts finite numbers of any 'RealFloat' type. -- -- >>> accept finite 1.0@@ -824,8 +1091,15 @@ finite =   Predicate     { showPredicate = "finite",-      accept = \x -> not (isInfinite x) && not (isNaN x)+      showNegation = "non-finite",+      accept = isFinite,+      explain = \x ->+        if isFinite x+          then "value is finite"+          else "value is not finite"     }+  where+    isFinite x = not (isInfinite x) && not (isNaN x)  -- | A 'Predicate' that accepts infinite numbers of any 'RealFloat' type. --@@ -839,7 +1113,12 @@ infinite =   Predicate     { showPredicate = "infinite",-      accept = isInfinite+      showNegation = "non-infinite",+      accept = isInfinite,+      explain = \x ->+        if isInfinite x+          then "value is infinite"+          else "value is not infinite"     }  -- | A 'Predicate' that accepts NaN values of any 'RealFloat' type.@@ -854,7 +1133,12 @@ nAn =   Predicate     { showPredicate = "NaN",-      accept = isNaN+      showNegation = "non-NaN",+      accept = isNaN,+      explain = \x ->+        if isNaN x+          then "value is NaN"+          else "value is not NaN"     }  -- | A conversion from @a -> 'Bool'@ to 'Predicate'.  This is a fallback that@@ -866,10 +1150,15 @@ -- >>> accept (is even) 4 -- True is :: HasCallStack => (a -> Bool) -> Predicate a-is f =+is p =   Predicate     { showPredicate = withLoc (locate callStack "custom predicate"),-      accept = f+      showNegation = withLoc (locate callStack "negated custom predicate"),+      accept = p,+      explain = \x ->+        if p x+          then "value matched custom predicate"+          else "value did not match custom predicate"     }  -- | A Template Haskell splice that acts like 'is', but receives a quoted@@ -884,13 +1173,17 @@ -- >>> show $(qIs [| even |]) -- "even" qIs :: HasCallStack => ExpQ -> ExpQ-qIs f =+qIs p =   [|     Predicate-      { showPredicate = $(lift . pprint . removeModNames =<< f),-        accept = $f+      { showPredicate = $description,+        showNegation = "not " ++ $description,+        accept = $p,+        explain = \x -> if $p x then $description else "not " ++ $description       }     |]+  where+    description = lift . pprint . removeModNames =<< p  -- | A combinator to lift a 'Predicate' to work on a property or computed value -- of the original value.@@ -906,10 +1199,13 @@ with :: HasCallStack => (a -> b) -> Predicate b -> Predicate a with f p =   Predicate-    { showPredicate =-        withLoc (locate callStack "property") ++ ": " ++ show p,-      accept = accept p . f+    { showPredicate = prop ++ ": " ++ show p,+      showNegation = prop ++ ": " ++ showNegation p,+      accept = accept p . f,+      explain = ((prop ++ ": ") ++) . explain p . f     }+  where+    prop = withLoc (locate callStack "property")  -- | 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@@ -931,11 +1227,14 @@   [|     \p ->       Predicate-        { showPredicate =-            $(lift . pprint . removeModNames =<< f) ++ ": " ++ show p,-          accept = accept p . $f+        { showPredicate = $prop ++ ": " ++ show p,+          showNegation = $prop ++ ": " ++ showNegation p,+          accept = accept p . $f,+          explain = (($prop ++ ": ") ++) . explain p . $f         }     |]+  where+    prop = lift . pprint . removeModNames =<< f  -- | A Template Haskell splice that turns a quoted pattern into a predicate that -- accepts values that match the pattern.@@ -953,12 +1252,18 @@ qMatch qpat =   [|     Predicate-      { showPredicate = $(lift . pprint . removeModNames =<< qpat),+      { showPredicate = $patString,+        showNegation = "not " ++ $patString,         accept = \case-          $(qpat) -> True-          _ -> False+          $qpat -> True+          _ -> False,+        explain = \case+          $qpat -> "value matched " ++ $patString+          _ -> "value didn't match " ++ $patString       }     |]+  where+    patString = lift . pprint . removeModNames =<< qpat  -- | Converts a 'Predicate' to a new type.  Typically used with visible type -- application, as in the examples below.@@ -974,7 +1279,18 @@   Predicate     { showPredicate =         showPredicate p ++ " :: " ++ show (typeRep (Proxy :: Proxy a)),+      showNegation =+        "not " ++ showPredicate p ++ " :: "+          ++ show (typeRep (Proxy :: Proxy a)),       accept = \x -> case cast x of         Nothing -> False-        Just y -> accept p y+        Just y -> accept p y,+      explain = \x -> case cast x of+        Nothing ->+          "wrong type ("+            ++ show (typeRep (undefined :: Proxy b))+            ++ " vs. "+            ++ show (typeRep (undefined :: Proxy a))+            ++ ")"+        Just y -> explain p y     }

@@ -2,10 +2,10 @@ {-# LANGUAGE FunctionalDependencies #-}  -- | This module defines the 'Rule' type, which describes a matcher for methods--- and a possibly-empty list of responses to use for successive calls to+-- and a (possibly empty) list of responses to use for successive calls to -- matching methods.  The 'Expectable' type class generalizes 'Rule', so that -- you can specify a bare 'Matcher' or 'Action' in most situations where a--- 'Rule' is needed but you don't want to specify the response.+-- 'Rule' is needed but you don't want to provide a response. module Test.HMock.Rule   ( Rule,     Expectable (..),

@@ -8,40 +8,14 @@ {-# LANGUAGE TypeOperators #-}  -- | This module provides Template Haskell splices that can be used to derive--- boilerplate instances for HMock.------ There are 20 splices described here, based on combinations of four--- choices:------ * Whether to generate a 'Test.HMock.MockableBase', an instance for---   'Test.HMock.MockT', or both.--- * When generating 'Test.HMock.MockableBase', whether to also generate a---   'Test.HMock.Mockable' instance with an empty setup.--- * 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.+-- boilerplate instances for HMock.  'makeMockable' implements the common case+-- where you just want to generate everything you need to mock with a class.+-- The variant 'makeMockableWithOptions' is similar, but takes an options+-- parameter that can be used to customize the generation. module Test.HMock.TH-  ( MockableOptions (..),+  ( MakeMockableOptions (..),     makeMockable,-    makeMockableType,     makeMockableWithOptions,-    makeMockableTypeWithOptions,-    makeMockableBase,-    makeMockableBaseType,-    makeMockableBaseWithOptions,-    makeMockableBaseTypeWithOptions,-    deriveMockable,-    deriveMockableType,-    deriveMockableWithOptions,-    deriveMockableTypeWithOptions,-    deriveMockableBase,-    deriveMockableBaseType,-    deriveMockableBaseWithOptions,-    deriveMockableBaseTypeWithOptions,-    deriveForMockT,-    deriveTypeForMockT,-    deriveForMockTWithOptions,-    deriveTypeForMockTWithOptions,   ) where @@ -54,7 +28,9 @@ import Data.Either (partitionEithers) import qualified Data.Kind import Data.List (foldl', (\\))-import Data.Typeable (Typeable)+import Data.Maybe (catMaybes, isNothing)+import Data.Proxy (Proxy)+import Data.Typeable (Typeable, typeRep) import GHC.Stack (HasCallStack) import GHC.TypeLits (ErrorMessage (Text, (:$$:), (:<>:)), Symbol, TypeError) import Language.Haskell.TH hiding (Match, match)@@ -66,9 +42,34 @@ import Test.HMock.Predicates (Predicate (..), eq) import Test.HMock.Rule (Expectable (..)) --- | Custom options for deriving a 'Mockable' class.-data MockableOptions = MockableOptions-  { -- | Suffix to add to 'Action' and 'Matcher' names.  Defaults to @""@.+-- | Custom options for deriving 'MockableBase' and related instances.+data MakeMockableOptions = MakeMockableOptions+  { -- | Whether to generate a 'Mockable' instance with an empty setup.  If this+    -- is 'False', you are responsible for providing a 'Mockable' instance.+    -- Defaults to 'True'.+    --+    -- If this is 'False', you are responsible for providing a 'Mockable'+    -- instance as follows:+    --+    -- @+    -- instance 'Mockable' MyClass where+    --   'Test.HMock.Mockable.setupMockable' _ = ...+    -- @+    mockEmptySetup :: Bool,+    -- | Whether to derive instances of the class for 'MockT' or not.  Defaults+    -- to 'True'.+    --+    -- This option will cause a build error if some members of the class are+    -- unmockable or are not methods.  In this case, you'll need to define this+    -- instance yourself, delegating the mockable methods as follows:+    --+    -- @+    -- instance MyClass ('MockT' m) where+    --   myMethod x y = 'mockMethod' (MyMethod x y)+    --   ...+    -- @+    mockDeriveForMockT :: Bool,+    -- | 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@@ -76,180 +77,43 @@     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+instance Default MakeMockableOptions where+  def =+    MakeMockableOptions+      { mockEmptySetup = True,+        mockDeriveForMockT = True,+        mockSuffix = "",+        mockVerbose = False+      } --- | 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:+-- | Defines all instances necessary to use HMock with the given type, using+-- default options.  The type should be a type class extending 'Monad', applied+-- to zero or more type arguments. ----- @--- 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.+-- This defines all of the following instances, if necessary: ----- See 'deriveForMockT' for restrictions on the use of this splice.-deriveTypeForMockT :: Q Type -> Q [Dec]-deriveTypeForMockT = deriveTypeForMockTWithOptions def+-- * 'MockableBase' and the associated 'Action' and 'Matcher' types.+-- * 'Expectable' instances for the 'Action' type.+-- * 'Mockable' with an empty setup.+-- * Instances of the provided application type class to allow unit tests to be+--   run with the 'MockT' monad transformer.+makeMockable :: Q Type -> Q [Dec]+makeMockable qtype = makeMockableWithOptions qtype 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.+-- | Defines all instances necessary to use HMock with the given type, using+-- the provided options.  The type should be a type class extending 'Monad',+-- applied to zero or more type arguments. ----- 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.+-- This defines the following instances, if necessary: ----- See 'deriveForMockT' for restrictions on the use of this splice.-deriveTypeForMockTWithOptions :: MockableOptions -> Q Type -> Q [Dec]-deriveTypeForMockTWithOptions = deriveForMockTImpl+-- * 'MockableBase' and the associated 'Action' and 'Matcher' types.+-- * 'Expectable' instances for the 'Action' type.+-- * If 'mockEmptySetup' is 'True': 'Mockable' with an empty setup.+-- * If 'mockDeriveForMockT' is 'True': Instances of the provided application+--   type class to allow unit tests to be run with the 'MockT' monad+--   transformer.+makeMockableWithOptions :: Q Type -> MakeMockableOptions -> Q [Dec]+makeMockableWithOptions qtype options = makeMockableImpl options qtype  data Instance = Instance   { instType :: Type,@@ -280,12 +144,13 @@         _ -> 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 :: MakeMockableOptions -> 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)+    go (ClassD cx _ params _ members) =+      matchVars ty [] (tvName <$> params)       where         matchVars :: Type -> [Type] -> [Name] -> Q Instance         matchVars _ _ [] = internalError@@ -294,14 +159,16 @@         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 genVars = init ps+          let mVar = last ps+          let t = foldl' (\t' v -> AppT t' (VarT v)) ty genVars           let tbl = zip (tvName <$> params) ts           let cx' = substTypeVars tbl <$> cx-          makeInstance options t cx' tbl (init ps) (last ps) members+          makeInstance options t cx' tbl genVars mVar members     go _ = internalError  makeInstance ::-  MockableOptions ->+  MakeMockableOptions ->   Type ->   Cxt ->   [(Name, Type)] ->@@ -341,8 +208,12 @@           [ nameBase name               ++ " can't be mocked: return value not in the expected monad."           ]-    unless (all (isVarTypeable cx) (filter (`elem` tvs) (freeTypeVars retval))) $-      Left+    unless+      ( all+          (isVarTypeable cx)+          (filter (`elem` tvs) (freeTypeVars retval))+      )+      $ Left         [ nameBase name             ++ " can't be mocked: return value not Typeable."         ]@@ -364,19 +235,24 @@   where     isVarTypeable :: Cxt -> Name -> Bool     isVarTypeable cx v = AppT (ConT ''Typeable) (VarT v) `elem` cx- getMethod _ _ _ (DataD _ name _ _ _ _) =-  return (Left [nameBase name ++ " must be defined in manual MockT instance."])+  return $+    Left [nameBase name ++ " must be defined manually in MockT instance."] getMethod _ _ _ (NewtypeD _ name _ _ _ _) =-  return (Left [nameBase name ++ " must be defined in manual MockT instance."])+  return $+    Left [nameBase name ++ " must be defined manually in MockT instance."] getMethod _ _ _ (TySynD name _ _) =-  return (Left [nameBase name ++ " must be defined in manual MockT instance."])+  return $+    Left [nameBase name ++ " must be defined manually in MockT instance."] getMethod _ _ _ (DataFamilyD name _ _) =-  return (Left [nameBase name ++ " must be defined in manual MockT instance."])+  return $+    Left [nameBase name ++ " must be defined manually in MockT instance."] getMethod _ _ _ (OpenTypeFamilyD (TypeFamilyHead name _ _ _)) =-  return (Left [nameBase name ++ " must be defined in manual MockT instance."])+  return $+    Left [nameBase name ++ " must be defined manually in MockT instance."] getMethod _ _ _ (ClosedTypeFamilyD (TypeFamilyHead name _ _ _) _) =-  return (Left [nameBase name ++ " must be defined in manual MockT instance."])+  return $+    Left [nameBase name ++ " must be defined manually in MockT instance."] getMethod _ _ _ _ = return (Left [])  isKnownType :: Method -> Type -> Bool@@ -395,47 +271,66 @@       $(pure (methodResult method))     |] -deriveMockableImpl :: Bool -> MockableOptions -> Q Type -> Q [Dec]-deriveMockableImpl baseOnly options qt = do+makeMockableImpl :: MakeMockableOptions -> Q Type -> Q [Dec]+makeMockableImpl options qtype = do   checkExt DataKinds   checkExt FlexibleInstances   checkExt GADTs   checkExt MultiParamTypeClasses+  checkExt ScopedTypeVariables   checkExt TypeFamilies -  inst <- getInstance options =<< qt+  ty <- qtype+  let generalizedTy = case unappliedName ty of+        Just cls -> ConT cls+        _ -> ty+  inst <- getInstance options generalizedTy    when (null (instMethods inst)) $ do     fail $       "Cannot derive Mockable because " ++ pprint (instType inst)         ++ " has no mockable methods." -  typeableCxts <- constrainVars [conT ''Typeable] (instGeneralParams inst)+  typeableCxt <- constrainVars [conT ''Typeable] (instGeneralParams inst) +  needsMockableBase <-+    isNothing <$> resolveInstance ''MockableBase [instType 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)-      ]+    if needsMockableBase+      then do+        mockableBase <-+          instanceD+            (pure typeableCxt)+            [t|MockableBase $(pure (instType inst))|]+            [ defineActionType options inst,+              defineMatcherType options inst,+              defineShowAction options (instMethods inst),+              defineShowMatcher options (instMethods inst),+              defineMatchAction options (instMethods inst)+            ]+        expectables <- defineExpectableActions options inst+        return (mockableBase : expectables)+      else return []++  needsMockable <-+    if mockEmptySetup options+      then isNothing <$> resolveInstance ''Mockable [instType inst]+      else return False   mockable <--    if baseOnly-      then return []-      else+    if needsMockable+      then         (: [])           <$> instanceD-            (pure typeableCxts)+            (pure typeableCxt)             [t|Mockable $(pure (instType inst))|]             []-  expectables <- defineExpectableActions options inst+      else return [] -  return $ mockableBase : mockable ++ expectables+  mockt <- deriveForMockT options ty -defineActionType :: MockableOptions -> Instance -> DecQ+  return $ mockableBase ++ mockable ++ mockt++defineActionType :: MakeMockableOptions -> Instance -> DecQ defineActionType options inst = do   kind <-     [t|@@ -445,9 +340,15 @@       Data.Kind.Type       |]   let cons = actionConstructor options inst <$> instMethods inst-  dataInstD (pure []) ''Action [pure (instType inst)] (Just kind) cons []+  dataInstD+    (pure [])+    ''Action+    [pure (instType inst)]+    (Just kind)+    cons+    [] -actionConstructor :: MockableOptions -> Instance -> Method -> ConQ+actionConstructor :: MakeMockableOptions -> Instance -> Method -> ConQ actionConstructor options inst method = do   forallC [] (return (methodCxt method)) $     gadtC@@ -457,13 +358,13 @@       ]       (withMethodParams inst method [t|Action|]) -getActionName :: MockableOptions -> Method -> Name+getActionName :: MakeMockableOptions -> 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 :: MakeMockableOptions -> Instance -> Q Dec defineMatcherType options inst = do   kind <-     [t|@@ -473,9 +374,15 @@       Data.Kind.Type       |]   let cons = matcherConstructor options inst <$> instMethods inst-  dataInstD (pure []) ''Matcher [pure (instType inst)] (Just kind) cons []+  dataInstD+    (pure [])+    ''Matcher+    [pure (instType inst)]+    (Just kind)+    cons+    [] -matcherConstructor :: MockableOptions -> Instance -> Method -> ConQ+matcherConstructor :: MakeMockableOptions -> Instance -> Method -> ConQ matcherConstructor options inst method = do   gadtC     [getMatcherName options method]@@ -497,17 +404,17 @@         (tyVars, cx) =           relevantContext argTy (methodTyVars method, methodCxt method) -getMatcherName :: MockableOptions -> Method -> Name+getMatcherName :: MakeMockableOptions -> 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 :: MakeMockableOptions -> [Method] -> Q Dec defineShowAction options methods =   funD 'showAction (showActionClause options <$> methods) -showActionClause :: MockableOptions -> Method -> Q Clause+showActionClause :: MakeMockableOptions -> Method -> Q Clause showActionClause options method = do   argVars <- replicateM (length (methodArgs method)) (newName "a")   clause@@ -525,22 +432,44 @@     )     []   where+    isLocalPoly ty =+      not . null . fst $+        relevantContext ty (methodTyVars method, methodCxt method)+     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) ""|]+      | hasPolyType ty = return False+      | isLocalPoly ty = (`elem` methodCxt method) <$> [t|Show $(pure ty)|]+      | null (freeTypeVars ty) = isInstance ''Show [ty]+      | otherwise = return False -defineShowMatcher :: MockableOptions -> [Method] -> Q Dec+    canType ty+      | hasPolyType ty = return False+      | isLocalPoly ty =+        (`elem` methodCxt method)+          <$> [t|Typeable $(pure ty)|]+      | otherwise = return (null (freeTypeVars ty))++    argPattern ty v = canShow ty >>= flip sigP (pure ty) . bool wildP (varP v)++    showArg ty var = do+      showable <- canShow ty+      typeable <- canType ty+      case (showable, typeable) of+        (True, _) -> [|showsPrec 11 $(varE var) ""|]+        (_, True) ->+          [|+            "(_ :: "+              ++ show (typeRep (undefined :: Proxy $(return ty)))+              ++ ")"+            |]+        _ -> lift ("(_  :: " ++ pprint (removeModNames ty) ++ ")")++defineShowMatcher :: MakeMockableOptions -> [Method] -> Q Dec defineShowMatcher options methods = do   clauses <- concatMapM (showMatcherClauses options) methods   funD 'showMatcher clauses -showMatcherClauses :: MockableOptions -> Method -> Q [ClauseQ]+showMatcherClauses :: MakeMockableOptions -> Method -> Q [ClauseQ] showMatcherClauses options method = do   argTVars <- replicateM (length (methodArgs method)) (newName "t")   predVars <- replicateM (length (methodArgs method)) (newName "p")@@ -567,7 +496,7 @@   where     actionArg t ty       | isKnownType method ty = wildP-      | otherwise = checkExt ScopedTypeVariables >> sigP wildP (varT t)+      | otherwise = sigP wildP (varT t)      matcherArg p ty       | isKnownType method ty = varP p@@ -582,11 +511,11 @@       | isKnownType method ty = [|"«" ++ show $(varE p) ++ "»"|]       | otherwise = [|"«polymorphic»"|] -defineMatchAction :: MockableOptions -> [Method] -> Q Dec+defineMatchAction :: MakeMockableOptions -> [Method] -> Q Dec defineMatchAction options methods =   funD 'matchAction (matchActionClause options <$> methods) -matchActionClause :: MockableOptions -> Method -> Q Clause+matchActionClause :: MakeMockableOptions -> Method -> Q Clause matchActionClause options method = do   argVars <-     replicateM@@ -600,19 +529,32 @@       conP (getActionName options method) (varP . snd <$> argVars)     ]     ( guardedB-        [ (,) <$> normalG [|$(varE mmVar) == 0|] <*> [|Match|],+        [ (,) <$> normalG [|null $(varE mmVar)|] <*> [|Match|],           (,) <$> normalG [|otherwise|] <*> [|NoMatch $(varE mmVar)|]         ]     )     [ valD         (varP mmVar)-        (normalB [|length (filter not $(listE (mkAccept <$> argVars)))|])+        ( normalB+            [|+              catMaybes $+                zipWith+                  (\i mm -> fmap (\x -> (i, x)) mm)+                  [1 ..]+                  $(listE (mkAccept <$> argVars))+              |]+        )         []     ]   where-    mkAccept (p, a) = [|accept $(return (VarE p)) $(return (VarE a))|]+    mkAccept (p, a) =+      [|+        if accept $(return (VarE p)) $(return (VarE a))+          then Nothing+          else Just $ explain $(return (VarE p)) $(return (VarE a))+        |] -defineExpectableActions :: MockableOptions -> Instance -> Q [Dec]+defineExpectableActions :: MakeMockableOptions -> Instance -> Q [Dec] defineExpectableActions options inst =   mapM (defineExpectableAction options inst) (instMethods inst) @@ -622,7 +564,7 @@   )     ':$$: 'Text "Suggested fix: Use a Matcher instead of an Action." -defineExpectableAction :: MockableOptions -> Instance -> Method -> Q Dec+defineExpectableAction :: MakeMockableOptions -> Instance -> Method -> Q Dec defineExpectableAction options inst method = do   maybeCxt <- wholeCxt (methodArgs method)   argVars <- replicateM (length (methodArgs method)) (newName "a")@@ -681,49 +623,62 @@       | VarT v <- argTy =         Just <$> sequence [[t|Eq $(varT v)|], [t|Show $(varT v)|]]       | otherwise = do-        eqCxt <- resolveInstance ''Eq argTy-        showCxt <- resolveInstance ''Show argTy+        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+deriveForMockT :: MakeMockableOptions -> Type -> Q [Dec]+deriveForMockT options ty = do+  inst <- getInstance options {mockVerbose = False} ty+  needsMockT <-+    if mockDeriveForMockT options+      then+        isNothing+          <$> resolveInstanceType+            ( AppT+                (instType inst)+                (AppT (ConT ''MockT) (VarT (instMonadVar inst)))+            )+      else return False -  unless (null (instExtraMembers inst)) $-    fail $-      "Cannot derive MockT because " ++ pprint (instType inst)-        ++ " has unmockable methods."+  if needsMockT+    then do+      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)+      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))-             ]+      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."+      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."+    else return [] -implementMethod :: MockableOptions -> Method -> Q Dec+implementMethod :: MakeMockableOptions -> Method -> Q Dec implementMethod options method = do   argVars <- replicateM (length (methodArgs method)) (newName "a")   funD@@ -734,7 +689,7 @@     actionExp (v : vs) e = actionExp vs [|$e $(varE v)|]      body argVars = do-      defaultCxt <- resolveInstance ''Default (methodResult method)+      defaultCxt <- resolveInstance ''Default [methodResult method]       let someMockMethod = case defaultCxt of             Just [] -> [|mockMethod|]             _ -> [|mockDefaultlessMethod|]

@@ -38,24 +38,25 @@ class MonadSimple m where   simple :: String -> m () -makeMockable ''MonadSimple+makeMockable [t|MonadSimple|]  simpleTests :: SpecWith () simpleTests = describe "MonadSimple" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadSimple)-        runQ (makeMockable ''MonadSimple)+        runQ (makeMockable [t|MonadSimple|])       evaluate (rnf decs)    it "doesn't require unnecessary extensions for simple cases" $     example . runMockT $ do+      allowUnexpected $ QReifyInstances_ anything anything |-> []       $(onReify [|expectAny|] ''MonadSimple)-      expectAny $ QIsExtEnabled ScopedTypeVariables |-> False       expectAny $ QIsExtEnabled RankNTypes |-> False -      _ <- runQ (makeMockable ''MonadSimple)+      _ <- runQ (makeMockable [t|MonadSimple|])       return ()    it "fails when GADTs is disabled" $@@ -64,10 +65,10 @@             expectAny $ QIsExtEnabled GADTs |-> False             expect $ QReport_ anything (hasSubstr "Please enable GADTs") -            _ <- runQ (makeMockable ''MonadSimple)+            _ <- runQ (makeMockable [t|MonadSimple|])             return () -      missingGADTs `shouldThrow` anyIOException+      missingGADTs `shouldThrow` anyException    it "fails when TypeFamilies is disabled" $     example $ do@@ -75,10 +76,10 @@             expectAny $ QIsExtEnabled TypeFamilies |-> False             expect $ QReport_ anything (hasSubstr "Please enable TypeFamilies") -            _ <- runQ (makeMockable ''MonadSimple)+            _ <- runQ (makeMockable [t|MonadSimple|])             return () -      missingTypeFamilies `shouldThrow` anyIOException+      missingTypeFamilies `shouldThrow` anyException    it "fails when DataKinds is disabled" $     example $ do@@ -86,10 +87,10 @@             expectAny $ QIsExtEnabled DataKinds |-> False             expect $ QReport_ anything (hasSubstr "Please enable DataKinds") -            _ <- runQ (makeMockable ''MonadSimple)+            _ <- runQ (makeMockable [t|MonadSimple|])             return () -      missingDataKinds `shouldThrow` anyIOException+      missingDataKinds `shouldThrow` anyException    it "fails when FlexibleInstances is disabled" $     example $ do@@ -98,10 +99,10 @@             expect $               QReport_ anything (hasSubstr "Please enable FlexibleInstances") -            _ <- runQ (makeMockable ''MonadSimple)+            _ <- runQ (makeMockable [t|MonadSimple|])             return () -      missingDataKinds `shouldThrow` anyIOException+      missingDataKinds `shouldThrow` anyException    it "fails when MultiParamTypeClasses is disabled" $     example $ do@@ -112,11 +113,25 @@                 anything                 (hasSubstr "Please enable MultiParamTypeClasses") -            _ <- runQ (makeMockable ''MonadSimple)+            _ <- runQ (makeMockable [t|MonadSimple|])             return () -      missingDataKinds `shouldThrow` anyIOException+      missingDataKinds `shouldThrow` anyException +  it "fails when ScopedTypeVariables is disabled" $+    example $ do+      let missingDataKinds = runMockT $ do+            expectAny $ QIsExtEnabled ScopedTypeVariables |-> False+            expect $+              QReport_+                anything+                (hasSubstr "Please enable ScopedTypeVariables")++            _ <- runQ (makeMockable [t|MonadSimple|])+            return ()++      missingDataKinds `shouldThrow` anyException+   it "fails when too many params are given" $     example $ do       let tooManyParams = runMockT $ do@@ -124,10 +139,10 @@             expect $               QReport_ anything (hasSubstr "is applied to too many arguments") -            _ <- runQ (makeMockableType [t|MonadSimple IO|])+            _ <- runQ (makeMockable [t|MonadSimple IO|])             return () -      tooManyParams `shouldThrow` anyIOException+      tooManyParams `shouldThrow` anyException    it "is mockable" $     example $ do@@ -145,15 +160,17 @@ class MonadSuffix m where   suffix :: String -> m () -makeMockableWithOptions def {mockSuffix = "Blah"} ''MonadSuffix+makeMockableWithOptions [t|MonadSuffix|] def {mockSuffix = "Blah"}  suffixTests :: SpecWith () suffixTests = describe "MonadSuffix" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadSuffix)-        runQ (makeMockableWithOptions def {mockSuffix = "Blah"} ''MonadSuffix)+        runQ $+          makeMockableWithOptions [t|MonadSuffix|] def {mockSuffix = "Blah"}       evaluate (rnf decs)    it "is mockable" $@@ -172,7 +189,7 @@ class MonadWithSetup m where   withSetup :: m String -makeMockableBase ''MonadWithSetup+makeMockableWithOptions [t|MonadWithSetup|] def {mockEmptySetup = False}  instance Mockable MonadWithSetup where   setupMockable _ = do@@ -183,8 +200,12 @@   it "generates mock impl" $ do     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadWithSetup)-        runQ (makeMockableBase ''MonadWithSetup)+        runQ $+          makeMockableWithOptions+            [t|MonadWithSetup|]+            def {mockEmptySetup = False}       evaluate (rnf decs)    it "returns the customized default value" $ do@@ -217,13 +238,14 @@ class (SuperClass m, Monad m, Typeable m) => MonadSuper m where   withSuper :: m () -makeMockable ''MonadSuper+makeMockable [t|MonadSuper|]  superTests :: SpecWith () superTests = describe "MonadSuper" $ do   it "generated mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadSuper)         expectAny $           QReifyInstances_@@ -234,7 +256,7 @@                      [AppT (ConT ''MockT) (VarT (mkName "v"))]                  ) -        runQ (makeMockable ''MonadSuper)+        runQ (makeMockable [t|MonadSuper|])       evaluate (rnf decs)    it "is mockable" $@@ -252,15 +274,16 @@   mptc :: a -> m ()   mptcList :: [a] -> m () -makeMockable ''MonadMPTC+makeMockable [t|MonadMPTC|]  mptcTests :: SpecWith () mptcTests = describe "MonadMPTC" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadMPTC)-        runQ (makeMockable ''MonadMPTC)+        runQ (makeMockable [t|MonadMPTC|])       evaluate (rnf decs)    it "is mockable" $@@ -279,15 +302,16 @@ class MonadFDSpecialized a m | m -> a where   fdSpecialized :: a -> m a -makeMockableType [t|MonadFDSpecialized String|]+makeMockable [t|MonadFDSpecialized String|]  fdSpecializedTests :: SpecWith () fdSpecializedTests = describe "MonadFDSpecialized" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadFDSpecialized)-        runQ (makeMockableType [t|MonadFDSpecialized String|])+        runQ (makeMockable [t|MonadFDSpecialized String|])       evaluate (rnf decs)    it "is mockable" $@@ -307,7 +331,7 @@ class MonadFDGeneral a m | m -> a where   fdGeneral :: a -> m a -deriveMockable ''MonadFDGeneral+makeMockableWithOptions [t|MonadFDGeneral|] def {mockDeriveForMockT = False}  newtype MyBase m a = MyBase {runMyBase :: m a}   deriving newtype (Functor, Applicative, Monad, MonadIO)@@ -323,8 +347,12 @@   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadFDGeneral)-        runQ (deriveMockable ''MonadFDGeneral)+        runQ $+          makeMockableWithOptions+            [t|MonadFDGeneral|]+            def {mockDeriveForMockT = False}       evaluate (rnf decs)    it "is mockable" $@@ -344,30 +372,38 @@ 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|]+makeMockableWithOptions+  [t|MonadFDMixed String Int|]+  def {mockDeriveForMockT = False} +makeMockable [t|MonadFDMixed String Int String String|]+ fdMixedTests :: SpecWith () fdMixedTests = describe "MonadFDMixed" $ do   it "generates mock impl" $     example . runMockT $ do+      allowUnexpected $ QReifyInstances_ anything anything |-> []       $(onReify [|expectAny|] ''MonadFDMixed) -      decs1 <- runQ (deriveMockableType [t|MonadFDMixed String Int|])+      decs1 <-+        runQ $+          makeMockableWithOptions+            [t|MonadFDMixed String Int|]+            def {mockDeriveForMockT = False}       decs2 <--        runQ (deriveTypeForMockT [t|MonadFDMixed String Int String Int|])+        runQ (makeMockable [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"+            expect $ FdMixed "foo" (1 :: Int) "bar" |-> "qux"             r <- fdMixed "foo" 1 "bar"             liftIO $ r `shouldBe` "qux"            failure = runMockT $ do-            expect $ FdMixed "foo" 1 "bar" |-> "qux"+            expect $ FdMixed "foo" (1 :: Int) "bar" |-> "qux"             _ <- fdMixed "bar" 1 "foo"             return () @@ -377,30 +413,18 @@ class MonadPolyArg m where   polyArg :: Enum a => String -> a -> b -> m () -makeMockable ''MonadPolyArg+makeMockable [t|MonadPolyArg|]  polyArgTests :: SpecWith () polyArgTests = describe "MonadPolyArg" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadPolyArg)-        runQ (makeMockable ''MonadPolyArg)+        runQ (makeMockable [t|MonadPolyArg|])       evaluate (rnf decs) -  it "fails without ScopedTypeVariables" $-    example $ do-      let missingScopedTypeVariables = runMockT $ do-            $(onReify [|expectAny|] ''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@@ -409,7 +433,7 @@             expect $               QReport_ anything (hasSubstr "Please enable RankNTypes") -            _ <- runQ (makeMockable ''MonadPolyArg)+            _ <- runQ (makeMockable [t|MonadPolyArg|])             return ()        missingRankNTypes `shouldThrow` anyException@@ -432,15 +456,16 @@ class MonadUnshowableArg m where   unshowableArg :: (Int -> Int) -> m () -makeMockable ''MonadUnshowableArg+makeMockable [t|MonadUnshowableArg|]  unshowableArgTests :: SpecWith () unshowableArgTests = describe "MonadUnshowableArg" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadUnshowableArg)-        runQ (makeMockable ''MonadUnshowableArg)+        runQ (makeMockable [t|MonadUnshowableArg|])       evaluate (rnf decs)    it "is mockable" $@@ -461,15 +486,16 @@ class MonadInArg m where   monadInArg :: (Int -> m ()) -> m () -makeMockable ''MonadInArg+makeMockable [t|MonadInArg|]  monadInArgTests :: SpecWith () monadInArgTests = describe "MonadInArg" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadInArg)-        runQ (makeMockable ''MonadInArg)+        runQ (makeMockable [t|MonadInArg|])       evaluate (rnf decs)    it "is mockable" $@@ -491,7 +517,7 @@   polyResult :: Typeable a => a -> m a   nonTypeablePolyResult :: a -> m a -deriveMockable ''MonadPolyResult+makeMockableWithOptions [t|MonadPolyResult|] def {mockDeriveForMockT = False}  instance (MonadIO m, Typeable m) => MonadPolyResult (MockT m) where   polyResult x = mockDefaultlessMethod (PolyResult x)@@ -502,8 +528,12 @@   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadPolyResult)-        runQ (deriveMockable ''MonadPolyResult)+        runQ $+          makeMockableWithOptions+            [t|MonadPolyResult|]+            def {mockDeriveForMockT = False}       evaluate (rnf decs)    it "is mockable" $@@ -520,7 +550,9 @@    mockableMethod :: Int -> m () -deriveMockable ''MonadExtraneousMembers+makeMockableWithOptions+  [t|MonadExtraneousMembers|]+  def {mockDeriveForMockT = False}  instance (Typeable m, MonadIO m) => MonadExtraneousMembers (MockT m) where   data SomeDataType (MockT m) = SomeCon@@ -535,18 +567,23 @@   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadExtraneousMembers)-        runQ (deriveMockable ''MonadExtraneousMembers)+        runQ $+          makeMockableWithOptions+            [t|MonadExtraneousMembers|]+            def {mockDeriveForMockT = False}       evaluate (rnf decs)    it "warns about non-methods" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadExtraneousMembers)         expect $           QReport             False-            "SomeDataType must be defined in manual MockT instance."+            "SomeDataType must be defined manually in MockT instance."         expect $           QReport             False@@ -565,9 +602,9 @@             "nestedRankN can't be mocked: rank-n types nested in arguments."          runQ-          ( deriveMockableWithOptions-              def {mockVerbose = True}-              ''MonadExtraneousMembers+          ( makeMockableWithOptions+              [t|MonadExtraneousMembers|]+              def {mockDeriveForMockT = False, mockVerbose = True}           )       evaluate (rnf decs) @@ -578,10 +615,10 @@             expect $               QReport_ anything (hasSubstr "has unmockable methods") -            _ <- runQ (makeMockable ''MonadExtraneousMembers)+            _ <- runQ (makeMockable [t|MonadExtraneousMembers|])             return () -      unmockableMethods `shouldThrow` anyIOException+      unmockableMethods `shouldThrow` anyException    it "is mockable" $     example $ do@@ -599,15 +636,16 @@ class MonadRankN m where   rankN :: (forall a. a -> Bool) -> Bool -> m () -makeMockable ''MonadRankN+makeMockable [t|MonadRankN|]  rankNTests :: SpecWith () rankNTests = describe "MonadRankN" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadRankN)-        runQ (deriveMockable ''MonadRankN)+        runQ (makeMockable [t|MonadRankN|])       evaluate (rnf decs)    it "is mockable" $@@ -633,7 +671,7 @@   returnsMaybe :: m (Maybe Bool)   returnsNoDefault :: m NoDefault -makeMockable ''MonadManyReturns+makeMockable [t|MonadManyReturns|]  defaultReturnTests :: SpecWith () defaultReturnTests = do@@ -641,10 +679,11 @@     it "generates mock impl" $       example $ do         decs <- runMockT $ do+          allowUnexpected $ QReifyInstances_ anything anything |-> []           $(onReify [|expectAny|] ''MonadManyReturns)           $(onReifyInstances [|expectAny|] ''Default [ConT ''NoDefault]) -          runQ (makeMockable ''MonadManyReturns)+          runQ (makeMockable [t|MonadManyReturns|])         evaluate (rnf decs)      it "fails when there's an unexpected method" $@@ -689,20 +728,21 @@ class MonadNestedNoDef m where   nestedNoDef :: m (NoDefault, String) -$(return []) -- Hack to get types into the TH environment.+makeMockable [t|MonadNestedNoDef|]  nestedNoDefTests :: SpecWith () nestedNoDefTests = describe "MonadNestedNoDef" $ do   it "generates mock impl" $     example $ do       decs <- runMockT $ do+        allowUnexpected $ QReifyInstances_ anything anything |-> []         $(onReify [|expectAny|] ''MonadNestedNoDef)         $( [t|(NoDefault, String)|]              >>= onReifyInstances [|expectAny|] ''Default . (: [])          )         $(onReifyInstances [|expectAny|] ''Default [ConT ''NoDefault]) -        runQ (makeMockable ''MonadNestedNoDef)+        runQ (makeMockable [t|MonadNestedNoDef|])       evaluate (rnf decs)  class ClassWithNoParams@@ -719,20 +759,20 @@                 anything                 (hasSubstr "Expected GHC.Types.Int to be a class") -            _ <- runQ (makeMockable ''Int)+            _ <- runQ (makeMockable [t|Int|])             return () -      wrongKind `shouldThrow` anyIOException+      wrongKind `shouldThrow` anyException -  it "fails when given an unexpected type construct" $+  it "fails when given an unexpected type constructor" $     example $ do       let notClass = runMockT $ do             expect $ QReport_ anything (hasSubstr "Expected a class") -            _ <- runQ (makeMockableType [t|(Int, String)|])+            _ <- runQ (makeMockable [t|(Int, String)|])             return () -      notClass `shouldThrow` anyIOException+      notClass `shouldThrow` anyException    it "fails when class has no params" $     example $ do@@ -743,20 +783,20 @@                 anything                 (hasSubstr "ClassWithNoParams has no type parameters") -            _ <- runQ (makeMockable ''ClassWithNoParams)+            _ <- runQ (makeMockable [t|ClassWithNoParams|])             return () -      tooManyParams `shouldThrow` anyIOException+      tooManyParams `shouldThrow` anyException    it "fails when class has no mockable methods" $     example $ do       let noMockableMethods = runMockT $ do             $(onReify [|expectAny|] ''Show)             expect $ QReport_ anything (hasSubstr "has no mockable methods")-            _ <- runQ (deriveMockable ''Show)+            _ <- runQ (makeMockable [t|Show|])             return () -      noMockableMethods `shouldThrow` anyIOException+      noMockableMethods `shouldThrow` anyException  classTests :: SpecWith () classTests = describe "makeMockable" $ do

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -14,7 +15,12 @@ import Control.Monad.Reader (MonadReader (local), ask, runReaderT) import Control.Monad.State (execStateT, modify) import Control.Monad.Trans (liftIO)-import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef)+import Data.IORef+  ( modifyIORef,+    newIORef,+    readIORef,+    writeIORef,+  ) import Data.List (isInfixOf, isPrefixOf) import Test.HMock import Test.Hspec@@ -32,7 +38,7 @@   readFile = Prelude.readFile   writeFile = Prelude.writeFile -makeMockable ''MonadFilesystem+makeMockable [t|MonadFilesystem|]  newtype SocketHandle = Handle Int deriving (Eq, Show) @@ -40,7 +46,7 @@   openSocket :: Int -> m SocketHandle   closeSocket :: SocketHandle -> m () -makeMockable ''MonadSocket+makeMockable [t|MonadSocket|]  coreTests :: SpecWith () coreTests = do@@ -298,6 +304,16 @@         failure1 `shouldThrow` anyException         failure2 `shouldThrow` anyException +    it "describes argument predicates that don't match" $+      example $ do+        let test = runMockT $ do+              expect $ WriteFile_ (eq "foo.txt") (hasSubstr "foo")+              _ <- writeFile "foo.txt" "bar"+              return ()+        test+          `shouldThrow` errorWith+            ("Arg #2: \"bar\" doesn't have substring \"foo\"" `isInfixOf`)+     it "enforces nested sequences" $       example $ do         let setExpectations =@@ -596,6 +612,10 @@     it "describes expectations when asked" $       example . runMockT $ do         expectAny $ ReadFile_ anything+        expectAny $+          WriteFile_ anything anything+            `SuchThat` \(WriteFile a b) -> b `isInfixOf` a+         expectations <- describeExpectations          -- Format is deliberately unspecified.  We're forcing it here so that@@ -681,7 +701,7 @@         let setExpectations = do               expect $ ReadFile_ anything               expect $ ReadFile "foo.txt"-              setAmbiguityCheck True+              setAmbiguityCheck Error              failure = runMockT $ do               setExpectations@@ -697,6 +717,31 @@          success         failure `shouldThrow` errorWith ("Ambiguous action" `isInfixOf`)++    it "ignores unexpected actions when asked" $+      example . runMockT $ do+        setUnexpectedActionCheck Ignore+        writeFile "foo.txt" "unexpected"++    it "ignores uninteresting actions when asked" $+      example . runMockT $ do+        setUninterestingActionCheck Ignore+        writeFile "foo.txt" "unexpected"++    it "still catches unexpected actions when ignoring uninteresting actions" $+      example $ do+        let test = runMockT $ do+              setUninterestingActionCheck Ignore+              expect $ WriteFile "bar.txt" ""++              writeFile "foo.txt" "unexpected"++        test `shouldThrow` anyException++    it "ignores unmet expectations when asked" $+      example . runMockT $ do+        setUnmetExpectationCheck Ignore+        expect $ ReadFile_ anything      describe "nestMockT" $ do       it "checks nested context early" $ do

@@ -16,14 +16,16 @@ import Control.Monad (unless, when) import Control.Monad.Catch (MonadMask, catch, finally, throwM) import Data.Char (isLetter)+import Data.Default (def) import Test.HMock-  ( Mockable (..),-    anything,+  ( MakeMockableOptions (..),+    Mockable (..),     allowUnexpected,+    anything,     expect,     expectAny,     makeMockable,-    makeMockableBase,+    makeMockableWithOptions,     runMockT,     (|->),     (|=>),@@ -145,14 +147,14 @@  -- Since there is no setup for MonadBugReport, it's easiest to use makeMockable -- to derive all instances needed to mock this class.-makeMockable ''MonadBugReport+makeMockable [t|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+makeMockableWithOptions [t|MonadAuth|] def {mockEmptySetup = False}  instance Mockable MonadAuth where   setupMockable _ = do@@ -168,7 +170,7 @@     -- can override this assumption.     allowUnexpected $ HasPermission_ anything |-> True -makeMockableBase ''MonadChat+makeMockableWithOptions [t|MonadChat|] def {mockEmptySetup = False}  instance Mockable MonadChat where   setupMockable _ = do

@@ -1,6 +1,7 @@ -- Do not edit! Automatically created with doctest-extract. module DocTests.All where +import qualified DocTests.Test.HMock.Internal.FlowMatcher import qualified DocTests.Test.HMock.Predicates import qualified DocTests.Test.HMock.Multiplicity @@ -8,5 +9,6 @@  main :: DocTest.T () main = do+    DocTests.Test.HMock.Internal.FlowMatcher.test     DocTests.Test.HMock.Predicates.test     DocTests.Test.HMock.Multiplicity.test

@@ -0,0 +1,20 @@+-- Do not edit! Automatically created with doctest-extract from src/Test/HMock/Internal/FlowMatcher.hs+{-# LINE 14 "src/Test/HMock/Internal/FlowMatcher.hs" #-}++{-# OPTIONS_GHC -Wno-type-defaults #-}+module DocTests.Test.HMock.Internal.FlowMatcher where++import Test.HMock.Internal.FlowMatcher+import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 16 "src/Test/HMock/Internal/FlowMatcher.hs" #-}++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Test.HMock.Internal.FlowMatcher:23: "+{-# LINE 23 "src/Test/HMock/Internal/FlowMatcher.hs" #-}+ DocTest.example+{-# LINE 23 "src/Test/HMock/Internal/FlowMatcher.hs" #-}+      (bipartiteMatching (==) [1 .. 5] [6, 5 .. 2])+  [ExpectedLine [LineChunk "([(2,2),(3,3),(4,4),(5,5)],[1],[6])"]]

@@ -8,135 +8,135 @@  test :: DocTest.T () test = do- DocTest.printPrefix "Test.HMock.Multiplicity:47: "-{-# LINE 47 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:48: "+{-# LINE 48 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 47 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 48 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity 5 4)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Multiplicity:49: "-{-# LINE 49 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:50: "+{-# LINE 50 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 49 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 50 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity 5 5)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:51: "-{-# LINE 51 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:52: "+{-# LINE 52 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 51 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 52 "src/Test/HMock/Multiplicity.hs" #-}       (between 4 6 - between 1 2)   [ExpectedLine [LineChunk "2 to 5 times"]]- DocTest.printPrefix "Test.HMock.Multiplicity:89: "-{-# LINE 89 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:90: "+{-# LINE 90 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 89 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 90 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity once 0)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Multiplicity:91: "-{-# LINE 91 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:92: "+{-# LINE 92 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 91 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 92 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity once 1)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:93: "-{-# LINE 93 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:94: "+{-# LINE 94 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 93 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 94 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity once 2)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Multiplicity:99: "-{-# LINE 99 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:100: "+{-# LINE 100 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 99 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 100 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity anyMultiplicity 0)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:101: "-{-# LINE 101 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:102: "+{-# LINE 102 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 101 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 102 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity anyMultiplicity 1)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:103: "-{-# LINE 103 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:104: "+{-# LINE 104 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 103 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 104 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity anyMultiplicity 10)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:110: "-{-# LINE 110 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:111: "+{-# LINE 111 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 110 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 111 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (atLeast 2) 1)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Multiplicity:112: "-{-# LINE 112 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:113: "+{-# LINE 113 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 112 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 113 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (atLeast 2) 2)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:114: "-{-# LINE 114 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:115: "+{-# LINE 115 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 114 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 115 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (atLeast 2) 3)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:121: "-{-# LINE 121 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:122: "+{-# LINE 122 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 121 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 122 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (atMost 2) 1)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:123: "-{-# LINE 123 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:124: "+{-# LINE 124 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 123 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 124 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (atMost 2) 2)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:125: "-{-# LINE 125 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:126: "+{-# LINE 126 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 125 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 126 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (atMost 2) 3)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Multiplicity:134: "-{-# LINE 134 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:135: "+{-# LINE 135 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 134 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 135 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (between 2 3) 1)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Multiplicity:136: "-{-# LINE 136 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:137: "+{-# LINE 137 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 136 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 137 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (between 2 3) 2)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:138: "-{-# LINE 138 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:139: "+{-# LINE 139 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 138 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 139 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (between 2 3) 3)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:140: "-{-# LINE 140 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:141: "+{-# LINE 141 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 140 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 141 "src/Test/HMock/Multiplicity.hs" #-}       (meetsMultiplicity (between 2 3) 4)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Multiplicity:147: "-{-# LINE 147 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:148: "+{-# LINE 148 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 147 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 148 "src/Test/HMock/Multiplicity.hs" #-}       (feasible once)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:149: "-{-# LINE 149 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:150: "+{-# LINE 150 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 149 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 150 "src/Test/HMock/Multiplicity.hs" #-}       (feasible 0)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Multiplicity:151: "-{-# LINE 151 "src/Test/HMock/Multiplicity.hs" #-}+ DocTest.printPrefix "Test.HMock.Multiplicity:152: "+{-# LINE 152 "src/Test/HMock/Multiplicity.hs" #-}  DocTest.example-{-# LINE 151 "src/Test/HMock/Multiplicity.hs" #-}+{-# LINE 152 "src/Test/HMock/Multiplicity.hs" #-}       (feasible (once - 2))   [ExpectedLine [LineChunk "False"]]

@@ -1,5 +1,5 @@ -- Do not edit! Automatically created with doctest-extract from src/Test/HMock/Predicates.hs-{-# LINE 78 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 85 "src/Test/HMock/Predicates.hs" #-}  {-# OPTIONS_GHC -XTemplateHaskell #-} {-# OPTIONS_GHC -XTypeApplications #-}@@ -10,865 +10,919 @@ import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest -{-# LINE 82 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 89 "src/Test/HMock/Predicates.hs" #-}  test :: DocTest.T () test = do- DocTest.printPrefix "Test.HMock.Predicates:98: "-{-# LINE 98 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:116: "+{-# LINE 116 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 98 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 116 "src/Test/HMock/Predicates.hs" #-}       (accept anything "foo")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:100: "-{-# LINE 100 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:118: "+{-# LINE 118 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 100 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 118 "src/Test/HMock/Predicates.hs" #-}       (accept anything undefined)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:111: "-{-# LINE 111 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:131: "+{-# LINE 131 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 111 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 131 "src/Test/HMock/Predicates.hs" #-}       (accept (eq "foo") "foo")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:113: "-{-# LINE 113 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:133: "+{-# LINE 133 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 113 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 133 "src/Test/HMock/Predicates.hs" #-}       (accept (eq "foo") "bar")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:124: "-{-# LINE 124 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:149: "+{-# LINE 149 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 124 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 149 "src/Test/HMock/Predicates.hs" #-}       (accept (neq "foo") "foo")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:126: "-{-# LINE 126 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:151: "+{-# LINE 151 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 126 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 151 "src/Test/HMock/Predicates.hs" #-}       (accept (neq "foo") "bar")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:137: "-{-# LINE 137 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:158: "+{-# LINE 158 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 137 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 158 "src/Test/HMock/Predicates.hs" #-}       (accept (gt 5) 4)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:139: "-{-# LINE 139 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:160: "+{-# LINE 160 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 139 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 160 "src/Test/HMock/Predicates.hs" #-}       (accept (gt 5) 5)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:141: "-{-# LINE 141 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:162: "+{-# LINE 162 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 141 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 162 "src/Test/HMock/Predicates.hs" #-}       (accept (gt 5) 6)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:153: "-{-# LINE 153 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:176: "+{-# LINE 176 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 153 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 176 "src/Test/HMock/Predicates.hs" #-}       (accept (geq 5) 4)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:155: "-{-# LINE 155 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:178: "+{-# LINE 178 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 155 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 178 "src/Test/HMock/Predicates.hs" #-}       (accept (geq 5) 5)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:157: "-{-# LINE 157 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:180: "+{-# LINE 180 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 157 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 180 "src/Test/HMock/Predicates.hs" #-}       (accept (geq 5) 6)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:168: "-{-# LINE 168 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:193: "+{-# LINE 193 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 168 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 193 "src/Test/HMock/Predicates.hs" #-}       (accept (lt 5) 4)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:170: "-{-# LINE 170 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:195: "+{-# LINE 195 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 170 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 195 "src/Test/HMock/Predicates.hs" #-}       (accept (lt 5) 5)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:172: "-{-# LINE 172 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:197: "+{-# LINE 197 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 172 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 197 "src/Test/HMock/Predicates.hs" #-}       (accept (lt 5) 6)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:183: "-{-# LINE 183 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:204: "+{-# LINE 204 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 183 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 204 "src/Test/HMock/Predicates.hs" #-}       (accept (leq 5) 4)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:185: "-{-# LINE 185 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:206: "+{-# LINE 206 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 185 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 206 "src/Test/HMock/Predicates.hs" #-}       (accept (leq 5) 5)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:187: "-{-# LINE 187 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:208: "+{-# LINE 208 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 187 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 208 "src/Test/HMock/Predicates.hs" #-}       (accept (leq 5) 6)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:199: "-{-# LINE 199 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:216: "+{-# LINE 216 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 199 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 216 "src/Test/HMock/Predicates.hs" #-}       (accept (just (eq "value")) Nothing)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:201: "-{-# LINE 201 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:218: "+{-# LINE 218 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 201 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 218 "src/Test/HMock/Predicates.hs" #-}       (accept (just (eq "value")) (Just "value"))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:203: "-{-# LINE 203 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:220: "+{-# LINE 220 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 203 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 220 "src/Test/HMock/Predicates.hs" #-}       (accept (just (eq "value")) (Just "wrong value"))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:215: "-{-# LINE 215 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:234: "+{-# LINE 234 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 215 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 234 "src/Test/HMock/Predicates.hs" #-}+      (accept nothing Nothing)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.HMock.Predicates:237: "+{-# LINE 237 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 237 "src/Test/HMock/Predicates.hs" #-}+      (accept nothing (Just "something"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.HMock.Predicates:251: "+{-# LINE 251 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 251 "src/Test/HMock/Predicates.hs" #-}       (accept (left (eq "value")) (Left "value"))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:217: "-{-# LINE 217 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:253: "+{-# LINE 253 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 217 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 253 "src/Test/HMock/Predicates.hs" #-}       (accept (left (eq "value")) (Right "value"))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:219: "-{-# LINE 219 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:255: "+{-# LINE 255 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 219 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 255 "src/Test/HMock/Predicates.hs" #-}       (accept (left (eq "value")) (Left "wrong value"))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:231: "-{-# LINE 231 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:269: "+{-# LINE 269 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 231 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 269 "src/Test/HMock/Predicates.hs" #-}       (accept (right (eq "value")) (Right "value"))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:233: "-{-# LINE 233 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:271: "+{-# LINE 271 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 233 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 271 "src/Test/HMock/Predicates.hs" #-}       (accept (right (eq "value")) (Right "wrong value"))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:235: "-{-# LINE 235 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:273: "+{-# LINE 273 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 235 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 273 "src/Test/HMock/Predicates.hs" #-}       (accept (right (eq "value")) (Left "value"))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:247: "-{-# LINE 247 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:287: "+{-# LINE 287 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 247 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 287 "src/Test/HMock/Predicates.hs" #-}       (accept (zipP (eq "foo") (eq "bar")) ("foo", "bar"))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:249: "-{-# LINE 249 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:289: "+{-# LINE 289 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 249 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 289 "src/Test/HMock/Predicates.hs" #-}       (accept (zipP (eq "foo") (eq "bar")) ("bar", "foo"))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:261: "-{-# LINE 261 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:313: "+{-# LINE 313 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 261 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 313 "src/Test/HMock/Predicates.hs" #-}       (accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("foo", "bar", "qux"))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:263: "-{-# LINE 263 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:315: "+{-# LINE 315 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 263 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 315 "src/Test/HMock/Predicates.hs" #-}       (accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("qux", "bar", "foo"))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:275: "-{-# LINE 275 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:340: "+{-# LINE 340 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 275 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 340 "src/Test/HMock/Predicates.hs" #-}       (accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (1, 2, 3, 4))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:277: "-{-# LINE 277 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:342: "+{-# LINE 342 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 277 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 342 "src/Test/HMock/Predicates.hs" #-}       (accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (4, 3, 2, 1))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:295: "-{-# LINE 295 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:373: "+{-# LINE 373 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 295 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 373 "src/Test/HMock/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.Predicates:297: "-{-# LINE 297 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:375: "+{-# LINE 375 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 297 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 375 "src/Test/HMock/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.Predicates:316: "-{-# LINE 316 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:407: "+{-# LINE 407 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 316 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 407 "src/Test/HMock/Predicates.hs" #-}       (accept (lt "foo" `andP` gt "bar") "eta")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:318: "-{-# LINE 318 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:409: "+{-# LINE 409 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 318 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 409 "src/Test/HMock/Predicates.hs" #-}       (accept (lt "foo" `andP` gt "bar") "quz")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:320: "-{-# LINE 320 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:411: "+{-# LINE 411 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 320 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 411 "src/Test/HMock/Predicates.hs" #-}       (accept (lt "foo" `andP` gt "bar") "alpha")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:331: "-{-# LINE 331 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:428: "+{-# LINE 428 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 331 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 428 "src/Test/HMock/Predicates.hs" #-}       (accept (lt "bar" `orP` gt "foo") "eta")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:333: "-{-# LINE 333 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:430: "+{-# LINE 430 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 333 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 430 "src/Test/HMock/Predicates.hs" #-}       (accept (lt "bar" `orP` gt "foo") "quz")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:335: "-{-# LINE 335 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:432: "+{-# LINE 432 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 335 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 432 "src/Test/HMock/Predicates.hs" #-}       (accept (lt "bar" `orP` gt "foo") "alpha")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:347: "-{-# LINE 347 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:440: "+{-# LINE 440 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 347 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 440 "src/Test/HMock/Predicates.hs" #-}       (accept (notP (eq "negative")) "positive")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:349: "-{-# LINE 349 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:442: "+{-# LINE 442 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 349 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 442 "src/Test/HMock/Predicates.hs" #-}       (accept (notP (eq "negative")) "negative")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:360: "-{-# LINE 360 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:455: "+{-# LINE 455 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 360 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 455 "src/Test/HMock/Predicates.hs" #-}       (accept (startsWith "fun") "fungible")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:362: "-{-# LINE 362 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:457: "+{-# LINE 457 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 362 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 457 "src/Test/HMock/Predicates.hs" #-}       (accept (startsWith "gib") "fungible")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:373: "-{-# LINE 373 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:470: "+{-# LINE 470 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 373 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 470 "src/Test/HMock/Predicates.hs" #-}       (accept (endsWith "ow") "crossbow")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:375: "-{-# LINE 375 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:472: "+{-# LINE 472 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 375 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 472 "src/Test/HMock/Predicates.hs" #-}       (accept (endsWith "ow") "trebuchet")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:387: "-{-# LINE 387 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:486: "+{-# LINE 486 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 387 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 486 "src/Test/HMock/Predicates.hs" #-}       (accept (hasSubstr "i") "team")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:389: "-{-# LINE 389 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:488: "+{-# LINE 488 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 389 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 488 "src/Test/HMock/Predicates.hs" #-}       (accept (hasSubstr "i") "partnership")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:401: "-{-# LINE 401 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:502: "+{-# LINE 502 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 401 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 502 "src/Test/HMock/Predicates.hs" #-}       (accept (hasSubsequence [1..5]) [1, 2, 3, 4, 5])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:403: "-{-# LINE 403 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:504: "+{-# LINE 504 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 403 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 504 "src/Test/HMock/Predicates.hs" #-}       (accept (hasSubsequence [1..5]) [0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:405: "-{-# LINE 405 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:506: "+{-# LINE 506 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 405 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 506 "src/Test/HMock/Predicates.hs" #-}       (accept (hasSubsequence [1..5]) [2, 3, 5, 7, 11])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:417: "-{-# LINE 417 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:520: "+{-# LINE 520 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 417 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 520 "src/Test/HMock/Predicates.hs" #-}       (accept (caseInsensitive startsWith "foo") "FOOTBALL!")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:419: "-{-# LINE 419 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:522: "+{-# LINE 522 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 419 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 522 "src/Test/HMock/Predicates.hs" #-}       (accept (caseInsensitive endsWith "ball") "soccer")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:421: "-{-# LINE 421 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:524: "+{-# LINE 524 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 421 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 524 "src/Test/HMock/Predicates.hs" #-}       (accept (caseInsensitive eq "time") "TIME")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:423: "-{-# LINE 423 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:526: "+{-# LINE 526 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 423 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 526 "src/Test/HMock/Predicates.hs" #-}       (accept (caseInsensitive gt "NOTHING") "everything")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:448: "-{-# LINE 448 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:553: "+{-# LINE 553 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 448 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 553 "src/Test/HMock/Predicates.hs" #-}       (accept (matchesRegex "x{2,5}y?") "xxxy")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:450: "-{-# LINE 450 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:555: "+{-# LINE 555 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 450 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 555 "src/Test/HMock/Predicates.hs" #-}       (accept (matchesRegex "x{2,5}y?") "xyy")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:452: "-{-# LINE 452 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:557: "+{-# LINE 557 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 452 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 557 "src/Test/HMock/Predicates.hs" #-}       (accept (matchesRegex "x{2,5}y?") "wxxxyz")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:475: "-{-# LINE 475 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:587: "+{-# LINE 587 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 475 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 587 "src/Test/HMock/Predicates.hs" #-}       (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XXXY")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:477: "-{-# LINE 477 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:589: "+{-# LINE 589 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 477 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 589 "src/Test/HMock/Predicates.hs" #-}       (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XYY")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:479: "-{-# LINE 479 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:591: "+{-# LINE 591 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 479 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 591 "src/Test/HMock/Predicates.hs" #-}       (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:508: "-{-# LINE 508 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:627: "+{-# LINE 627 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 508 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 627 "src/Test/HMock/Predicates.hs" #-}       (accept (containsRegex "x{2,5}y?") "xxxy")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:510: "-{-# LINE 510 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:629: "+{-# LINE 629 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 510 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 629 "src/Test/HMock/Predicates.hs" #-}       (accept (containsRegex "x{2,5}y?") "xyy")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:512: "-{-# LINE 512 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:631: "+{-# LINE 631 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 512 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 631 "src/Test/HMock/Predicates.hs" #-}       (accept (containsRegex "x{2,5}y?") "wxxxyz")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:533: "-{-# LINE 533 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:655: "+{-# LINE 655 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 533 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 655 "src/Test/HMock/Predicates.hs" #-}       (accept (containsCaseInsensitiveRegex "x{2,5}y?") "XXXY")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:535: "-{-# LINE 535 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:657: "+{-# LINE 657 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 535 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 657 "src/Test/HMock/Predicates.hs" #-}       (accept (containsCaseInsensitiveRegex "x{2,5}y?") "XYY")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:537: "-{-# LINE 537 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:659: "+{-# LINE 659 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 537 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 659 "src/Test/HMock/Predicates.hs" #-}       (accept (containsCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:558: "-{-# LINE 558 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:683: "+{-# LINE 683 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 558 "src/Test/HMock/Predicates.hs" #-}-      (accept isEmpty [])+{-# LINE 683 "src/Test/HMock/Predicates.hs" #-}+      (accept isEmpty ([] :: [Int]))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:560: "-{-# LINE 560 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:685: "+{-# LINE 685 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 560 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 685 "src/Test/HMock/Predicates.hs" #-}       (accept isEmpty [1, 2, 3])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:562: "-{-# LINE 562 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:687: "+{-# LINE 687 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 562 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 687 "src/Test/HMock/Predicates.hs" #-}       (accept isEmpty "")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:564: "-{-# LINE 564 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:689: "+{-# LINE 689 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 564 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 689 "src/Test/HMock/Predicates.hs" #-}       (accept isEmpty "gas tank")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:575: "-{-# LINE 575 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:702: "+{-# LINE 702 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 575 "src/Test/HMock/Predicates.hs" #-}-      (accept nonEmpty [])+{-# LINE 702 "src/Test/HMock/Predicates.hs" #-}+      (accept nonEmpty ([] :: [Int]))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:577: "-{-# LINE 577 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:704: "+{-# LINE 704 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 577 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 704 "src/Test/HMock/Predicates.hs" #-}       (accept nonEmpty [1, 2, 3])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:579: "-{-# LINE 579 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:706: "+{-# LINE 706 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 579 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 706 "src/Test/HMock/Predicates.hs" #-}       (accept nonEmpty "")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:581: "-{-# LINE 581 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:708: "+{-# LINE 708 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 581 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 708 "src/Test/HMock/Predicates.hs" #-}       (accept nonEmpty "gas tank")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:593: "-{-# LINE 593 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:716: "+{-# LINE 716 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 593 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 716 "src/Test/HMock/Predicates.hs" #-}       (accept (sizeIs (lt 3)) ['a' .. 'f'])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:595: "-{-# LINE 595 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:718: "+{-# LINE 718 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 595 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 718 "src/Test/HMock/Predicates.hs" #-}       (accept (sizeIs (lt 3)) ['a' .. 'b'])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:607: "-{-# LINE 607 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:739: "+{-# LINE 739 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 607 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 739 "src/Test/HMock/Predicates.hs" #-}       (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:609: "-{-# LINE 609 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:741: "+{-# LINE 741 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 609 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 741 "src/Test/HMock/Predicates.hs" #-}       (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4, 5])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:611: "-{-# LINE 611 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:743: "+{-# LINE 743 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 611 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 743 "src/Test/HMock/Predicates.hs" #-}       (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 10, 4])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:625: "-{-# LINE 625 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:775: "+{-# LINE 775 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 625 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 775 "src/Test/HMock/Predicates.hs" #-}       (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:627: "-{-# LINE 627 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:777: "+{-# LINE 777 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 627 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 777 "src/Test/HMock/Predicates.hs" #-}       (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [2, 3, 1])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:629: "-{-# LINE 629 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:779: "+{-# LINE 779 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 629 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 779 "src/Test/HMock/Predicates.hs" #-}       (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3, 4])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:631: "-{-# LINE 631 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:781: "+{-# LINE 781 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 631 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 781 "src/Test/HMock/Predicates.hs" #-}       (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 3])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:647: "-{-# LINE 647 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:828: "+{-# LINE 828 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 647 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 828 "src/Test/HMock/Predicates.hs" #-}       (accept (each (gt 5)) [4, 5, 6])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:649: "-{-# LINE 649 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:830: "+{-# LINE 830 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 649 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 830 "src/Test/HMock/Predicates.hs" #-}       (accept (each (gt 5)) [6, 7, 8])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:651: "-{-# LINE 651 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:832: "+{-# LINE 832 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 651 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 832 "src/Test/HMock/Predicates.hs" #-}       (accept (each (gt 5)) [])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:663: "-{-# LINE 663 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:857: "+{-# LINE 857 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 663 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 857 "src/Test/HMock/Predicates.hs" #-}       (accept (contains (gt 5)) [3, 4, 5])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:665: "-{-# LINE 665 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:859: "+{-# LINE 859 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 665 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 859 "src/Test/HMock/Predicates.hs" #-}       (accept (contains (gt 5)) [4, 5, 6])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:667: "-{-# LINE 667 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:861: "+{-# LINE 861 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 667 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 861 "src/Test/HMock/Predicates.hs" #-}       (accept (contains (gt 5)) [])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:681: "-{-# LINE 681 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:869: "+{-# LINE 869 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 681 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 869 "src/Test/HMock/Predicates.hs" #-}       (accept (containsAll [eq "foo", eq "bar"]) ["bar", "foo"])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:683: "-{-# LINE 683 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:871: "+{-# LINE 871 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 683 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 871 "src/Test/HMock/Predicates.hs" #-}       (accept (containsAll [eq "foo", eq "bar"]) ["foo"])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:685: "-{-# LINE 685 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:873: "+{-# LINE 873 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 685 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 873 "src/Test/HMock/Predicates.hs" #-}       (accept (containsAll [eq "foo", eq "bar"]) ["foo", "bar", "qux"])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:698: "-{-# LINE 698 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:881: "+{-# LINE 881 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 698 "src/Test/HMock/Predicates.hs" #-}-      (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "foo"])+{-# LINE 881 "src/Test/HMock/Predicates.hs" #-}+      (accept (containsAll [startsWith "f", endsWith "o"]) ["foo"])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.HMock.Predicates:883: "+{-# LINE 883 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 883 "src/Test/HMock/Predicates.hs" #-}+      (accept (contains (startsWith "f") `andP` contains (endsWith "o")) ["foo"])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:700: "-{-# LINE 700 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:905: "+{-# LINE 905 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 700 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 905 "src/Test/HMock/Predicates.hs" #-}+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo"])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.HMock.Predicates:907: "+{-# LINE 907 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 907 "src/Test/HMock/Predicates.hs" #-}       (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "bar"])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:702: "-{-# LINE 702 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:909: "+{-# LINE 909 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 702 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 909 "src/Test/HMock/Predicates.hs" #-}       (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "qux"])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:714: "-{-# LINE 714 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:916: "+{-# LINE 916 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 714 "src/Test/HMock/Predicates.hs" #-}-      (accept (containsKey (eq "foo")) [("foo", 1), ("bar", 2)])+{-# LINE 916 "src/Test/HMock/Predicates.hs" #-}+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "foo"])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.HMock.Predicates:918: "+{-# LINE 918 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 918 "src/Test/HMock/Predicates.hs" #-}+      (accept (each (eq "foo" `orP` eq "bar")) ["foo", "foo"])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:716: "-{-# LINE 716 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:944: "+{-# LINE 944 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 716 "src/Test/HMock/Predicates.hs" #-}-      (accept (containsKey (eq "foo")) [("bar", 1), ("qux", 2)])+{-# LINE 944 "src/Test/HMock/Predicates.hs" #-}+      (accept (keys (each (eq "foo"))) [("foo", 5)])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.HMock.Predicates:947: "+{-# LINE 947 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 947 "src/Test/HMock/Predicates.hs" #-}+      (accept (keys (each (eq "foo"))) [("foo", 5), ("bar", 6)])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:729: "-{-# LINE 729 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:963: "+{-# LINE 963 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 729 "src/Test/HMock/Predicates.hs" #-}-      (accept (containsEntry (eq "foo") (gt 10)) [("foo", 12), ("bar", 5)])+{-# LINE 963 "src/Test/HMock/Predicates.hs" #-}+      (accept (values (each (eq 5))) [("foo", 5), ("bar", 5)])   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:731: "-{-# LINE 731 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:966: "+{-# LINE 966 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 731 "src/Test/HMock/Predicates.hs" #-}-      (accept (containsEntry (eq "foo") (gt 10)) [("foo", 5), ("bar", 12)])+{-# LINE 966 "src/Test/HMock/Predicates.hs" #-}+      (accept (values (each (eq 5))) [("foo", 5), ("bar", 6)])   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:733: "-{-# LINE 733 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:984: "+{-# LINE 984 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 733 "src/Test/HMock/Predicates.hs" #-}-      (accept (containsEntry (eq "foo") (gt 10)) [("bar", 12)])+{-# LINE 984 "src/Test/HMock/Predicates.hs" #-}+      (accept (eq 1.0) (sum (replicate 100 0.01)))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:746: "-{-# LINE 746 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:991: "+{-# LINE 991 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 746 "src/Test/HMock/Predicates.hs" #-}-      (accept (keysAre [eq "a", eq "b", eq "c"]) [("a", 1), ("b", 2), ("c", 3)])+{-# LINE 991 "src/Test/HMock/Predicates.hs" #-}+      (accept (approxEq 1.0) (sum (replicate 100 0.01)))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:748: "-{-# LINE 748 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:993: "+{-# LINE 993 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 748 "src/Test/HMock/Predicates.hs" #-}-      (accept (keysAre [eq "a", eq "b", eq "c"]) [("c", 1), ("b", 2), ("a", 3)])+{-# LINE 993 "src/Test/HMock/Predicates.hs" #-}+      (accept (approxEq 1.0) (sum (replicate 100 0.009999)))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.HMock.Predicates:1008: "+{-# LINE 1008 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 1008 "src/Test/HMock/Predicates.hs" #-}+      (accept positive 1)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:750: "-{-# LINE 750 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1011: "+{-# LINE 1011 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 750 "src/Test/HMock/Predicates.hs" #-}-      (accept (keysAre [eq "a", eq "b", eq "c"]) [("a", 1), ("c", 3)])+{-# LINE 1011 "src/Test/HMock/Predicates.hs" #-}+      (accept positive 0)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:752: "-{-# LINE 752 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1014: "+{-# LINE 1014 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 752 "src/Test/HMock/Predicates.hs" #-}-      (accept (keysAre [eq "a", eq "b"]) [("a", 1), ("b", 2), ("c", 3)])+{-# LINE 1014 "src/Test/HMock/Predicates.hs" #-}+      (accept positive (-1))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:768: "-{-# LINE 768 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1032: "+{-# LINE 1032 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 768 "src/Test/HMock/Predicates.hs" #-}-      (accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(1, 2), (3, 4)])-  [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:770: "-{-# LINE 770 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1032 "src/Test/HMock/Predicates.hs" #-}+      (accept negative 1)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.HMock.Predicates:1035: "+{-# LINE 1035 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 770 "src/Test/HMock/Predicates.hs" #-}-      (accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(3, 4), (1, 2)])+{-# LINE 1035 "src/Test/HMock/Predicates.hs" #-}+      (accept negative 0)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.HMock.Predicates:1038: "+{-# LINE 1038 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 1038 "src/Test/HMock/Predicates.hs" #-}+      (accept negative (-1))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:772: "-{-# LINE 772 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1057: "+{-# LINE 1057 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 772 "src/Test/HMock/Predicates.hs" #-}-      (accept (entriesAre [(eq 1, eq 2), (eq 3, eq 4)]) [(1, 4), (3, 2)])+{-# LINE 1057 "src/Test/HMock/Predicates.hs" #-}+      (accept nonPositive 1)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:774: "-{-# LINE 774 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1060: "+{-# LINE 1060 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 774 "src/Test/HMock/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.Predicates:795: "-{-# LINE 795 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1060 "src/Test/HMock/Predicates.hs" #-}+      (accept nonPositive 0)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.HMock.Predicates:1063: "+{-# LINE 1063 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 795 "src/Test/HMock/Predicates.hs" #-}-      (accept (eq 1.0) (sum (replicate 100 0.01)))-  [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:802: "-{-# LINE 802 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1063 "src/Test/HMock/Predicates.hs" #-}+      (accept nonPositive (-1))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.HMock.Predicates:1071: "+{-# LINE 1071 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 802 "src/Test/HMock/Predicates.hs" #-}-      (accept (approxEq 1.0) (sum (replicate 100 0.01)))+{-# LINE 1071 "src/Test/HMock/Predicates.hs" #-}+      (accept nonNegative 1)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:804: "-{-# LINE 804 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1074: "+{-# LINE 1074 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 804 "src/Test/HMock/Predicates.hs" #-}-      (accept (approxEq 1.0) (sum (replicate 100 0.009999)))+{-# LINE 1074 "src/Test/HMock/Predicates.hs" #-}+      (accept nonNegative 0)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.HMock.Predicates:1077: "+{-# LINE 1077 "src/Test/HMock/Predicates.hs" #-}+ DocTest.example+{-# LINE 1077 "src/Test/HMock/Predicates.hs" #-}+      (accept nonNegative (-1))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:817: "-{-# LINE 817 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1084: "+{-# LINE 1084 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 817 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1084 "src/Test/HMock/Predicates.hs" #-}       (accept finite 1.0)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:819: "-{-# LINE 819 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1086: "+{-# LINE 1086 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 819 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1086 "src/Test/HMock/Predicates.hs" #-}       (accept finite (0 / 0))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:821: "-{-# LINE 821 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1088: "+{-# LINE 1088 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 821 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1088 "src/Test/HMock/Predicates.hs" #-}       (accept finite (1 / 0))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:832: "-{-# LINE 832 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1106: "+{-# LINE 1106 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 832 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1106 "src/Test/HMock/Predicates.hs" #-}       (accept infinite 1.0)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:834: "-{-# LINE 834 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1108: "+{-# LINE 1108 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 834 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1108 "src/Test/HMock/Predicates.hs" #-}       (accept infinite (0 / 0))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:836: "-{-# LINE 836 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1110: "+{-# LINE 1110 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 836 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1110 "src/Test/HMock/Predicates.hs" #-}       (accept infinite (1 / 0))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:847: "-{-# LINE 847 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1126: "+{-# LINE 1126 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 847 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1126 "src/Test/HMock/Predicates.hs" #-}       (accept nAn 1.0)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:849: "-{-# LINE 849 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1128: "+{-# LINE 1128 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 849 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1128 "src/Test/HMock/Predicates.hs" #-}       (accept nAn (0 / 0))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:851: "-{-# LINE 851 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1130: "+{-# LINE 1130 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 851 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1130 "src/Test/HMock/Predicates.hs" #-}       (accept nAn (1 / 0))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:864: "-{-# LINE 864 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1148: "+{-# LINE 1148 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 864 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1148 "src/Test/HMock/Predicates.hs" #-}       (accept (is even) 3)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:866: "-{-# LINE 866 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1150: "+{-# LINE 1150 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 866 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1150 "src/Test/HMock/Predicates.hs" #-}       (accept (is even) 4)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:879: "-{-# LINE 879 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1168: "+{-# LINE 1168 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 879 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1168 "src/Test/HMock/Predicates.hs" #-}       (accept $(qIs [| even |]) 3)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:881: "-{-# LINE 881 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1170: "+{-# LINE 1170 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 881 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1170 "src/Test/HMock/Predicates.hs" #-}       (accept $(qIs [| even |]) 4)   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:884: "-{-# LINE 884 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1173: "+{-# LINE 1173 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 884 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1173 "src/Test/HMock/Predicates.hs" #-}       (show $(qIs [| even |]))   [ExpectedLine [LineChunk "\"even\""]]- DocTest.printPrefix "Test.HMock.Predicates:898: "-{-# LINE 898 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1191: "+{-# LINE 1191 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 898 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1191 "src/Test/HMock/Predicates.hs" #-}       (accept (with abs (gt 5)) (-6))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:900: "-{-# LINE 900 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1193: "+{-# LINE 1193 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 900 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1193 "src/Test/HMock/Predicates.hs" #-}       (accept (with abs (gt 5)) (-5))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:902: "-{-# LINE 902 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1195: "+{-# LINE 1195 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 902 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1195 "src/Test/HMock/Predicates.hs" #-}       (accept (with reverse (eq "olleh")) "hello")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:904: "-{-# LINE 904 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1197: "+{-# LINE 1197 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 904 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1197 "src/Test/HMock/Predicates.hs" #-}       (accept (with reverse (eq "olleh")) "goodbye")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:918: "-{-# LINE 918 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1214: "+{-# LINE 1214 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 918 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1214 "src/Test/HMock/Predicates.hs" #-}       (accept ($(qWith [| abs |]) (gt 5)) (-6))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:920: "-{-# LINE 920 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1216: "+{-# LINE 1216 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 920 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1216 "src/Test/HMock/Predicates.hs" #-}       (accept ($(qWith [| abs |]) (gt 5)) (-5))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:922: "-{-# LINE 922 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1218: "+{-# LINE 1218 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 922 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1218 "src/Test/HMock/Predicates.hs" #-}       (accept ($(qWith [| reverse |]) (eq "olleh")) "hello")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:924: "-{-# LINE 924 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1220: "+{-# LINE 1220 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 924 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1220 "src/Test/HMock/Predicates.hs" #-}       (accept ($(qWith [| reverse |]) (eq "olleh")) "goodbye")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:927: "-{-# LINE 927 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1223: "+{-# LINE 1223 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 927 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1223 "src/Test/HMock/Predicates.hs" #-}       (show ($(qWith [| abs |]) (gt 5)))   [ExpectedLine [LineChunk "\"abs: > 5\""]]- DocTest.printPrefix "Test.HMock.Predicates:943: "-{-# LINE 943 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1242: "+{-# LINE 1242 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 943 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1242 "src/Test/HMock/Predicates.hs" #-}       (accept $(qMatch [p| Just (Left _) |]) Nothing)   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:945: "-{-# LINE 945 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1244: "+{-# LINE 1244 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 945 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1244 "src/Test/HMock/Predicates.hs" #-}       (accept $(qMatch [p| Just (Left _) |]) (Just (Left 5)))   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:947: "-{-# LINE 947 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1246: "+{-# LINE 1246 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 947 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1246 "src/Test/HMock/Predicates.hs" #-}       (accept $(qMatch [p| Just (Left _) |]) (Just (Right 5)))   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:950: "-{-# LINE 950 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1249: "+{-# LINE 1249 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 950 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1249 "src/Test/HMock/Predicates.hs" #-}       (show $(qMatch [p| Just (Left _) |]))   [ExpectedLine [LineChunk "\"Just (Left _)\""]]- DocTest.printPrefix "Test.HMock.Predicates:966: "-{-# LINE 966 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1271: "+{-# LINE 1271 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 966 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1271 "src/Test/HMock/Predicates.hs" #-}       (accept (typed @String anything) "foo")   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Test.HMock.Predicates:968: "-{-# LINE 968 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1273: "+{-# LINE 1273 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 968 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1273 "src/Test/HMock/Predicates.hs" #-}       (accept (typed @String (sizeIs (gt 5))) "foo")   [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Test.HMock.Predicates:970: "-{-# LINE 970 "src/Test/HMock/Predicates.hs" #-}+ DocTest.printPrefix "Test.HMock.Predicates:1275: "+{-# LINE 1275 "src/Test/HMock/Predicates.hs" #-}  DocTest.example-{-# LINE 970 "src/Test/HMock/Predicates.hs" #-}+{-# LINE 1275 "src/Test/HMock/Predicates.hs" #-}       (accept (typed @String anything) (42 :: Int))   [ExpectedLine [LineChunk "False"]]

@@ -90,7 +90,7 @@           `shouldBe` "< \"foo\" and > \"bar\""         show (lt "bar" `orP` gt "foo")           `shouldBe` "< \"bar\" or > \"foo\""-        show (notP (gt "foo")) `shouldBe` "not > \"foo\""+        show (notP (gt "foo")) `shouldBe` "≤ \"foo\""         show (startsWith "fun") `shouldBe` "starts with \"fun\""         show (endsWith "ing") `shouldBe` "ends with \"ing\""         show (hasSubstr "i") `shouldBe` "has substring \"i\""@@ -109,7 +109,7 @@         show (containsCaseInsensitiveRegex "foo" :: Predicate String)           `shouldBe` "contains /foo/i"         show (isEmpty :: Predicate [()]) `shouldBe` "empty"-        show (nonEmpty :: Predicate [()]) `shouldBe` "nonempty"+        show (nonEmpty :: Predicate [()]) `shouldBe` "non-empty"         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])@@ -120,23 +120,28 @@           `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 (keys (contains (eq "foo")) :: Predicate [(String, String)])+          `shouldBe` "keys (contains (\"foo\"))"         show-          ( containsEntry (eq "foo") (eq "bar") ::+          ( contains (eq "foo" `zipP` 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]"+          `shouldBe` "contains ((\"foo\",\"bar\"))"         show-          ( entriesAre [(eq 1, eq "one"), (eq 2, eq "two")] ::+          ( keys (unorderedElemsAre [eq 1, eq 2, eq 3]) ::               Predicate [(Int, String)]           )-          `shouldBe` "entries are [(1,\"one\"),(2,\"two\")]"+          `shouldBe` "keys ((any order) [1,2,3])"+        show+          (values (elemsAre [eq "one", eq "two"]) :: Predicate [(Int, String)])+          `shouldBe` "values ([\"one\",\"two\"])"         show (approxEq 1.0 :: Predicate Double) `shouldBe` "≈ 1.0"         show (finite :: Predicate Double) `shouldBe` "finite"         show (infinite :: Predicate Double) `shouldBe` "infinite"+        show (positive :: Predicate Double) `shouldBe` "positive"+        show (negative :: Predicate Double) `shouldBe` "negative"+        show (nonPositive :: Predicate Double) `shouldBe` "non-positive"+        show (nonNegative :: Predicate Double) `shouldBe` "non-negative"         show (nAn :: Predicate Double) `shouldBe` "NaN"         show (is even :: Predicate Int)           `shouldSatisfy` ("custom predicate at " `isPrefixOf`)

@@ -13,9 +13,10 @@  module QuasiMockBase where +import Data.Default (def) import Language.Haskell.TH import Language.Haskell.TH.Syntax-import Test.HMock.TH (deriveMockableBase)+import Test.HMock (MakeMockableOptions (..), makeMockableWithOptions) import Util.DeriveRecursive (deriveRecursive)  #if MIN_VERSION_template_haskell(2, 16, 0)@@ -25,7 +26,12 @@  deriveRecursive Nothing ''Lift ''Info -deriveMockableBase ''Quasi+makeMockableWithOptions+  [t|Quasi|]+  def+    { mockEmptySetup = False,+      mockDeriveForMockT = False+    }  reifyStatic :: Name -> Q Exp reifyStatic n = reify n >>= lift@@ -33,7 +39,7 @@ onReify :: Q Exp -> Name -> Q Exp onReify handler n = do   result <- reify n-  [| $handler (QReify $(lift n) |-> $(lift result))|]+  [|$handler (QReify $(lift n) |-> $(lift result))|]  deriveRecursive Nothing ''Lift ''InstanceDec 

@@ -52,14 +52,14 @@     it "finds unrestricted instances" $       example $         runMockT $ do-          result <- runQ $ resolveInstance ''Show (ConT ''String)+          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))+          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" $@@ -72,5 +72,5 @@            )            t <- runQ [t|(Int, NotShowable)|]-          result <- runQ $ resolveInstance ''Show t+          result <- runQ $ resolveInstance ''Show [t]           liftIO $ result `shouldBe` Nothing