mockcat 1.2.1.0 → 1.3.0.0

raw patch · 33 files changed

+743/−455 lines, 33 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• mockcat.cabal +2/−1
• src/Test/MockCat/Internal/Registry/Core.hs +16/−1
• src/Test/MockCat/Mock.hs +22/−7
• src/Test/MockCat/TH/FunctionBuilder.hs +6/−5
• src/Test/MockCat/Verify.hs +5/−7
• src/Test/MockCat/WithMock.hs +123/−32
• test/Property/ConcurrentCountProp.hs +2/−1
• test/Property/LazyEvalProp.hs +3/−2
• test/Property/ReinforcementProps.hs +2/−1
• test/Spec.hs +3/−0
• test/Test/MockCat/ConcurrencySpec.hs +7/−6
• test/Test/MockCat/DeferredTypeErrorsSpec.hs +3/−1
• test/Test/MockCat/ExampleSpec.hs +5/−9
• test/Test/MockCat/HPCFallbackSpec.hs +5/−4
• test/Test/MockCat/HPCNestSpec.hs +17/−18
• test/Test/MockCat/Internal/MockRegistrySpec.hs +2/−1
• test/Test/MockCat/MockSpec.hs +0/−1
• test/Test/MockCat/MockTSpec.hs +2/−4
• test/Test/MockCat/MultipleMocksSpec.hs +5/−4
• test/Test/MockCat/PartialMockCommonSpec.hs +27/−27
• test/Test/MockCat/PartialMockSpec.hs +14/−20
• test/Test/MockCat/PartialMockTHSpec.hs +4/−4
• test/Test/MockCat/ShouldBeCalledErrorDiffSpec.hs +15/−14
• test/Test/MockCat/ShouldBeCalledMockMSpec.hs +0/−1
• test/Test/MockCat/ShouldBeCalledSpec.hs +46/−46
• test/Test/MockCat/THCompareSpec.hs +3/−3
• test/Test/MockCat/TypeClassCommonSpec.hs +66/−65
• test/Test/MockCat/TypeClassMinimalSpec.hs +104/−0
• test/Test/MockCat/TypeClassSpec.hs +102/−51
• test/Test/MockCat/TypeClassTHSpec.hs +30/−29
• test/Test/MockCat/WithMockErrorDiffSpec.hs +41/−36
• test/Test/MockCat/WithMockSpec.hs +50/−54

@@ -6,6 +6,17 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.3.0.0] - 2026-01-03+### Added+- **Type-Safe Verification Result**: Generated mock helpers now return `MockResult params`. This type carries parameter information, enabling robust type inference and compile-time safety checks when using declarative verification (`expects`).+    - *This change is part of an ongoing effort to make misuse of mocks impossible at the type level.*++### Changed+- **Breaking Change**: Due to the introduction of `MockResult`, generated mock helpers (e.g., `_myMethod`) no longer return the mock function itself (`MockT m (FunctionType)`).+    - Code that previously relied on capturing the returned function (e.g., `fn <- _myMethod ...`) will need to be updated.+- **Refactoring**: Reorganized internal test verification logic to utilize `MockResult` properties.+- **Internal**: Refactored test suite organization for better maintainability.+ ## [1.2.1.0] - 2026-01-01 ### Added - **Dynamic Language Extension Detection**: `mockcat` now automatically identifies and requests only necessary extensions (e.g., `MultiParamTypeClasses`, `UndecidableInstances`) based on the target class definition.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           mockcat-version:        1.2.1.0+version:        1.3.0.0 synopsis:       Declarative mocking with a single arrow `~>`. description:    Mockcat is a minimal, architecture-agnostic mocking library for Haskell.                 It enables declarative verification and intent-driven matching, allowing you to define function behavior and expectations without specific architectural dependencies.@@ -120,6 +120,7 @@       Test.MockCat.TH.TypeUtilsSpec       Test.MockCat.THCompareSpec       Test.MockCat.TypeClassCommonSpec+      Test.MockCat.TypeClassMinimalSpec       Test.MockCat.TypeClassSpec       Test.MockCat.TypeClassTHSpec       Test.MockCat.UnsafeCheck

@@ -20,6 +20,7 @@   , markUnitUsed   , isGuardActive   , getLastRecorder+  , getLastRecorderRaw   , resetMockHistory   ) where @@ -35,8 +36,10 @@ import Control.Exception (bracket_) import Control.Monad (forM_) import Control.Concurrent (ThreadId, myThreadId)-import Data.Dynamic (Dynamic, toDyn, fromDynamic)+import Data.Dynamic (Dynamic(..), toDyn, fromDynamic) import Data.Typeable (Typeable)+import GHC.Exts (Any)+import Unsafe.Coerce (unsafeCoerce) import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap import qualified Data.Map.Strict as Map@@ -94,6 +97,7 @@     Map.insertWith (++) tid [(name, dyn)] m  -- | Get the last registered recorder (peek only, does not remove).+-- | Get the last registered recorder (peek only, does not remove). getLastRecorder :: Typeable a => IO (Maybe MockName, Maybe a) getLastRecorder = do   tid <- myThreadId@@ -103,6 +107,17 @@       Nothing -> pure (Nothing, Nothing)       Just [] -> pure (Nothing, Nothing)       Just ((name, dyn) : _) -> pure (name, fromDynamic dyn)++-- | Get the last registered recorder as raw Any (unwrapped from Dynamic).+getLastRecorderRaw :: IO (Maybe MockName, Maybe Any)+getLastRecorderRaw = do+  tid <- myThreadId+  atomically $ do+    store <- readTVar threadMockHistory+    case Map.lookup tid store of+      Nothing -> pure (Nothing, Nothing)+      Just [] -> pure (Nothing, Nothing)+      Just ((name, Dynamic _ v) : _) -> pure (name, Just (unsafeCoerce v))  -- | Reset the mock history for the current thread. resetMockHistory :: IO ()

@@ -8,6 +8,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-}@@ -134,6 +135,13 @@ class CreateStubFn a where   stubImpl :: a +-- | Type class for extracting result or unit.++++++ -- | Type family to distinguish MockSpec from other parameters. type family IsMockSpec p :: Bool where   IsMockSpec (MockSpec p e) = 'True@@ -142,7 +150,7 @@ -- | Internal class for dispatching named mocks based on parameter type. --   This resolves overlapping instances between generic params and MockSpec. --   The 'flag' parameter avoids instance overlap.-class MockDispatch (flag :: Bool) p m fn where+class MockDispatch (flag :: Bool) p m fn | flag p m -> fn where   mockDispatchImpl :: Label -> p -> m fn  -- Generic instance for named mocks (flag ~ 'False)@@ -160,9 +168,15 @@   where   mockDispatchImpl (Label name) p = do     let params = toParams p-    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock (Just name) params-    liftIO $ MockRegistry.register (Just name) recorder fn+    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock (Just name) params :: m (BuiltMock fn verifyParams)+    _ <- liftIO $ MockRegistry.register (Just name) recorder fn+    pure fn +++    ++ -- Specific instance for MockSpec (flag ~ 'True) instance   ( MonadIO m@@ -177,7 +191,7 @@   MockDispatch 'True (MockSpec params [Expectation verifyParams]) m fn   where   mockDispatchImpl (Label name) (MockSpec params exps) = do-    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock (Just name) (toParams params)+    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock (Just name) (toParams params) :: m (BuiltMock fn verifyParams)     _ <- liftIO $ MockRegistry.register (Just name) recorder fn          WithMockContext ctxRef <- askWithMockContext@@ -206,8 +220,9 @@   where   mockImpl p = do     let params = toParams p-    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock Nothing params-    liftIO $ MockRegistry.register Nothing recorder fn+    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock Nothing params :: m (BuiltMock fn verifyParams)+    _ <- liftIO $ MockRegistry.register Nothing recorder fn+    pure fn  -- | Create a mock function from MockSpec. --   MockSpec can optionally contain expectations.@@ -228,7 +243,7 @@   CreateMockFn (MockSpec params [Expectation verifyParams] -> m fn)   where   mockImpl (MockSpec params exps) = do-    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock Nothing (toParams params)+    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock Nothing (toParams params) :: m (BuiltMock fn verifyParams)     _ <- liftIO $ MockRegistry.register Nothing recorder fn          WithMockContext ctxRef <- askWithMockContext

@@ -78,6 +78,7 @@     updateType   ) import Test.MockCat.Verify (ResolvableParamsOf)+import Test.MockCat.WithMock (MockResult(..)) import Data.Dynamic (Dynamic, toDyn) import Data.Proxy (Proxy(..)) import Data.List (find, nubBy, nub)@@ -210,7 +211,7 @@   let resultType =         AppT           (AppT ArrowT (VarT params))-          (AppT (AppT (ConT ''MockT) (VarT monadVarName)) funType)+          (AppT (AppT (ConT ''MockT) (VarT monadVarName)) (AppT (ConT ''MockResult) (AppT (ConT ''ResolvableParamsOf) funType)))              mockTType = AppT (ConT ''MockT) (VarT monadVarName)       flag = AppT (ConT ''IsMockSpec) (VarT params)@@ -255,7 +256,7 @@   let resultType =         AppT           (AppT ArrowT (VarT stubVar))-          (AppT (AppT (ConT ''MockT) (VarT monadVarName)) tySanitized)+          (AppT (AppT (ConT ''MockT) (VarT monadVarName)) (AppT (ConT ''MockResult) (AppT (ConT ''ResolvableParamsOf) tySanitized)))          let mockTType = AppT (ConT ''MockT) (VarT monadVarName)   let flag = AppT (ConT ''IsMockSpec) (VarT stubVar)@@ -303,7 +304,7 @@       let resultType =             AppT               (AppT ArrowT (VarT params))-              (AppT (AppT (ConT ''MockT) (VarT monadVarName)) tySanitized)+              (AppT (AppT (ConT ''MockT) (VarT monadVarName)) (AppT (ConT ''MockResult) (AppT (ConT ''ResolvableParamsOf) tySanitized)))                      mockTType = AppT (ConT ''MockT) (VarT monadVarName)           flag = AppT (ConT ''IsMockSpec) (VarT params)@@ -343,7 +344,7 @@         resultType =           AppT             (AppT ArrowT (VarT params))-            (AppT (AppT (ConT ''MockT) (VarT monadVarName)) funType)+            (AppT (AppT (ConT ''MockT) (VarT monadVarName)) (AppT (ConT ''MockResult) (AppT (ConT ''ResolvableParamsOf) funType)))                  mockTType = AppT (ConT ''MockT) (VarT monadVarName)         flag = AppT (ConT ''IsMockSpec) (VarT params)@@ -387,7 +388,7 @@             mockInstance             NoVerification         )-      pure mockInstance+      pure (MockResult ())     |]  createFnName :: Name -> MockOptions -> String

@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ConstraintKinds #-}@@ -11,7 +10,6 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GADTs #-}@@ -144,7 +142,7 @@   candidates <- resolveForVerification target   case candidates of     [] -> verificationFailure-    _ -> pure $ map (\(name, recorder) -> ResolvedMock name recorder) candidates+    _ -> pure $ map (uncurry ResolvedMock) candidates  resolveForVerification ::   forall target params.@@ -399,20 +397,20 @@       if compareCount method callCount         then pure Nothing         else pure $ Just $ countWithArgsMismatchMessage mockName method callCount-    +     CountAnyVerification method ->       tryVerifyCallCount mockName recorder method-      +     OrderVerification method argsList ->       case doVerifyOrder method mockName invocationList argsList of         Nothing -> pure Nothing         Just (VerifyFailed msg) -> pure $ Just msg-        +     SimpleVerification args ->       case doVerify mockName invocationList (MatchAny args) of         Nothing -> pure Nothing         Just (VerifyFailed msg) -> pure $ Just msg-        +     AnyVerification -> do       if null invocationList         then pure $ Just $ intercalate "\n" ["Function" <> mockNameLabel mockName <> " was never called"]

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-}@@ -17,6 +18,7 @@ module Test.MockCat.WithMock   ( withMock   , expects+  , MockResult(..)   , called   , with   , calledInOrder@@ -41,9 +43,7 @@ import Control.Concurrent.STM (newTVarIO, readTVarIO, atomically, modifyTVar') import Control.Monad.State (get, put, modify) import Test.MockCat.Verify (TimesSpec(..), times, once, never, atLeast, atMost, greaterThan, lessThan, anything, ResolvableMock, ResolvableParamsOf)-import Test.MockCat.Internal.Verify-  ( verifyExpectationDirect-  )+import Test.MockCat.Internal.Verify (verifyExpectationDirect) import Test.MockCat.Internal.Types   ( VerifyOrderMethod(..)   , WithMockContext(..)@@ -55,14 +55,20 @@   , InvocationRecorder(..)   , ResolvedMock(..)   )-import qualified Test.MockCat.Internal.MockRegistry as MockRegistry+import qualified Test.MockCat.Internal.Registry.Core as MockRegistry+import Unsafe.Coerce (unsafeCoerce)  import Test.MockCat.Param (Param(..), param, EqParams(..)) import Data.Kind (Type) import Data.Proxy (Proxy(..)) +-- | A specialized Unit type that carries the parameter type information.+--   This is used to improve type inference for unit-returning mock helpers.+newtype MockResult params = MockResult ()+  deriving (Show, Eq)  + -- | Run a block with mock expectations that are automatically verified withMock :: ReaderT WithMockContext IO a -> IO a withMock action = do@@ -93,50 +99,135 @@  -- | Register expectations for a mock function --   Accepts an Expectations builder---   The params type is inferred from the mock function type or the expectation-class BuildExpectations fn exp where-  buildExpectations :: fn -> exp -> [Expectation (ResolvableParamsOf fn)]+--   The params type is usually inferred from the mock function, but can be overridden+class BuildExpectations fn exp params | fn exp -> params where+  buildExpectations :: fn -> exp -> [Expectation params]  -- | Instance for direct Expectations value---   The params type must match ResolvableParamsOf fn-instance forall fn params. (ResolvableParamsOf fn ~ params) => BuildExpectations fn (Expectations params ()) where+instance {-# OVERLAPPABLE #-} forall fn params. (ResolvableParamsOf fn ~ params) => BuildExpectations fn (Expectations params ()) params where   buildExpectations _ = runExpectations +-- | Instance for function form when fn is MockResult+instance {-# OVERLAPPING #-} forall params. BuildExpectations (MockResult params) (MockResult params -> Expectations params ()) params where+  buildExpectations _ f = runExpectations (f (MockResult ()))++-- | Instance for direct Expectations value when fn is MockResult+instance {-# OVERLAPPING #-} forall params. BuildExpectations (MockResult params) (Expectations params ()) params where+  buildExpectations _ = runExpectations++-- | Instance for direct Expectations value when fn is ()+instance {-# OVERLAPPING #-} forall params. BuildExpectations () (Expectations params ()) params where+  buildExpectations _ = runExpectations+ -- | Instance for function form (fn -> Expectations params ())---   This allows passing a function that receives the mock function-instance forall fn params. (ResolvableParamsOf fn ~ params) => BuildExpectations fn (fn -> Expectations params ()) where+instance {-# OVERLAPPABLE #-} forall fn params. (ResolvableParamsOf fn ~ params) => BuildExpectations fn (fn -> Expectations params ()) params where   buildExpectations fn f = runExpectations (f fn) -expects ::-  forall m fn exp params.+-- | Type class for dispatching expectations based on mock function type+class ExpectsDispatch fn exp m where+  expects :: m fn -> exp -> m fn++-- | Specialized instance for MockResult helpers (handles type inference)+instance {-# OVERLAPPING #-} (exp ~ Expectations params (), ExpectsDispatchImpl 'True (MockResult params) (Expectations params ()) m) => ExpectsDispatch (MockResult params) exp m where+  expects = expectsDispatchImpl @'True++-- | Specialized instance for Unit helpers (fallback)+instance {-# OVERLAPPING #-} (exp ~ Expectations params (), ExpectsDispatchImpl 'True () (Expectations params ()) m) => ExpectsDispatch () exp m where+  expects = expectsDispatchImpl @'True++-- | Generic instance for normal mocks+instance {-# OVERLAPPABLE #-} (ExpectsDispatchImpl 'False fn exp m) => ExpectsDispatch fn exp m where+  expects = expectsDispatchImpl @'False++-- | Internal class for implementation dispatch+class ExpectsDispatchImpl (flag :: Bool) fn exp m where+  expectsDispatchImpl :: m fn -> exp -> m fn++-- | Instance for normal mocks (flag ~ 'False)+--   Strict matching of params+instance   ( MonadIO m   , MonadWithMockContext m   , ResolvableMock fn   , ResolvableParamsOf fn ~ params   , ExtractParams exp   , ExpParams exp ~ params-  , BuildExpectations fn exp+  , BuildExpectations fn exp params   , Show params   , EqParams params   ) =>-  m fn ->-  exp ->-  m fn-expects mockFnM exp = do-  (WithMockContext ctxVar) <- askWithMockContext-  -- Try to help type inference by using exp first-  let _ = extractParams exp :: Proxy params-  mockFn <- mockFnM-  -- Get the recorder from the thread-local store (set by mock/register)-  -- This avoids StableName lookup and is HPC-safe-  (mockName, mRecorder) <- liftIO $ MockRegistry.getLastRecorder @(InvocationRecorder params)-  let resolved = case mRecorder of-        Just recorder -> ResolvedMock mockName recorder-        Nothing -> error "expects: mock recorder not found. Use mock inside withMock/runMockT."-  let expectations = buildExpectations mockFn exp-  let actions = map (verifyExpectationDirect resolved) expectations-  liftIO $ atomically $ modifyTVar' ctxVar (++ actions)-  pure mockFn+  ExpectsDispatchImpl 'False fn exp m+  where+  expectsDispatchImpl mockFnM exp = do+    (WithMockContext ctxVar) <- askWithMockContext+    -- Try to help type inference by using exp first+    let _ = extractParams exp :: Proxy params+    mockFn <- mockFnM+    -- Get the recorder from the thread-local store (set by mock/register)+    -- This avoids StableName lookup and is HPC-safe+    (mockName, mRecorder) <- liftIO $ MockRegistry.getLastRecorder @(InvocationRecorder params)++    let resolved = case mRecorder of+          Just recorder -> ResolvedMock mockName recorder+          Nothing -> errorWithoutStackTrace "expects: mock recorder not found. Use mock inside withMock/runMockT."++    let expectations = buildExpectations mockFn exp+    let actions = map (verifyExpectationDirect resolved) expectations+    liftIO $ atomically $ modifyTVar' ctxVar (++ actions)+    pure mockFn++-- | Instance for MockResult mocks (flag ~ 'True)+--   Dynamic resolution using expectation params+instance+  ( MonadIO m+  , MonadWithMockContext m+  , BuildExpectations (MockResult params) (Expectations params ()) params+  , Show params+  , EqParams params+  ) =>+  ExpectsDispatchImpl 'True (MockResult params) (Expectations params ()) m+  where+  expectsDispatchImpl mockFnM exp = do+    (WithMockContext ctxVar) <- askWithMockContext+    _ <- mockFnM+    (mockName, mRecorder) <- liftIO MockRegistry.getLastRecorderRaw+    resolved <- case mRecorder of+      Just raw -> do+         let recorder = unsafeCoerce raw :: InvocationRecorder params+         pure $ ResolvedMock mockName recorder+      Nothing -> errorWithoutStackTrace "expects: mock recorder not found (Dynamic Resolution Failed). Ensure the mock helper function was called."+    -- Use the expectations directly since we know the context+    let expectations = runExpectations exp+    let actions = map (verifyExpectationDirect resolved) expectations+    liftIO $ atomically $ modifyTVar' ctxVar (++ actions)+    pure (MockResult ())++-- | Instance for Unit mocks (flag ~ 'True)+--   Dynamic resolution using expectation params+instance+  ( MonadIO m+  , MonadWithMockContext m+  , BuildExpectations () (Expectations params ()) params+  , Show params+  , EqParams params+  ) =>+  ExpectsDispatchImpl 'True () (Expectations params ()) m+  where+  expectsDispatchImpl mockFnM exp = do+    (WithMockContext ctxVar) <- askWithMockContext+    _ <- mockFnM+    (mockName, mRecorder) <- liftIO MockRegistry.getLastRecorderRaw+    resolved <- case mRecorder of+      Just raw -> do+         let recorder = unsafeCoerce raw :: InvocationRecorder params+         pure $ ResolvedMock mockName recorder+      Nothing -> errorWithoutStackTrace "expects: mock recorder not found (Dynamic Resolution Failed). Ensure the mock helper function was called."+    let expectations = buildExpectations () exp+    let actions = map (verifyExpectationDirect resolved) expectations+    liftIO $ atomically $ modifyTVar' ctxVar (++ actions)+    pure ()++  -- | Create a count expectation builder --   The params type is inferred from the mock function in expects

@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-}@@ -33,7 +34,7 @@         let totalCalls = threads * callsPerThread         -- Pre-declare expected count with `expects` inside `runMockT`, and have it automatically verified after concurrent calls.         run $ runMockT $ do-          _ <- _propAction ((MC.any ~> (1 :: Int)))+          _propAction ((MC.any ~> (1 :: Int)))             `expects` do               called (times totalCalls)           parallelInvoke threads callsPerThread

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-}@@ -25,7 +26,7 @@ prop_lazy_unforced_not_counted :: Property prop_lazy_unforced_not_counted = monadicIO $ do   run $ runMockT $ do-    _ <- _lazyUnaryAction ((param (10 :: Int) ~> (42 :: Int)))+    _lazyUnaryAction ((param (10 :: Int) ~> (42 :: Int)))       `expects` do         called never     -- Do NOT force the call; only build a thunk.@@ -38,7 +39,7 @@ prop_lazy_forced_counted :: Property prop_lazy_forced_counted = monadicIO $ do   run $ runMockT $ do-    _ <- _lazyUnaryAction ((param (10 :: Int) ~> (7 :: Int)))+    _lazyUnaryAction ((param (10 :: Int) ~> (7 :: Int)))       `expects` do         called once     v <- lazyUnaryAction 10   -- forcing the monadic action executes the mock

@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DataKinds #-}@@ -61,7 +62,7 @@   let forcedCount = length (filter id mask)   run $ runMockT $ do     -- expectation: arg -> arg; count only forced executions-    _ <- _parLazy ((param arg ~> arg))+    _parLazy ((param arg ~> arg))       `expects` do         called (times forcedCount)     -- prepare thunks (NOT executed yet)

@@ -4,7 +4,9 @@ import Test.MockCat.ParamSpec as Param import Test.MockCat.AssociationListSpec as AssociationList import Test.MockCat.ExampleSpec as Example+import Test.MockCat.TypeClassMinimalSpec as TypeClassMinimal import Test.MockCat.TypeClassSpec as TypeClass+ import Test.MockCat.TypeClassTHSpec as TypeClassTH import Test.MockCat.PartialMockSpec as PartialMock import Test.MockCat.PartialMockTHSpec as PartialMockTH@@ -45,6 +47,7 @@     Mock.spec     AssociationList.spec     Example.spec+    TypeClassMinimal.spec     TypeClass.spec     TypeClassTH.spec     PartialMock.spec

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-}@@ -37,7 +38,7 @@   withRunInIO \runInIO -> do     as <- replicateM threads (async $ do       replicateM_ callsPerThread $ do-        _ <- runInIO (action 123)+        runInIO (action 123)         threadDelay 100)     mapM_ wait as @@ -52,7 +53,7 @@   describe "Concurrency / expects" do     it "counts calls across parallel async threads" do       result <- runMockT do-        _ <- _action ((any ~> (1 :: Int)))+        _action ((any ~> (1 :: Int)))           `expects` do             called (times 10)         parallelActionSum 10@@ -62,8 +63,8 @@       let threads = 50 :: Int           callsPerThread = 20 :: Int           total = threads * callsPerThread :: Int-      _ <- (runMockT $ do-        _ <- _action ((any ~> (1 :: Int)))+      (runMockT $ do+        _action ((any ~> (1 :: Int)))           `expects` do             called (times total)         parallelCallActionWithDelay threads callsPerThread@@ -72,7 +73,7 @@      it "fails verification when calls are fewer than declared" do       runMockT (do-        _ <- _action ((any ~> (1 :: Int)))+        _action ((any ~> (1 :: Int)))           `expects` do             called (times 10)         parallelCallActionN 9@@ -82,7 +83,7 @@   describe "Concurrency / never expectation" do     it "passes when stub not used in parallel context" do       r <- runMockT do-        _ <- _action ((any ~> (99 :: Int)))+        _action ((any ~> (99 :: Int)))           `expects` do             called never 

@@ -1,5 +1,7 @@ {-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE DataKinds #-}  module Test.MockCat.DeferredTypeErrorsSpec (spec) where@@ -32,7 +34,7 @@           f <- mock (any ~> (1 :: Int))           let val = f `expects` do                 called once-          _ <- liftIO $ evaluate val+          liftIO $ evaluate val           pure ()          -- Since the type error is deferred inside the IO action logic, we must run it to trigger the exception.

@@ -3,12 +3,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-}-{-# OPTIONS_GHC -Wno-name-shadowing #-}-{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-} {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -42,8 +41,6 @@  makeMock [t|Teletype|] -- class Monad m => StrictTest m where   strictFunc :: String -> m () @@ -52,8 +49,6 @@  makeMock [t|StrictTest|] -- spec :: Spec spec = do   it "Default makeMock is strict (requires pure)" do@@ -96,15 +91,16 @@    it "echo1" do     result <- runMockT do-      _readTTY $ pure @IO ""+      _readTTY (pure @IO "") `expects` called once       echoProgram     result `shouldBe` ()    it "echo2" do     result <- runMockT do-      _readTTY $ do+      _readTTY (do         onCase $ pure @IO "a"-        onCase $ pure @IO ""+        onCase $ pure @IO "")+        `expects` called (times 2)        _writeTTY $ "a" ~> pure @IO ()       echoProgram

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -34,8 +35,8 @@       f2 <- mock $ "2" ~> (2 :: Int)        -- Execute both-      _ <- evaluate $ f1 "1"-      _ <- evaluate $ f2 "2"+      evaluate $ f1 "1"+      evaluate $ f2 "2"        -- Verify f1.        -- If fallback picks f2 (latest or first), verification might fail or see wrong calls.@@ -51,8 +52,8 @@       fA <- mock (label "mockA") $ "A" ~> (1 :: Int)       fB <- mock (label "mockB") $ "B" ~> (2 :: Int) -      _ <- evaluate $ fA "A"-      _ <- evaluate $ fB "B"+      evaluate $ fA "A"+      evaluate $ fB "B"        fA `shouldBeCalled` "A"       fB `shouldBeCalled` "B"

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.MockCat.HPCNestSpec (spec) where@@ -15,7 +16,7 @@   it "RunMockT nested in IO: outer mock with 'shouldBeCalled' becomes unverifiable inside runMockT" $ do     outer <- mock (param "outer" ~> True)     -- execution in IO context-    _ <- evaluate (outer "outer")+    evaluate (outer "outer")      runMockT @IO $ do       -- runMockT resets history, so 'outer' should not be verifiable here.@@ -24,7 +25,7 @@    it "RunMockT nested in IO: outer mock is verifiable AFTER runMockT returns" $ do     outer <- mock (param "outer" ~> True)-    _ <- evaluate (outer "outer")+    evaluate (outer "outer")      runMockT @IO $ do       pure ()@@ -35,12 +36,11 @@    it "withMock (using expects) is immune to history reset" $ do     withMock $ do-      f <- mock (param "a" ~> True) -           `expects` do+      f <- mock (param "a" ~> True) `expects` do              called once `with` "a"              liftIO $ do-        _ <- evaluate (f "a")+        evaluate (f "a")         -- Nested runMockT clears history, but expectations capture the recorder directly.         runMockT @IO $ pure ()         @@ -49,32 +49,30 @@   it "Sibling runMockT blocks are isolated" $ do     runMockT @IO $ do       f1 <- mock (param "a" ~> True)-      _ <- liftIO $ evaluate (f1 "a")+      liftIO $ evaluate (f1 "a")       liftIO $ f1 `shouldBeCalled` "a"          runMockT @IO $ do       f2 <- mock (param "a" ~> True)-      _ <- liftIO $ evaluate (f2 "a")+      liftIO $ evaluate (f2 "a")       liftIO $ f2 `shouldBeCalled` "a"    it "Nested withMock blocks work correctly even with same-type mocks" $ do     withMock $ do       -- Outer mock-      outer <- mock (param "a" ~> True) -           `expects` do+      outer <- mock (param "a" ~> True) `expects` do              called once              liftIO $ do-        _ <- evaluate (outer "a")+        evaluate (outer "a")                  -- Inner withMock         withMock $ do           -- Inner mock with SAME signature-          inner <- mock (param "a" ~> True)-               `expects` do+          inner <- mock (param "a" ~> True) `expects` do                  called once           -          _ <- liftIO $ evaluate (inner "a")+          liftIO $ evaluate (inner "a")           pure ()                  pure ()@@ -82,7 +80,7 @@   it "Nested runMockT: inner block clears outer block's history" $ do     runMockT @IO $ do       outer <- mock (param "a" ~> True)-      _ <- liftIO $ evaluate (outer "a")+      liftIO $ evaluate (outer "a")              -- At this point, outer is verifiable       liftIO $ outer `shouldBeCalled` "a"@@ -96,7 +94,7 @@                  -- Inner mock should work checking         inner <- mock (param "b" ~> True)-        _ <- liftIO $ evaluate (inner "b")+        liftIO $ evaluate (inner "b")         liftIO $ inner `shouldBeCalled` "b"        -- After inner block returns, history is NOT restored (resetMockHistory is destructive).@@ -107,11 +105,12 @@   it "withMock inside runMockT works correctly" $ do     runMockT @IO $ do       f <- mock (param "a" ~> True)-      _ <- liftIO $ evaluate (f "a")+      liftIO $ evaluate (f "a")              liftIO $ withMock $ do-        g <- mock (param "b" ~> True) `expects` do called once-        _ <- liftIO $ evaluate (g "b")+        g <- mock (param "b" ~> True)+        pure g `expects` do called once+        liftIO $ evaluate (g "b")         pure ()              -- withMock does not reset history, so 'f' should still be verifiable

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} module Test.MockCat.Internal.MockRegistrySpec (spec) where  import Test.Hspec@@ -14,7 +15,7 @@     it "register and lookup" do       let f = (+ 1) :: Int -> Int       ref <- newTVarIO InvocationRecord { invocations = [] :: [Int], invocationCounts = empty }-      _ <- attachVerifierToFn f (Just "name", InvocationRecorder ref ParametricFunction)+      attachVerifierToFn f (Just "name", InvocationRecorder ref ParametricFunction)       results <- lookupVerifierForFn f       case results of         [(mockName, dyn)] -> do

@@ -6,7 +6,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-type-defaults #-}-{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-} {- HLINT ignore "Use newtype instead of data" -}

@@ -13,9 +13,7 @@ spec = describe "MockT + expects integration" do   it "allows expects inside runMockT" do     runMockT @IO do-      f <--        mock (any @String ~> True)-          `expects` do-            called once `with` "foo"+      f <- mock (any @String ~> True)+        `expects` called once `with` "foo"       _ <- liftIO $ evaluate (f "foo")       pure ()

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE ScopedTypeVariables #-}  module Test.MockCat.MultipleMocksSpec (spec) where@@ -27,8 +28,8 @@         called once        -- Call them to satisfy expectations-      _ <- liftIO $ evaluate $ f "A"-      _ <- liftIO $ evaluate $ g "B"+      liftIO $ evaluate $ f "A"+      liftIO $ evaluate $ g "B"              pure () @@ -40,13 +41,13 @@        f <- mock ("A" ~> (1 :: Int)) `expects` do          called once        -       _ <- mock ("B" ~> (2 :: Int)) `expects` do+       mock ("B" ~> (2 :: Int)) `expects` do          called once                -- We call f with "B".         -- f expects "A", so f should fail (unexpected arg).        -- g expects "B", but g was not called, so g should fail (count mismatch).-       _ <- liftIO $ evaluate $ f "B"+       liftIO $ evaluate $ f "B"        pure ()      -- We expect failure because expectations were not met.

@@ -43,13 +43,13 @@  -- Dependency record to group builders data PartialMockDeps = PartialMockDeps-  { _getInput    :: forall params m. (MockDispatch (IsMockSpec params) params (MockT m) String, MonadIO m, Typeable (Verify.ResolvableParamsOf String), Typeable params, Show params, Eq params) => params -> MockT m String-  , _getBy       :: forall params. (MockDispatch (IsMockSpec params) params (MockT IO) (String -> IO Int)) => params -> MockT IO (String -> IO Int)-  , _echo        :: forall params. (MockDispatch (IsMockSpec params) params (MockT IO) (String -> IO ())) => params -> MockT IO (String -> IO ())-  , _writeFile   :: forall params m. (MockDispatch (IsMockSpec params) params (MockT m) (FilePath -> Text -> ()), MonadIO m) => params -> MockT m (FilePath -> Text -> ())-  , _findIds     :: forall p a m. (MockDispatch (IsMockSpec p) p (MockT m) [a], MonadIO m, Typeable p, Show p, Eq p, Typeable (InvocationRecorder (Verify.ResolvableParamsOf [a])), Typeable (Verify.ResolvableParamsOf [a]), Typeable [a], Typeable a) => p -> MockT m [a]-  , _findById    :: forall params m. (MockDispatch (IsMockSpec params) params (MockT m) (Int -> String), MonadIO m) => params -> MockT m (Int -> String)-  , _findByIdNI  :: forall params. (MockDispatch (IsMockSpec params) params (MockT IO) (Int -> IO String)) => params -> MockT IO (Int -> IO String)+  { _getInput    :: forall params m. (MockDispatch (IsMockSpec params) params (MockT m) String, MonadIO m, Typeable (Verify.ResolvableParamsOf String), Typeable params, Show params, Eq params) => params -> MockT m (MockResult (Verify.ResolvableParamsOf String))+  , _getBy       :: forall params. (MockDispatch (IsMockSpec params) params (MockT IO) (String -> IO Int)) => params -> MockT IO (MockResult (Verify.ResolvableParamsOf (String -> IO Int)))+  , _echo        :: forall params. (MockDispatch (IsMockSpec params) params (MockT IO) (String -> IO ())) => params -> MockT IO (MockResult (Verify.ResolvableParamsOf (String -> IO ())))+  , _writeFile   :: forall params m. (MockDispatch (IsMockSpec params) params (MockT m) (FilePath -> Text -> ()), MonadIO m) => params -> MockT m (MockResult (Verify.ResolvableParamsOf (FilePath -> Text -> ())))+  , _findIds     :: forall p a m. (MockDispatch (IsMockSpec p) p (MockT m) [a], MonadIO m, Typeable p, Show p, Eq p, Typeable (InvocationRecorder (Verify.ResolvableParamsOf [a])), Typeable (Verify.ResolvableParamsOf [a]), Typeable [a], Typeable a) => p -> MockT m (MockResult (Verify.ResolvableParamsOf [a]))+  , _findById    :: forall params m. (MockDispatch (IsMockSpec params) params (MockT m) (Int -> String), MonadIO m) => params -> MockT m (MockResult (Verify.ResolvableParamsOf (Int -> String)))+  , _findByIdNI  :: forall params. (MockDispatch (IsMockSpec params) params (MockT IO) (Int -> IO String)) => params -> MockT IO (MockResult (Verify.ResolvableParamsOf (Int -> IO String)))   }  -- Main Entry Point@@ -78,14 +78,14 @@   describe "UserInputGetter" do     it "Get user input (has input)" do       result <- runMockT do-        _ <- _getInput ("value" :: String)+        _getInput ("value" :: String)         i <- getInput         toUserInput i       result `shouldBe` Just (UserInput "value")      it "Get user input (no input)" do       result <- runMockT do-        _ <- _getInput ("" :: String)+        _getInput ("" :: String)         i <- getInput         toUserInput i       result `shouldBe` Nothing@@ -93,35 +93,35 @@   describe "FileOperation" do     it "IO" do       result <- runMockT do-        _ <- _writeFile (("output.text" :: FilePath) ~> pack ("IO content" :: String) ~> ())+        _writeFile (("output.text" :: FilePath) ~> pack ("IO content" :: String) ~> ())         pure ()       result `shouldBe` ()      it "MaybeT" do       result <- runMaybeT do         runMockT do-          _ <- _writeFile (("output.text" :: FilePath) ~> pack ("MaybeT content" :: String) ~> ())+          _writeFile (("output.text" :: FilePath) ~> pack ("MaybeT content" :: String) ~> ())           pure ()       result `shouldBe` Just ()      it "ReaderT" do       result <- flip runReaderT "foo" do         runMockT do-          _ <- _writeFile (("output.text" :: FilePath) ~> pack ("ReaderT content foo" :: String) ~> ())+          _writeFile (("output.text" :: FilePath) ~> pack ("ReaderT content foo" :: String) ~> ())           pure ()       result `shouldBe` ()    describe "Handwritten Partial Mock Test" do     it "IO" do       result <- runMockT do-        _ <- _writeFile (("output.text" :: FilePath) ~> pack ("IO content" :: String) ~> ())+        _writeFile (("output.text" :: FilePath) ~> pack ("IO content" :: String) ~> ())         programAction       result `shouldBe` ()      it "MaybeT" do       result <- runMaybeT do         runMockT do-          _ <- _writeFile (("output.text" :: FilePath) ~> pack ("MaybeT content" :: String) ~> ())+          _writeFile (("output.text" :: FilePath) ~> pack ("MaybeT content" :: String) ~> ())           pure ()       result `shouldBe` Just () @@ -135,14 +135,14 @@ specExplicitMonadicReturns (PartialMockDeps { _echo, _getBy }) = describe "Explicit Monadic Returns" do   it "Return monadic value test" do     result <- runMockT $ do-      _ <- _echo $ ("3" :: String) ~> pure @IO ()+      _echo $ ("3" :: String) ~> pure @IO ()       v <- getByExplicitPartial "abc"       echoExplicitPartial (show v)     result `shouldBe` ()    it "Override getBy via stub" do     result <- runMockT do-      _ <- _getBy $ ("abc" :: String) ~> pure @IO (123 :: Int)+      _getBy $ ("abc" :: String) ~> pure @IO (123 :: Int)       getByExplicitPartial "abc"     result `shouldBe` 123 @@ -160,13 +160,13 @@    it "partial findIds" do     values <- runMockT $ do-      _ <- _findIds ([1 :: Int, 2] :: [Int])+      _findIds ([1 :: Int, 2] :: [Int])       findValue @Int @String     values `shouldBe` ["{id: 1}", "{id: 2}"]    it "partial findById" do     values <- runMockT $ do-      _ <- _findById $ do+      _findById $ do         onCase $ (1 :: Int) ~> "id1"         onCase $ (2 :: Int) ~> "id2"         onCase $ (3 :: Int) ~> "id3"@@ -175,7 +175,7 @@    it "Concurrent execution correctly calls and collects results from mocks (async)" do     result <- runMockT do-      _ <- _findById $ do+      _findById $ do         onCase $ (1 :: Int) ~> "id1"         onCase $ (2 :: Int) ~> "id2"       withRunInIO $ \runInIO -> do@@ -191,14 +191,14 @@       let argError :: Selector ErrorCall           argError err = "was not called with the expected arguments" `isInfixOf` displayException (err :: ErrorCall)       (runMockT @IO do-        _ <- _findById $ do+        _findById $ do           onCase $ (1 :: Int) ~> "id1"         -- calling findValue will hit findById for id 2 which is not covered by mock         findValue @Int @String) `shouldThrow` argError      it "duplicate cases prefer first" do       result <- runMockT $ do-        _ <- _findById $ do+        _findById $ do           onCase $ (1 :: Int) ~> "first"           onCase $ (1 :: Int) ~> "second"         findById 1@@ -206,7 +206,7 @@      it "findValue returns empty when findIds returns empty list" do       result <- runMockT $ do-        _ <- _findIds ([] :: [Int])+        _findIds ([] :: [Int])         findValue @Int @String       result `shouldBe` [] @@ -214,7 +214,7 @@     it "error message contains mock name when unexpected arg is used" do       let nameMsg = "function `_findById` was not called with the expected arguments"       (runMockT @IO do-        _ <- _findById $ do+        _findById $ do           onCase $ (1 :: Int) ~> "id1"         -- call with unexpected arg to trigger message         findById (2 :: Int)) `shouldThrow` (\(err :: ErrorCall) -> nameMsg `isInfixOf` displayException err)@@ -224,7 +224,7 @@       let argError :: Selector ErrorCall           argError err = "was not called with the expected arguments" `isInfixOf` displayException (err :: ErrorCall)       (runMockT @IO do-        _ <- _findById $ do+        _findById $ do           onCase $ (1 :: Int) ~> "id1"         -- calling findValue will hit findById for id 2 which is not covered by mock,         -- and because a mock function exists for _findById, it will error rather than fallback.@@ -233,7 +233,7 @@   describe "Implicit monadic return options" do     it "partial findById with explicit monadic returns (implicitMonadicReturn=False)" do       result <- runMockT $ do-        _ <- _findByIdNI $ do+        _findByIdNI $ do           onCase $ (1 :: Int) ~> pure @IO "id1"           onCase $ (2 :: Int) ~> pure @IO "id2"           onCase $ (3 :: Int) ~> pure @IO "id3"@@ -260,7 +260,7 @@    it "fails when _findIds is defined but findIds is never called" do     (runMockT @IO do-      _ <- _findIds (Head :> param ([1 :: Int, 2] :: [Int]))+      _findIds (Head :> param ([1 :: Int, 2] :: [Int]))         `expects` do           called once       -- findIds is never called@@ -272,7 +272,7 @@             onCase $ (1 :: Int) ~> "id1"             onCase $ (2 :: Int) ~> "id2"             onCase $ (3 :: Int) ~> "id3"-      _ <- _findById casesDef `expects` do+      _findById casesDef `expects` do         called once       -- findById is never called       pure ()) `shouldThrow` missingCall "_findById"

@@ -10,7 +10,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}-{-# OPTIONS_GHC -Wno-unused-do-bind #-}  module Test.MockCat.PartialMockSpec (spec) where @@ -27,11 +26,8 @@ import Data.Data import GHC.TypeLits (KnownSymbol, symbolVal) import Unsafe.Coerce (unsafeCoerce)- import qualified Test.MockCat.Verify as Verify -- ensureVerifiable ::   ( MonadIO m   , Verify.ResolvableMock target@@ -45,7 +41,6 @@       [] -> Verify.verificationFailure       _ -> pure () - instance UserInputGetter IO where   getInput = getLine   toUserInput "" = pure Nothing@@ -55,7 +50,6 @@   echoExplicitPartial _ = pure ()   getByExplicitPartial s = pure (length s) - instance (MonadIO m, FileOperation m) => FileOperation (MockT m) where   readFile path = MockT do     defs <- getDefinitions@@ -128,12 +122,12 @@   , MonadIO m   ) =>   params ->-  MockT m (FilePath -> Text -> ())+  MockT m (MockResult (Verify.ResolvableParamsOf (FilePath -> Text -> ()))) _writeFile p = MockT $ do   mockInstance <- unMockT $ mock (label "writeFile") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "writeFile") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _getInput ::   ( MockDispatch (IsMockSpec params) params (MockT m) String@@ -141,12 +135,12 @@   , Typeable (Verify.ResolvableParamsOf String)   ) =>   params ->-  MockT m String+  MockT m (MockResult (Verify.ResolvableParamsOf String)) _getInput value = MockT $ do   mockInstance <- unMockT $ mock (label "getInput") value   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "getInput") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _toUserInput ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m (Maybe UserInput))@@ -166,23 +160,23 @@   ( MockDispatch (IsMockSpec params) params (MockT IO) (String -> IO Int)   ) =>   params ->-  MockT IO (String -> IO Int)+  MockT IO (MockResult (Verify.ResolvableParamsOf (String -> IO Int))) _getByPartial p = MockT $ do   mockInstance <- unMockT $ mock (label "getBy") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "getBy") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _echoPartial ::   ( MockDispatch (IsMockSpec params) params (MockT IO) (String -> IO ())   ) =>   params ->-  MockT IO (String -> IO ())+  MockT IO (MockResult (Verify.ResolvableParamsOf (String -> IO ()))) _echoPartial p = MockT $ do   mockInstance <- unMockT $ mock (label "echo") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "echo") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  findParam :: KnownSymbol sym => Proxy sym -> [Definition] -> Maybe a findParam pa definitions = do@@ -215,7 +209,7 @@   , Typeable [a]   ) =>   p ->-  MockT m [a]+  MockT m (MockResult (Verify.ResolvableParamsOf [a])) _findIds p = MockT $ do   mockInstance <- unMockT $ mock (label "_findIds") p @@ -226,14 +220,14 @@         mockInstance         NoVerification     )-  pure mockInstance+  pure (MockResult ())  _findById ::   ( MockDispatch (IsMockSpec params) params (MockT m) (Int -> String)   , MonadIO m   ) =>   params ->-  MockT m (Int -> String)+  MockT m (MockResult (Verify.ResolvableParamsOf (Int -> String))) _findById p = MockT $ do   mockInstance <- unMockT $ mock (label "_findById") p   ensureVerifiable mockInstance@@ -243,13 +237,13 @@         mockInstance         NoVerification     )-  pure mockInstance+  pure (MockResult ())  _findByIdNI ::   ( MockDispatch (IsMockSpec params) params (MockT IO) (Int -> IO String)   ) =>   params ->-  MockT IO (Int -> IO String)+  MockT IO (MockResult (Verify.ResolvableParamsOf (Int -> IO String))) _findByIdNI p = MockT $ do   mockInstance <- unMockT $ mock (label "_findByIdNI") p   ensureVerifiable mockInstance@@ -259,7 +253,7 @@         mockInstance         NoVerification     )-  pure mockInstance+  pure (MockResult ())  spec :: Spec spec = PartialMockCommonSpec.spec deps (program "input.txt" "output.text")

@@ -12,16 +12,15 @@ {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# OPTIONS_GHC -Wno-missing-export-lists #-}-{-# OPTIONS_GHC -Wno-unused-do-bind #-}  module Test.MockCat.PartialMockTHSpec (spec) where  import Test.MockCat import qualified Test.MockCat.PartialMockCommonSpec as PartialMockCommonSpec import Test.MockCat.SharedSpecDefs-import Test.MockCat.Impl () import Prelude hiding (readFile, writeFile)-import Test.Hspec (Spec)+import Test.Hspec (Spec, describe)+import Test.MockCat.Impl ()  instance UserInputGetter IO where   getInput = getLine@@ -40,7 +39,8 @@ makePartialMock [t|FinderNoImplicit|]  spec :: Spec-spec = PartialMockCommonSpec.spec deps (program "input.txt" "output.text")+spec = describe "PartialMockTHSpec" $+  PartialMockCommonSpec.spec deps (program "input.txt" "output.text")   where     deps = PartialMockCommonSpec.PartialMockDeps       { PartialMockCommonSpec._getInput = Test.MockCat.PartialMockTHSpec._getInput

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# OPTIONS_GHC -Wno-partial-fields #-}@@ -31,7 +32,7 @@   describe "Error Message Diff" do     it "shows diff for string arguments" do       f <- mock ((any :: Param String) ~> "ok")-      _ <- evaluate $ f "hello haskell"+      evaluate $ f "hello haskell"       let expectedError =             "function was not called with the expected arguments.\n\             \\n\@@ -46,7 +47,7 @@      it "shows diff for user-defined type (Post)" do       f <- mock (Post 2 "wrong" ~> "ok")-      _ <- evaluate $ f (Post 2 "wrong")+      evaluate $ f (Post 2 "wrong")       let expectedError =             "function was not called with the expected arguments.\n\             \\n\@@ -68,7 +69,7 @@      it "shows diff for long list" do       f <- mock ((any :: Param [Int]) ~> "ok")-      _ <- evaluate $ f [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]+      evaluate $ f [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]       let expectedError =             "function was not called with the expected arguments.\n\             \\n\@@ -87,7 +88,7 @@      it "shows diff for record" do       f <- mock ((any :: Param User) ~> "ok")-      _ <- evaluate $ f (User "Fagen" 20)+      evaluate $ f (User "Fagen" 20)       let expectedError =             "function was not called with the expected arguments.\n\             \\n\@@ -106,8 +107,8 @@      it "shows diff for inOrderWith" do       f <- mock ((any :: Param String) ~> "ok")-      _ <- evaluate $ f "a"-      _ <- evaluate $ f "b"+      evaluate $ f "a"+      evaluate $ f "b"       let expectedError =             "function was not called with the expected arguments in the expected order.\n\             \  expected 2nd call: \"c\"\n\@@ -132,7 +133,7 @@      it "shows diff for nested record" do       f <- mock ((any :: Param ComplexUser) ~> "ok")-      _ <- evaluate $ f (ComplexUser "Alice" (Config "Light" 1))+      evaluate $ f (ComplexUser "Alice" (Config "Light" 1))       let expectedError =             "function was not called with the expected arguments.\n\             \\n\@@ -151,7 +152,7 @@      it "shows diff for nested list" do       f <- mock ((any :: Param [[Int]]) ~> "ok")-      _ <- evaluate $ f [[1, 2], [3, 4]]+      evaluate $ f [[1, 2], [3, 4]]       let expectedError =             "function was not called with the expected arguments.\n\             \\n\@@ -172,7 +173,7 @@       f <- mock ((any :: Param ComplexUser) ~> "ok")       let actual = ComplexUser "Alice" (Config "Light" 2)           expected = ComplexUser "Bob" (Config "Dark" 1)-      _ <- evaluate $ f actual+      evaluate $ f actual       let expectedError =             "function was not called with the expected arguments.\n\             \\n\@@ -200,7 +201,7 @@          f <- mock ((any :: Param String) ~> "ok")          let actual = "{ name = \"Alice\""              expected = "{ name = \"Bob\" }"-         _ <- evaluate $ f actual+         evaluate $ f actual          let expectedError =                "function was not called with the expected arguments.\n\                \\n\@@ -217,7 +218,7 @@          f <- mock ((any :: Param String) ~> "ok")          let actual = "NotARecord {,,,,,}"          let expected = "NotARecord { a = 1 }"-         _ <- evaluate $ f actual+         evaluate $ f actual          let expectedError =                "function was not called with the expected arguments.\n\                \\n\@@ -236,7 +237,7 @@         -- 5 layers deep         let actual = Node{val = 1, next = Node{val = 2, next = Node{val = 3, next = Node{val = 4, next = Node{val = 5, next = Leaf 0}}}}}             expected = Node{val = 1, next = Node{val = 2, next = Node{val = 3, next = Node{val = 4, next = Node{val = 5, next = Leaf 1}}}}}-        _ <- evaluate $ f actual+        evaluate $ f actual         let expectedError =               "function was not called with the expected arguments.\n" <>               "\n" <>@@ -257,7 +258,7 @@         f <- mock ((any :: Param MultiLayer) ~> "ok")         let actual = MultiLayer {layer1 = "A", sub = SubLayer {layer2 = "B", items = [Node {val = 1, next = Leaf 2}]}}             expected = MultiLayer {layer1 = "X", sub = SubLayer {layer2 = "Y", items = [Node {val = 1, next = Leaf 3}]}}-        _ <- evaluate $ f actual+        evaluate $ f actual         let expectedError =               "function was not called with the expected arguments.\n" <>               "\n" <>@@ -284,7 +285,7 @@         f <- mock ((any :: Param Config) ~> "ok")         let actual = Config "Light" 1             expected = Config "Dark" 99-        _ <- evaluate $ f actual+        evaluate $ f actual         let expectedError =               "function was not called with the expected arguments.\n" <>               "\n" <>

@@ -1,7 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-type-defaults #-}-{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# OPTIONS_GHC -fno-hpc #-} module Test.MockCat.ShouldBeCalledMockMSpec (spec) where 

@@ -212,52 +212,52 @@     describe "Monadic mocks" do       it "shouldBeCalled with IO mock" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` ("a" ~> (1 :: Int))        it "shouldBeCalled times with IO mock" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` (times 3 `withArgs` ("a" ~> (1 :: Int)))        it "shouldBeCalled inOrderWith with IO mock" do         f <- mock $ any ~> any ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "b" (2 :: Int)-        _ <- f "c" (3 :: Int)+        f "a" (1 :: Int)+        f "b" (2 :: Int)+        f "c" (3 :: Int)         f `shouldBeCalled` inOrderWith ["a" ~> (1 :: Int), "b" ~> (2 :: Int), "c" ~> (3 :: Int)]        it "shouldBeCalled inPartialOrderWith with IO mock" do         f <- mock $ any ~> any ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "b" (2 :: Int)-        _ <- f "c" (3 :: Int)+        f "a" (1 :: Int)+        f "b" (2 :: Int)+        f "c" (3 :: Int)         f `shouldBeCalled` inPartialOrderWith ["a" ~> (1 :: Int), "c" ~> (3 :: Int)]        it "shouldBeCalled anything with IO mock" do         f <- mock $ any ~> any ~> pure @IO True-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` anything        it "shouldBeCalled times without args with IO mock" do         f <- mock $ any ~> any ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "b" (2 :: Int)-        _ <- f "c" (3 :: Int)+        f "a" (1 :: Int)+        f "b" (2 :: Int)+        f "c" (3 :: Int)         f `shouldBeCalled` times 3      describe "Named mocks (error messages)" do       it "shouldBeCalled with name in error message" do         f <- mock (label "named mock") $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` ("b" ~> (1 :: Int)) `shouldThrow` anyErrorCall        it "shouldBeCalled times with name in error message" do         f <- mock (label "named mock") $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)         let e =               "function `named mock` was not called the expected number of times with the expected arguments.\n\               \  expected: 3\n\@@ -266,15 +266,15 @@        it "shouldBeCalled inOrderWith with name in error message" do         f <- mock (label "named mock") $ any ~> any ~> pure @IO True-        _ <- f "b" (2 :: Int)-        _ <- f "a" (1 :: Int)-        _ <- f "c" (3 :: Int)+        f "b" (2 :: Int)+        f "a" (1 :: Int)+        f "c" (3 :: Int)         f `shouldBeCalled` inOrderWith ["a" ~> (1 :: Int), "b" ~> (2 :: Int), "c" ~> (3 :: Int)] `shouldThrow` errorContains "expected 1st call:"        it "shouldBeCalled inPartialOrderWith with name in error message" do         f <- mock (label "named mock") $ any ~> any ~> pure @IO True-        _ <- f "b" (2 :: Int)-        _ <- f "a" (1 :: Int)+        f "b" (2 :: Int)+        f "a" (1 :: Int)         let e =               "function `named mock` was not called with the expected arguments in the expected order.\n\               \  expected order:\n\@@ -304,8 +304,8 @@        it "shouldBeCalled times failure with detailed error message" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)         let e =               "function was not called the expected number of times with the expected arguments.\n\               \  expected: 3\n\@@ -320,56 +320,56 @@     describe "Multiple arguments with typed values" do       it "shouldBeCalled with multiple typed arguments" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` ("a" ~> (1 :: Int))        it "shouldBeCalled times with multiple typed arguments" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` (times 3 `withArgs` ("a" ~> (1 :: Int)))        it "shouldBeCalled atLeast with multiple typed arguments" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` (atLeast 3 `withArgs` ("a" ~> (1 :: Int)))        it "shouldBeCalled atMost with multiple typed arguments" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` (atMost 3 `withArgs` ("a" ~> (1 :: Int)))        it "shouldBeCalled greaterThan with multiple typed arguments" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` (greaterThan 2 `withArgs` ("a" ~> (1 :: Int)))        it "shouldBeCalled lessThan with multiple typed arguments" do         f <- mock $ "a" ~> (1 :: Int) ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)-        _ <- f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)+        f "a" (1 :: Int)         f `shouldBeCalled` (lessThan 4 `withArgs` ("a" ~> (1 :: Int)))        it "shouldBeCalled inOrderWith with multiple typed arguments" do         f <- mock $ any ~> any ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "b" (2 :: Int)-        _ <- f "c" (3 :: Int)+        f "a" (1 :: Int)+        f "b" (2 :: Int)+        f "c" (3 :: Int)         f `shouldBeCalled` inOrderWith ["a" ~> (1 :: Int), "b" ~> (2 :: Int), "c" ~> (3 :: Int)]        it "shouldBeCalled inPartialOrderWith with multiple typed arguments" do         f <- mock $ any ~> any ~> pure @IO True-        _ <- f "a" (1 :: Int)-        _ <- f "b" (2 :: Int)-        _ <- f "c" (3 :: Int)+        f "a" (1 :: Int)+        f "b" (2 :: Int)+        f "c" (3 :: Int)         f `shouldBeCalled` inPartialOrderWith ["a" ~> (1 :: Int), "c" ~> (3 :: Int)]      describe "High arity mocks" do

@@ -3,7 +3,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FunctionalDependencies #-}@@ -63,6 +62,7 @@       , "Internal."       , "Test.MockCat.Mock."       , "Test.MockCat.Types."+      , "Test.MockCat.WithMock."       ])   where     stripPrefixes [] t = t@@ -374,7 +374,7 @@     it "_findIds signature matches handwritten" $       assertHelperSigMatches partialMockSpecPath generatedFinderSigMap "_findIds" -    it "_toUserInput signature omits redundant ResolvableParamsOf constraint" do+    it "_toUserInput signature contains ResolvableParamsOf (due to MockResult wrapper)" do       let genSig =             Map.lookup "_toUserInput" generatedUserInputSigMap       case genSig of@@ -382,7 +382,7 @@           expectationFailure "TH generated signature not found: _toUserInput"         Just sig ->           normalizeSignature sig-            `shouldNotSatisfy` T.isInfixOf (T.pack "ResolvableParamsOf") . T.pack+            `shouldSatisfy` T.isInfixOf (T.pack "ResolvableParamsOf") . T.pack      it "_produce signature matches handwritten" $       assertHelperSigMatches typeClassSpecPath generatedAssocSigMap "_produce"

@@ -24,6 +24,7 @@ import Prelude hiding (readFile, writeFile, any) import Test.Hspec import Test.MockCat+import Test.MockCat.Verify (ResolvableParamsOf)  import Data.Kind (Type) import Data.Text (Text, pack, isInfixOf)@@ -132,9 +133,9 @@   ArgsOfF r = ()  -- Generic Mock alias for a function type f-type MockFor f = forall params. (MockDispatch (IsMockSpec params) params (MockT IO) f) => params -> MockT IO f+type MockFor f = forall params. (MockDispatch (IsMockSpec params) params (MockT IO) f) => params -> MockT IO (MockResult (ResolvableParamsOf f)) -- Generic Mock alias for an arbitrary base monad m-type MockForM m f = forall params. (MockDispatch (IsMockSpec params) params (MockT m) f) => params -> MockT m f+type MockForM m f = forall params. (MockDispatch (IsMockSpec params) params (MockT m) f) => params -> MockT m (MockResult (ResolvableParamsOf f))  -- Per-spec dependency records to group required builders/mocks data BasicDeps = BasicDeps@@ -347,16 +348,16 @@ specBasicStubbingAndVerification (BasicDeps { _readFile, _writeFile }) = do   it "Program reads content and writes it to output path" do     result <- runMockT do-      _ <- _readFile $ "input.txt" ~> pack "content"-      _ <- _writeFile $ "output.txt" ~> pack "content" ~> ()+      _readFile $ "input.txt" ~> pack "content"+      _writeFile $ "output.txt" ~> pack "content" ~> ()       operationProgram "input.txt" "output.txt"      result `shouldBe` ()    it "Program skips file write when input content contains 'ngWord'" do     result <- runMockT do-      _ <- _readFile  ("input.txt" ~> pack "contains ngWord")-      _ <- _writeFile ("output.txt" ~> any ~> ())+      _readFile  ("input.txt" ~> pack "contains ngWord")+      _writeFile ("output.txt" ~> any ~> ())         `expects` do           called never       operationProgram "input.txt" "output.txt"@@ -374,9 +375,9 @@     modifyContentStub <- mock $ pack "content" ~> pack "modifiedContent"      result <- runMockT do-      _ <- _readFile $ "input.txt" ~> pack "content"-      _ <- _writeFile $ ("output.text" ~> pack "modifiedContent" ~> ())-      _ <- _post $ (pack "modifiedContent" ~> ())+      _readFile $ "input.txt" ~> pack "content"+      _writeFile ("output.text" ~> pack "modifiedContent" ~> ())+      _post (pack "modifiedContent" ~> ())       operationProgram2 "input.txt" "output.text" modifyContentStub      result `shouldBe` ()@@ -394,10 +395,10 @@     let env = Environment "input.txt" "output.text"      result <- runMockT do-      _ <- _ask env-      _ <- _readFile ("input.txt" ~> pack "content")-      _ <- _writeFile ("output.text" ~> pack "modifiedContent" ~> ())-      _ <- _post (pack "modifiedContent" <> pack ("+" <> show env) ~> ())+      _ask env+      _readFile ("input.txt" ~> pack "content")+      _writeFile ("output.text" ~> pack "modifiedContent" ~> ())+      _post (pack "modifiedContent" <> pack ("+" <> show env) ~> ())       apiFileOperationProgram modifyContentStub      result `shouldBe` ()@@ -413,9 +414,9 @@ specMonadReaderContextMocking (ReaderContextDeps { _ask, _readFile, _writeFile }) = do   it "Program successfully uses MonadReader to find paths and executes FileOperation" do     r <- runMockT do-      _ <- _ask (Environment "input.txt" "output.txt")-      _ <- _readFile  ("input.txt" ~> pack "content")-      _ <- _writeFile  ("output.txt" ~> pack "content" ~> ())+      _ask (Environment "input.txt" "output.txt")+      _readFile  ("input.txt" ~> pack "content")+      _writeFile  ("output.txt" ~> pack "content" ~> ())       operationProgram3     r `shouldBe` () @@ -427,8 +428,8 @@ specSequentialIOStubbing (SequentialIODeps { _readTTY, _writeTTY }) = do   it "Recursive program echo2 reads sequential input and writes output until empty string" do     result <- runMockT do-      _ <- _readTTY $ casesIO ["a", ""]-      _ <- _writeTTY $ "a" ~> pure @IO ()+      _readTTY $ casesIO ["a", ""]+      _writeTTY $ "a" ~> pure @IO ()       echo2     result `shouldBe` () @@ -440,8 +441,8 @@ specImplicitMonadicReturnValues (ImplicitMonadicReturnDeps { _getBy, _echo }) = do   it "Program correctly uses and echoes the implicitly stubbed monadic return value" do     result <- runMockT do-      _ <- _getBy $ "s" ~> pure @IO (10 :: Int)-      _ <- _echo $ "10" ~> pure @IO ()+      _getBy $ "s" ~> pure @IO (10 :: Int)+      _echo $ "10" ~> pure @IO ()       echoProgram "s"      result `shouldBe` ()@@ -454,7 +455,7 @@ specArgumentPatternMatching (ArgumentPatternMatchingDeps { _getValueBy }) = do   it "Multi-case stubbing correctly dispatches and collects results for distinct arguments" do     result <- runMockT do-      _ <- _getValueBy $ do+      _getValueBy $ do         onCase $ "a" ~> pure @IO "ax"         onCase $ "b" ~> pure @IO "bx"         onCase $ "c" ~> pure @IO "cx"@@ -470,7 +471,7 @@ specMonadStateTransformerSupport (MonadStateTransformerDeps { _fnState, _fnState2 }) = do   it "Mock with StateT correctly consumes input and returns next value" do     let action = runMockT $ do-          _ <- _fnState $ do+          _fnState $ do             onCase $ Just "current" ~> pure @(StateT String IO) "next"             onCase $ Nothing ~> pure @(StateT String IO) "default"           fnState (Just "current")@@ -479,7 +480,7 @@    it "Mock in StateT correctly executes and leaves the state unchanged (unit return)" do     let action = runMockT $ do-          _ <- _fnState2 $ "label" ~> pure @(StateT String IO) ()+          _fnState2 $ "label" ~> pure @(StateT String IO) ()           fnState2 @String "label"     result <- evalStateT action "initial"     result `shouldBe` ()@@ -496,31 +497,31 @@ specMultiParamTypeClassArity (MultiParamTypeClassArityDeps { _fn2_1Sub, _fn2_2Sub, _fn3_1Sub, _fn3_2Sub, _fn3_3Sub }) = do   it "Type variable MonadVar2_1Sub is correctly resolved and mocked" do     result <- runMockT do-      _ <- _fn2_1Sub $ "alpha" ~> pure @IO ()+      _fn2_1Sub $ "alpha" ~> pure @IO ()       fn2_1Sub @(MockT IO) @String "alpha"     result `shouldBe` ()    it "Type variable MonadVar2_2Sub is correctly resolved and mocked" do     result <- runMockT do-      _ <- _fn2_2Sub $ "beta" ~> pure @IO ()+      _fn2_2Sub $ "beta" ~> pure @IO ()       fn2_2Sub @String @(MockT IO) "beta"     result `shouldBe` ()    it "Type variable MonadVar3_1Sub is correctly resolved and mocked" do     result <- runMockT do-      _ <- _fn3_1Sub $ "gamma" ~> pure @IO ()+      _fn3_1Sub $ "gamma" ~> pure @IO ()       fn3_1Sub @(MockT IO) @String @String "gamma"     result `shouldBe` ()    it "Type variable MonadVar3_2Sub is correctly resolved and mocked" do     result <- runMockT do-      _ <- _fn3_2Sub $ "delta" ~> pure @IO ()+      _fn3_2Sub $ "delta" ~> pure @IO ()       fn3_2Sub @String @(MockT IO) @String "delta"     result `shouldBe` ()    it "Type variable MonadVar3_3Sub is correctly resolved and mocked" do     result <- runMockT do-      _ <- _fn3_3Sub $ "epsilon" ~> pure @IO ()+      _fn3_3Sub $ "epsilon" ~> pure @IO ()       fn3_3Sub @String @String @(MockT IO) "epsilon"     result `shouldBe` () @@ -532,10 +533,10 @@ specFunctionalDependenciesSupport (FunctionalDependenciesDeps { _fnParam3_1, _fnParam3_2, _fnParam3_3 }) = do   it "FunDeps are correctly resolved allowing multiple actions to return values" do     result <- runMockT $ do-      _ <- _fnParam3_1 $ do+      _fnParam3_1 $ do         onCase $ (1 :: Int) ~> True ~> pure @IO "combined"-      _ <- _fnParam3_2 $ casesIO [1 :: Int]-      _ <- _fnParam3_3 $ casesIO [True]+      _fnParam3_2 $ casesIO [1 :: Int]+      _fnParam3_3 $ casesIO [True]       r1 <- fnParam3_1 (1 :: Int) True       r2 <- fnParam3_2       r3 <- fnParam3_3@@ -550,8 +551,8 @@ specExplicitMonadicReturnValues (ExplicitMonadicReturnDeps { _getByExplicit, _echoExplicit }) = do   it "Explicitly stubbed function returns value and subsequent action is verified" do     result <- runMockT do-      _ <- _getByExplicit $ "key" ~> pure @IO (42 :: Int)-      _ <- _echoExplicit $ "value" ~> pure @IO ()+      _getByExplicit $ "key" ~> pure @IO (42 :: Int)+      _echoExplicit $ "value" ~> pure @IO ()       v <- getByExplicit "key"       echoExplicit "value"       pure v@@ -559,8 +560,8 @@    it "Helper program correctly uses and echoes the explicitly stubbed monadic return value" do     result <- runMockT do-      _ <- _getByExplicit $ "s" ~> pure @IO (10 :: Int)-      _ <- _echoExplicit $ "10" ~> pure @IO ()+      _getByExplicit $ "s" ~> pure @IO (10 :: Int)+      _echoExplicit $ "10" ~> pure @IO ()       echoProgramExplicit "s"     result `shouldBe` () @@ -572,7 +573,7 @@ specDefaultMethodMocking (DefaultMethodDeps { _defaultAction }) = do   it "Default method is successfully overridden and stubbed value is returned" do     result <- runMockT do-      _ <- _defaultAction (Head :> param (99 :: Int))+      _defaultAction (Head :> param (99 :: Int))       defaultAction     result `shouldBe` 99 @@ -585,7 +586,7 @@ specAssociatedTypeFamiliesSupport (AssociatedTypeFamiliesDeps { _produce }) = do   it "Associated Type family is correctly resolved and mocked stub value is returned" do     v <- runMockT do-      _ <- _produce (Head :> param (321 :: Int))+      _produce (Head :> param (321 :: Int))       produce     v `shouldBe` 321 @@ -598,7 +599,7 @@ specConcurrencyAndUnliftIO (ConcurrencyAndUnliftIODeps { _readFile }) = do   it "Concurrent execution (mapConcurrently) correctly calls and collects results from mocks" do     result <- runMockT do-      _ <- _readFile $ do+      _readFile $ do         onCase $ "file1.txt" ~> pack "content1"         onCase $ "file2.txt" ~> pack "content2"       processFiles ["file1.txt", "file2.txt"]@@ -606,7 +607,7 @@    it "MonadUnliftIO correctly handles internal async operation and verification" do     result <- runMockT do-      _ <- _readFile $ do+      _readFile $ do         onCase $ "test.txt" ~> pack "content"        content <- withRunInIO $ \runInIO -> do@@ -620,7 +621,7 @@    it "MonadUnliftIO basic runInIO functionality is verified correctly" do     result <- runMockT do-      _ <- _readFile $ do+      _readFile $ do         onCase $ "test.txt" ~> pack "test content"        content <- withRunInIO $ \runInIO -> do@@ -640,7 +641,7 @@   it "User defined class method handles shared user-defined type correctly" do     let p = Post 1 "title"     runMockT @IO $ do-      _ <- _processPost $ do+      _processPost $ do          -- verify that we can match exactly on the user defined type          onCase $ p ~> True       @@ -657,7 +658,7 @@ specBasicVerificationFailureDetection (BasicDeps { _readFile, _writeFile }) = describe "verification failures (FileOperation)" do     it "Error when read stub is defined but target function readFile is never called" do       (runMockT @IO do-        _ <- _readFile ("input.txt" ~> pack "content")+        _readFile ("input.txt" ~> pack "content")           `expects` do             called once         -- readFile is never called@@ -665,7 +666,7 @@      it "Error when write stub is defined but target function writeFile is never called" do       (runMockT @IO do-        _ <- _writeFile ("output.txt" ~> pack "content" ~> ())+        _writeFile ("output.txt" ~> pack "content" ~> ())           `expects` do             called once         -- writeFile is never called@@ -673,10 +674,10 @@      it "Error when read stub expects call but only writeFile is executed" do       (runMockT @IO do-        _ <- _readFile ("input.txt" ~> pack "content")+        _readFile ("input.txt" ~> pack "content")           `expects` do             called once-        _ <- _writeFile  ("output.txt" ~> pack "content" ~> ())+        _writeFile  ("output.txt" ~> pack "content" ~> ())         -- readFile is never called, only writeFile is called         do           writeFile "output.txt" (pack "content")@@ -684,8 +685,8 @@      it "Error when write stub expects call but only readFile is executed" do       (runMockT @IO do-        _ <- _readFile  ("input.txt" ~> pack "content")-        _ <- _writeFile ("output.txt" ~> pack "content" ~> ())+        _readFile  ("input.txt" ~> pack "content")+        _writeFile ("output.txt" ~> pack "content" ~> ())           `expects` do             called once         -- writeFile is never called, only readFile is called@@ -700,7 +701,7 @@ specMonadReaderVerificationFailureDetection (ReaderContextDeps { _ask }) = describe "verification failures (Reader Environment)" do     it "Error when MonadReader stub _ask is defined but target function ask is never called" do       (runMockT @IO do-        _ <- _ask (Head :> param (Environment "input.txt" "output.txt"))+        _ask (Head :> param (Environment "input.txt" "output.txt"))           `expects` do             called once         -- ask is never called@@ -712,14 +713,14 @@ specImplicitReturnVerificationFailureDetection (ImplicitMonadicReturnDeps { _getBy, _echo }) = describe "verification failures (TestClass)" do     it "Error when _getBy stub expects call but getBy is never executed" do       (runMockT @IO do-        _ <- _getBy ("s" ~> pure @IO (10 :: Int))+        _getBy ("s" ~> pure @IO (10 :: Int))           `expects` do             called once         pure ()) `shouldThrow` missingCall "_getBy"      it "Error when _echo stub expects call but echo is never executed" do       (runMockT @IO do-        _ <- _echo ("10" ~> pure @IO ())+        _echo ("10" ~> pure @IO ())           `expects` do             called once         pure ()) `shouldThrow` missingCall "_echo"@@ -730,35 +731,35 @@ specMultiParamVerificationFailureDetection (MultiParamTypeClassArityDeps { _fn2_1Sub, _fn2_2Sub, _fn3_1Sub, _fn3_2Sub, _fn3_3Sub }) = describe "verification failures (SubVars)" do     it "Error when _fn2_1Sub stub expects call but fn2_1Sub is never executed" do       (runMockT @IO do-        _ <- _fn2_1Sub ("alpha" ~> pure @IO ())+        _fn2_1Sub ("alpha" ~> pure @IO ())           `expects` do             called once         pure ()) `shouldThrow` missingCall "_fn2_1Sub"      it "Error when _fn2_2Sub stub expects call but fn2_2Sub is never executed" do       (runMockT @IO do-        _ <- _fn2_2Sub ("beta" ~> pure @IO ())+        _fn2_2Sub ("beta" ~> pure @IO ())           `expects` do             called once         pure ()) `shouldThrow` missingCall "_fn2_2Sub"      it "Error when _fn3_1Sub stub expects call but fn3_1Sub is never executed" do       (runMockT @IO do-        _ <- _fn3_1Sub ("gamma" ~> pure @IO ())+        _fn3_1Sub ("gamma" ~> pure @IO ())           `expects` do             called once         pure ()) `shouldThrow` missingCall "_fn3_1Sub"      it "Error when _fn3_2Sub stub expects call but fn3_2Sub is never executed" do       (runMockT @IO do-        _ <- _fn3_2Sub ("delta" ~> pure @IO ())+        _fn3_2Sub ("delta" ~> pure @IO ())           `expects` do             called once         pure ()) `shouldThrow` missingCall "_fn3_2Sub"      it "Error when _fn3_3Sub stub expects call but fn3_3Sub is never executed" do       (runMockT @IO do-        _ <- _fn3_3Sub ("epsilon" ~> pure @IO ())+        _fn3_3Sub ("epsilon" ~> pure @IO ())           `expects` do             called once         pure ()) `shouldThrow` missingCall "_fn3_3Sub"@@ -769,7 +770,7 @@ specArgumentMatchingVerificationFailureDetection (ArgumentPatternMatchingDeps { _getValueBy }) = describe "verification failures (MultiApply)" do     it "Error when multi-case stub _getValueBy expects call but getValueBy is never executed" do       (runMockT @IO do-        _ <- _getValueBy (do onCase $ "a" ~> pure @IO "ax")+        _getValueBy (do onCase $ "a" ~> pure @IO "ax")           `expects` do             called once         pure ()) `shouldThrow` missingCall "_getValueBy"@@ -780,7 +781,7 @@ specFunDepsVerificationFailureDetection (FunctionalDependenciesDeps { _fnParam3_1, _fnParam3_2, _fnParam3_3 }) = describe "verification failures (ParamThreeMonad)" do     it "Error when FunDep stub _fnParam3_1 expects call but fnParam3_1 is never executed" do       (runMockT @IO do-        _ <- _fnParam3_1 (do+        _fnParam3_1 (do                onCase $ (1 :: Int) ~> True ~> pure @IO "combined")           `expects` do             called once@@ -788,14 +789,14 @@      it "Error when FunDep stub _fnParam3_2 expects call but fnParam3_2 is never executed" do       (runMockT @IO do-        _ <- _fnParam3_2 (casesIO [1 :: Int])+        _fnParam3_2 (casesIO [1 :: Int])           `expects` do             called once         pure ()) `shouldThrow` missingCall "_fnParam3_2"      it "Error when FunDep stub _fnParam3_3 expects call but fnParam3_3 is never executed" do       (runMockT @IO do-        _ <- _fnParam3_3 (casesIO [True])+        _fnParam3_3 (casesIO [True])           `expects` do             called once         pure ()) `shouldThrow` missingCall "_fnParam3_3"@@ -806,14 +807,14 @@ specExplicitReturnVerificationFailureDetection (ExplicitMonadicReturnDeps { _getByExplicit, _echoExplicit }) = describe "verification failures (ExplicitReturn)" do     it "Error when explicit stub _getByExplicit expects call but getByExplicit is never executed" do       (runMockT @IO do-        _ <- _getByExplicit ("key" ~> pure @IO (42 :: Int))+        _getByExplicit ("key" ~> pure @IO (42 :: Int))           `expects` do             called once         pure ()) `shouldThrow` missingCall "_getByExplicit"      it "Error when explicit stub _echoExplicit expects call but echoExplicit is never executed" do       (runMockT @IO do-        _ <- _echoExplicit ("value" ~> pure @IO ())+        _echoExplicit ("value" ~> pure @IO ())           `expects` do             called once         pure ()) `shouldThrow` missingCall "_echoExplicit"@@ -825,14 +826,14 @@ specAdvancedTypesVerificationFailureDetection (DefaultMethodDeps { _defaultAction }) (AssociatedTypeFamiliesDeps { _produce }) = describe "verification failures (Default/Assoc)" do     it "Error when default method stub _defaultAction expects call but defaultAction is never executed" do       (runMockT @IO do-        _ <- _defaultAction (Head :> param (99 :: Int))+        _defaultAction (Head :> param (99 :: Int))           `expects` do             called once         pure ()) `shouldThrow` missingCall "_defaultAction"      it "Error when associated type stub _produce expects call but produce is never executed" do       (runMockT @IO do-        _ <- _produce (Head :> param (321 :: Int))+        _produce (Head :> param (321 :: Int))           `expects` do             called once         pure ()) `shouldThrow` missingCall "_produce"@@ -843,14 +844,14 @@ specSequentialStubbingVerificationFailureDetection (SequentialIODeps { _readTTY, _writeTTY }) = describe "verification failures (TTY)" do     it "Error when sequential stub _readTTY expects call but readTTY is never executed" do       (runMockT @IO do-        _ <- _readTTY (casesIO ["a", ""])+        _readTTY (casesIO ["a", ""])           `expects` do             called once         pure ()) `shouldThrow` missingCall "_readTTY"      it "Error when sequential stub _writeTTY expects call but writeTTY is never executed" do       (runMockT @IO do-        _ <- _writeTTY ("a" ~> pure @IO ())+        _writeTTY ("a" ~> pure @IO ())           `expects` do             called once         pure ()) `shouldThrow` missingCall "_writeTTY"

@@ -0,0 +1,104 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}++module Test.MockCat.TypeClassMinimalSpec (spec) where++import Test.Hspec+import Test.MockCat+import Data.Text (Text, pack)+import Test.MockCat.Verify (ResolvableParamsOf)+import Prelude hiding (readFile, writeFile, any)++import Data.Proxy (Proxy(..))+import Control.Exception (ErrorCall, displayException, evaluate)+import Data.List (isInfixOf)+import Data.Typeable (cast)+import GHC.TypeLits (symbolVal)+import Control.Monad.IO.Class (liftIO)++-- Helper for error matching+missingCallHandwritten :: String -> Selector ErrorCall+missingCallHandwritten name err =+  let needle1 = "function `" <> name <> "` was not called the expected number of times."+      needle2 = "function `_" <> name <> "` was not called the expected number of times."+   in (needle1 `isInfixOf` displayException err) || (needle2 `isInfixOf` displayException err)++-- Handwritten polymorphic return helpers+_readFile ::+  ( MockDispatch (IsMockSpec spec) spec (MockT IO) (FilePath -> Text)+  ) =>+  spec ->+  MockT IO (MockResult (ResolvableParamsOf (FilePath -> Text)))+_readFile p = MockT $ do+  fn <- unMockT (mock (label "readFile") p :: MockT IO (FilePath -> Text))+  addDefinition (Definition (Proxy :: Proxy "readFile") fn NoVerification)+  pure (MockResult ())++_writeFile ::+  ( MockDispatch (IsMockSpec spec) spec (MockT IO) (FilePath -> Text -> ())+  ) =>+  spec ->+  MockT IO (MockResult (ResolvableParamsOf (FilePath -> Text -> ())))+_writeFile p = MockT $ do+  fn <- unMockT (mock (label "writeFile") p :: MockT IO (FilePath -> Text -> ()))+  addDefinition (Definition (Proxy :: Proxy "writeFile") fn NoVerification)+  pure (MockResult ())++readFile :: FilePath -> MockT IO Text+readFile path = do+  defs <- getDefinitions+  let stubs = reverse [f | Definition (p :: Proxy sym) fn _ <- defs, symbolVal p == "readFile", Just f <- [cast fn :: Maybe (FilePath -> Text)]]+  case stubs of+    [] -> error "readFile: no stub defined or type mismatch"+    (f : _) -> pure (f path)++writeFile :: FilePath -> Text -> MockT IO ()+writeFile path content = do+  defs <- getDefinitions+  let stubs = reverse [f | Definition (p :: Proxy sym) fn _ <- defs, symbolVal p == "writeFile", Just f <- [cast fn :: Maybe (FilePath -> Text -> ())]]+  case stubs of+    [] -> error "writeFile: no stub defined or type mismatch"+    (f : _) -> pure (f path content)++spec :: Spec+spec = do+  describe "Polymorphic return tests (Clean)" do+    it "Program definition suppresses unused-do-bind warning (expects not used)" do+      -- Just verify that this compiles without warning+      runMockT do+        _readFile $ "input.txt" ~> pack "content"+        _writeFile $ "output.txt" ~> pack "content" ~> ()+        pure ()++    it "Error when read stub is defined but target function readFile is never called (expects used)" do+      (runMockT @IO do+        _readFile ("input.txt" ~> pack "content")+          `expects` called once+        -- readFile is never called+        pure ()) `shouldThrow` missingCallHandwritten "readFile"++    it "Arguments can be verified even if the helper returns () (Dynamic Resolution + Coercion)" do+      runMockT do+        _readFile ("input.txt" ~> pack "content") `expects` called once+        _ <- readFile "input.txt" >>= liftIO . evaluate+        pure ()++    it "Arguments can be verified with 'with' (Dynamic Resolution + Coercion)" do+      runMockT do+        _readFile ("input.txt" ~> pack "content") `expects` (called once `with` "input.txt")+        _ <- readFile "input.txt" >>= liftIO . evaluate+        pure ()++    it "Can verify arguments for functions returning () without type annotations (writeFile)" do+      runMockT do+        _writeFile ("output.txt" ~> pack "content" ~> ()) `expects` called once+        -- Execute the function and force evaluation+        writeFile "output.txt" (pack "content") >>= liftIO . evaluate+        pure ()

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-}@@ -11,16 +12,20 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}-{-# OPTIONS_GHC -Wno-unused-do-bind #-}  module Test.MockCat.TypeClassSpec (spec) where -import Data.Text (Text)-import Test.Hspec (Spec)+import Data.Text (Text, pack)+import qualified Data.List as List+import Test.Hspec (Spec, shouldBe, shouldThrow, Selector, describe, it)+import Control.Exception (ErrorCall, displayException) import Test.MockCat import Prelude hiding (readFile, writeFile, any)+ import Data.Data import Data.List (find) import GHC.TypeLits (KnownSymbol, symbolVal)@@ -88,48 +93,48 @@   , Typeable env   ) =>   params ->-  MockT m env+  MockT m (MockResult (Verify.ResolvableParamsOf env)) _ask p = MockT $ do   mockInstance <- unMockT $ mock (label "ask") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "ask") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _readFile ::   ( MockDispatch (IsMockSpec params) params (MockT m) (FilePath -> Text)   , MonadIO m   ) =>   params ->-  MockT m (FilePath -> Text)+  MockT m (MockResult (Verify.ResolvableParamsOf (FilePath -> Text))) _readFile p = MockT $ do   mockInstance <- unMockT $ mock (label "readFile") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "readFile") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _writeFile ::   ( MockDispatch (IsMockSpec params) params (MockT m) (FilePath -> Text -> ())   , MonadIO m   ) =>   params ->-  MockT m (FilePath -> Text -> ())+  MockT m (MockResult (Verify.ResolvableParamsOf (FilePath -> Text -> ()))) _writeFile p = MockT $ do   mockInstance <- unMockT $ mock (label "writeFile") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "writeFile") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _post ::   ( MockDispatch (IsMockSpec params) params (MockT m) (Text -> ())   , MonadIO m   ) =>   params ->-  MockT m (Text -> ())+  MockT m (MockResult (Verify.ResolvableParamsOf (Text -> ()))) _post p = MockT $ do   mockFn <- unMockT $ mock (label "post") p   ensureVerifiable mockFn   addDefinition (Definition (Proxy :: Proxy "post") mockFn NoVerification)-  pure mockFn+  pure (MockResult ())  findParam :: KnownSymbol sym => Proxy sym -> [Definition] -> Maybe a findParam pa definitions = do@@ -297,12 +302,12 @@   , Verify.ResolvableParamsOf (String -> m Int) ~ Param String   ) =>   params ->-  MockT m (String -> m Int)+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m Int))) _getBy p = MockT $ do   mockInstance <- unMockT $ mock (label "_getBy") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_getBy") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _echo ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -311,12 +316,12 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _echo p = MockT $ do   mockInstance <- unMockT $ mock (label "_echo") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_echo") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fn2_1Sub ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -325,12 +330,12 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _fn2_1Sub p = MockT $ do   mockInstance <- unMockT $ mock (label "_fn2_1Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn2_1Sub") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fn2_2Sub ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -339,12 +344,12 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _fn2_2Sub p = MockT $ do   mockInstance <- unMockT $ mock (label "_fn2_2Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn2_2Sub") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fn3_1Sub ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -353,12 +358,12 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _fn3_1Sub p = MockT $ do   mockInstance <- unMockT $ mock (label "_fn3_1Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn3_1Sub") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fn3_2Sub ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -367,12 +372,12 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _fn3_2Sub p = MockT $ do   mockInstance <- unMockT $ mock (label "_fn3_2Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn3_2Sub") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fn3_3Sub ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -381,12 +386,12 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _fn3_3Sub p = MockT $ do   mockInstance <- unMockT $ mock (label "_fn3_3Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn3_3Sub") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _getValueBy ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m String)@@ -395,12 +400,12 @@   , Verify.ResolvableParamsOf (String -> m String) ~ Param String   ) =>   params ->-  MockT m (String -> m String)+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m String))) _getValueBy p = MockT $ do   mockInstance <- unMockT $ mock (label "_getValueBy") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_getValueBy") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fnState ::   ( MockDispatch (IsMockSpec params) params (MockT m) (Maybe s -> m s)@@ -410,11 +415,11 @@   , Verify.ResolvableParamsOf (Maybe s -> m s) ~ Param (Maybe s)   ) =>   params ->-  MockT m (Maybe s -> m s)+  MockT m (MockResult (Verify.ResolvableParamsOf (Maybe s -> m s))) _fnState p = MockT $ do   mockInstance <- unMockT $ mock (label "_fnState") p   addDefinition (Definition (Proxy :: Proxy "_fnState") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fnState2 ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -423,11 +428,11 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _fnState2 p = MockT $ do   mockInstance <- unMockT $ mock (label "_fnState2") p   addDefinition (Definition (Proxy :: Proxy "_fnState2") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fnParam3_1 ::   ( MockDispatch (IsMockSpec params) params (MockT m) (Int -> Bool -> m String)@@ -436,12 +441,12 @@   , Verify.ResolvableParamsOf (Int -> Bool -> m String) ~ (Param Int :> Param Bool)   ) =>   params ->-  MockT m (Int -> Bool -> m String)+  MockT m (MockResult (Verify.ResolvableParamsOf (Int -> Bool -> m String))) _fnParam3_1 p = MockT $ do   mockInstance <- unMockT $ mock (label "_fnParam3_1") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fnParam3_1") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fnParam3_2 ::   ( MockDispatch (IsMockSpec params) params (MockT m) (m Int)@@ -450,12 +455,12 @@   , Verify.ResolvableParamsOf (m Int) ~ ()   ) =>   params ->-  MockT m (m Int)+  MockT m (MockResult (Verify.ResolvableParamsOf (m Int))) _fnParam3_2 p = MockT $ do   mockInstance <- unMockT $ mock (label "_fnParam3_2") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fnParam3_2") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _fnParam3_3 ::   ( MockDispatch (IsMockSpec params) params (MockT m) (m Bool)@@ -464,12 +469,12 @@   , Verify.ResolvableParamsOf (m Bool) ~ ()   ) =>   params ->-  MockT m (m Bool)+  MockT m (MockResult (Verify.ResolvableParamsOf (m Bool))) _fnParam3_3 p = MockT $ do   mockInstance <- unMockT $ mock (label "_fnParam3_3") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fnParam3_3") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _getByExplicit ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m Int)@@ -478,12 +483,12 @@   , Verify.ResolvableParamsOf (String -> m Int) ~ Param String   ) =>   params ->-  MockT m (String -> m Int)+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m Int))) _getByExplicit p = MockT $ do   mockInstance <- unMockT $ mock (label "_getByExplicit") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_getByExplicit") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _echoExplicit ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -492,12 +497,12 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _echoExplicit p = MockT $ do   mockInstance <- unMockT $ mock (label "_echoExplicit") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_echoExplicit") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _defaultAction ::   ( MonadIO m@@ -506,12 +511,12 @@   , Typeable a   ) =>   params ->-  MockT m a+  MockT m (MockResult (Verify.ResolvableParamsOf a)) _defaultAction p = MockT $ do   mockInstance <- unMockT $ mock (label "_defaultAction") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_defaultAction") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _produce ::   ( MockDispatch (IsMockSpec p) p (MockT m) (ResultType m)@@ -521,12 +526,12 @@   , Typeable (ResultType m)   ) =>   p ->-  MockT m (ResultType m)+  MockT m (MockResult (Verify.ResolvableParamsOf (ResultType m))) _produce p = MockT $ do   mockInstance <- unMockT $ mock (label "_produce") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_produce") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  instance MonadIO m => Teletype (MockT m) where   readTTY = MockT do@@ -550,12 +555,12 @@   , Verify.ResolvableParamsOf (m String) ~ ()   ) =>   params ->-  MockT m (m String)+  MockT m (MockResult (Verify.ResolvableParamsOf (m String))) _readTTY p = MockT $ do   mockInstance <- unMockT $ mock (label "_readTTY") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_readTTY") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _writeTTY ::   ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())@@ -564,24 +569,24 @@   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String   ) =>   params ->-  MockT m (String -> m ())+  MockT m (MockResult (Verify.ResolvableParamsOf (String -> m ()))) _writeTTY p = MockT $ do   mockInstance <- unMockT $ mock (label "_writeTTY") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_writeTTY") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  _processPost ::   ( MockDispatch (IsMockSpec params) params (MockT m) (Post -> Bool)   , MonadIO m   ) =>   params ->-  MockT m (Post -> Bool)+  MockT m (MockResult (Verify.ResolvableParamsOf (Post -> Bool))) _processPost p = MockT $ do   mockInstance <- unMockT $ mock (label "_processPost") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_processPost") mockInstance NoVerification)-  pure mockInstance+  pure (MockResult ())  instance MonadIO m => UserDefinedClass (MockT m) where   processPost p = MockT do@@ -592,8 +597,54 @@       !result = mockFn p     lift $ pure result +-- Handwritten polymorphic return helpers for testing+_readFileHandwritten ::+  ( MockDispatch (IsMockSpec params) params (MockT IO) (FilePath -> Text)+  ) =>+  params ->+  MockT IO (MockResult (Verify.ResolvableParamsOf (FilePath -> Text)))+_readFileHandwritten p = do+  fn <- mock (label "readFile") p :: MockT IO (FilePath -> Text)+  addDefinition (Definition (Proxy :: Proxy "readFile") fn NoVerification)+  pure (MockResult ())++_writeFileHandwritten ::+  ( MockDispatch (IsMockSpec params) params (MockT IO) (FilePath -> Text -> ())+  ) =>+  params ->+  MockT IO (MockResult (Verify.ResolvableParamsOf (FilePath -> Text -> ())))+_writeFileHandwritten p = do+  fn <- mock (label "writeFile") p :: MockT IO (FilePath -> Text -> ())+  addDefinition (Definition (Proxy :: Proxy "writeFile") fn NoVerification)+  pure (MockResult ())++-- Helper for error matching (same logic as TypeClassCommonSpec)+missingCallHandwritten :: String -> Selector ErrorCall+missingCallHandwritten name err =+  let needle1 = "function `" <> name <> "` was not called the expected number of times."+      needle2 = "function `_" <> name <> "` was not called the expected number of times."+   in (needle1 `List.isInfixOf` displayException err) || (needle2 `List.isInfixOf` displayException err)+ spec :: Spec spec = do+  -- Handwritten polymorphic return tests+  describe "Handwritten polymorphic return tests" do+    it "Program reads content and writes it to output path (expects not used)" do+      result <- runMockT do+        _readFileHandwritten $ "input.txt" ~> pack "content"+        _writeFileHandwritten $ "output.txt" ~> pack "content" ~> ()+        SpecCommon.operationProgram "input.txt" "output.txt"++      result `shouldBe` ()++    it "Error when read stub is defined but target function readFile is never called (expects used)" do+      (runMockT @IO do+        _readFileHandwritten ("input.txt" ~> pack "content")+          `expects` do+            called once+        -- readFile is never called+        pure ()) `shouldThrow` missingCallHandwritten "readFile"+     -- build SpecDeps and call aggregated spec entrypoint   let deps = SpecCommon.SpecDeps         { SpecCommon.basicDeps          = SpecCommon.BasicDeps _readFile _writeFile

@@ -24,6 +24,7 @@ import qualified Test.MockCat.TypeClassCommonSpec as SpecCommon  --makeAutoLiftMock [t|MonadReader Bool|]+ makeAutoLiftMock [t|MonadReader SpecCommon.Environment|] makeMock [t|MonadVar2_1Sub|] makeMock [t|MonadVar2_2Sub|]@@ -51,33 +52,33 @@   produce = pure 0  spec :: Spec-spec = do-  -- build SpecDeps and call aggregated spec entrypoint-  let deps = SpecCommon.SpecDeps-        { SpecCommon.basicDeps          = SpecCommon.BasicDeps _readFile _writeFile-        , SpecCommon.mixedDeps          = SpecCommon.MixedDeps _readFile _writeFile _post-        , SpecCommon.multipleDeps       = SpecCommon.MultipleDeps _ask _readFile _writeFile _post+spec = describe "TypeClassTHSpec" $ do+    -- build SpecDeps and call aggregated spec entrypoint+    let deps = SpecCommon.SpecDeps+          { SpecCommon.basicDeps          = SpecCommon.BasicDeps _readFile _writeFile+          , SpecCommon.mixedDeps          = SpecCommon.MixedDeps _readFile _writeFile _post+          , SpecCommon.multipleDeps       = SpecCommon.MultipleDeps _ask _readFile _writeFile _post -        , SpecCommon.readerContextDeps  = SpecCommon.ReaderContextDeps _ask _readFile _writeFile-        , SpecCommon.sequentialIODeps            = SpecCommon.SequentialIODeps _readTTY _writeTTY-        , SpecCommon.ttyDeps                      = SpecCommon.TtyDeps _readTTY _writeTTY-        , SpecCommon.implicitMonadicReturnDeps    = SpecCommon.ImplicitMonadicReturnDeps _getBy _echo-        , SpecCommon.testClassDeps                = SpecCommon.TestClassDeps _getBy _echo-        , SpecCommon.argumentPatternMatchingDeps  = SpecCommon.ArgumentPatternMatchingDeps _getValueBy-        , SpecCommon.multiApplyDeps               = SpecCommon.MultiApplyDeps _getValueBy-        , SpecCommon.monadStateTransformerDeps    = SpecCommon.MonadStateTransformerDeps _fnState _fnState2-        , SpecCommon.stateDeps                    = SpecCommon.StateDeps _fnState _fnState2-        , SpecCommon.multiParamTypeClassArityDeps = SpecCommon.MultiParamTypeClassArityDeps _fn2_1Sub _fn2_2Sub _fn3_1Sub _fn3_2Sub _fn3_3Sub-        , SpecCommon.multiParamDeps               = SpecCommon.MultiParamDeps _fn2_1Sub _fn2_2Sub _fn3_1Sub _fn3_2Sub _fn3_3Sub-        , SpecCommon.functionalDependenciesDeps   = SpecCommon.FunctionalDependenciesDeps _fnParam3_1 _fnParam3_2 _fnParam3_3-        , SpecCommon.funDeps                      = SpecCommon.FunDeps _fnParam3_1 _fnParam3_2 _fnParam3_3-        , SpecCommon.explicitMonadicReturnDeps    = SpecCommon.ExplicitMonadicReturnDeps _getByExplicit _echoExplicit-        , SpecCommon.explicitReturnDeps           = SpecCommon.ExplicitReturnDeps _getByExplicit _echoExplicit-        , SpecCommon.defaultMethodDeps            = SpecCommon.DefaultMethodDeps _defaultAction-        , SpecCommon.associatedTypeFamiliesDeps   = SpecCommon.AssociatedTypeFamiliesDeps _produce-        , SpecCommon.assocTypeDeps                = SpecCommon.AssocTypeDeps _produce-        , SpecCommon.concurrencyAndUnliftIODeps   = SpecCommon.ConcurrencyAndUnliftIODeps _readFile-        , SpecCommon.concurrencyDeps              = SpecCommon.ConcurrencyDeps _readFile-        , SpecCommon.userDefinedTypeDeps          = SpecCommon.UserDefinedTypeDeps _processPost-        }-  SpecCommon.spec deps+          , SpecCommon.readerContextDeps  = SpecCommon.ReaderContextDeps _ask _readFile _writeFile+          , SpecCommon.sequentialIODeps            = SpecCommon.SequentialIODeps _readTTY _writeTTY+          , SpecCommon.ttyDeps                      = SpecCommon.TtyDeps _readTTY _writeTTY+          , SpecCommon.implicitMonadicReturnDeps    = SpecCommon.ImplicitMonadicReturnDeps _getBy _echo+          , SpecCommon.testClassDeps                = SpecCommon.TestClassDeps _getBy _echo+          , SpecCommon.argumentPatternMatchingDeps  = SpecCommon.ArgumentPatternMatchingDeps _getValueBy+          , SpecCommon.multiApplyDeps               = SpecCommon.MultiApplyDeps _getValueBy+          , SpecCommon.monadStateTransformerDeps    = SpecCommon.MonadStateTransformerDeps _fnState _fnState2+          , SpecCommon.stateDeps                    = SpecCommon.StateDeps _fnState _fnState2+          , SpecCommon.multiParamTypeClassArityDeps = SpecCommon.MultiParamTypeClassArityDeps _fn2_1Sub _fn2_2Sub _fn3_1Sub _fn3_2Sub _fn3_3Sub+          , SpecCommon.multiParamDeps               = SpecCommon.MultiParamDeps _fn2_1Sub _fn2_2Sub _fn3_1Sub _fn3_2Sub _fn3_3Sub+          , SpecCommon.functionalDependenciesDeps   = SpecCommon.FunctionalDependenciesDeps _fnParam3_1 _fnParam3_2 _fnParam3_3+          , SpecCommon.funDeps                      = SpecCommon.FunDeps _fnParam3_1 _fnParam3_2 _fnParam3_3+          , SpecCommon.explicitMonadicReturnDeps    = SpecCommon.ExplicitMonadicReturnDeps _getByExplicit _echoExplicit+          , SpecCommon.explicitReturnDeps           = SpecCommon.ExplicitReturnDeps _getByExplicit _echoExplicit+          , SpecCommon.defaultMethodDeps            = SpecCommon.DefaultMethodDeps _defaultAction+          , SpecCommon.associatedTypeFamiliesDeps   = SpecCommon.AssociatedTypeFamiliesDeps _produce+          , SpecCommon.assocTypeDeps                = SpecCommon.AssocTypeDeps _produce+          , SpecCommon.concurrencyAndUnliftIODeps   = SpecCommon.ConcurrencyAndUnliftIODeps _readFile+          , SpecCommon.concurrencyDeps              = SpecCommon.ConcurrencyDeps _readFile+          , SpecCommon.userDefinedTypeDeps          = SpecCommon.UserDefinedTypeDeps _processPost+          }+    SpecCommon.spec deps

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -46,7 +47,7 @@             \    [Closest] 1. \"hello haskell\""       withMock (do         f <- mock ((any :: Param String) ~> "ok") `expects` (called once `with` "hello world")-        _ <- liftIO $ evaluate $ f "hello haskell"+        liftIO $ evaluate $ f "hello haskell"         pure ()         ) `shouldThrow` errorCall expectedError @@ -67,7 +68,7 @@             \                           ^^^^^^^^^^^^^^^^^^^"       withMock (do         f <- mock (Post 1 "title" ~> "ok")-        _ <- liftIO $ evaluate $ f (Post 2 "wrong")+        liftIO $ evaluate $ f (Post 2 "wrong")         pure ()         ) `shouldThrow` errorCall expectedError @@ -88,7 +89,7 @@             \    [Closest] 1. [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]"       withMock (do         f <- mock ((any :: Param [Int]) ~> "ok") `expects` (called once `with` [1, 2, 3, 4, 5, 6, 7, 8, 9, 10])-        _ <- liftIO $ evaluate $ f [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]+        liftIO $ evaluate $ f [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]         pure ()         ) `shouldThrow` errorCall expectedError @@ -109,7 +110,7 @@             \    [Closest] 1. User {name = \"Fagen\", age = 20}"       withMock (do         f <- mock ((any :: Param User) ~> "ok") `expects` (called once `with` User "Fagen" 30)-        _ <- liftIO $ evaluate $ f (User "Fagen" 20)+        liftIO $ evaluate $ f (User "Fagen" 20)         pure ()         ) `shouldThrow` errorCall expectedError @@ -121,8 +122,8 @@             \                      ^^"       withMock (do         f <- mock ((any :: Param String) ~> "ok") `expects` calledInOrder ["a", "c"]-        _ <- liftIO $ evaluate $ f "a"-        _ <- liftIO $ evaluate $ f "b"+        liftIO $ evaluate $ f "a"+        liftIO $ evaluate $ f "b"         pure ()         ) `shouldThrow` errorCall expectedError @@ -139,7 +140,7 @@         f <- mock $ do           onCase $ "aaa" ~> (100 :: Int) ~> "ok"           onCase $ "bbb" ~> (200 :: Int) ~> "ok"-        _ <- liftIO $ evaluate (f "aaa" 200)+        liftIO $ evaluate (f "aaa" 200)         pure ()         ) `shouldThrow` errorCall expectedError @@ -160,7 +161,7 @@             \    [Closest] 1. ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 1}}"       withMock (do         f <- mock ((any :: Param ComplexUser) ~> "ok") `expects` (called once `with` ComplexUser "Alice" (Config "Dark" 1))-        _ <- liftIO $ evaluate $ f (ComplexUser "Alice" (Config "Light" 1))+        liftIO $ evaluate $ f (ComplexUser "Alice" (Config "Light" 1))         pure ()         ) `shouldThrow` errorCall expectedError @@ -181,7 +182,7 @@             \    [Closest] 1. [[1,2], [3,4]]"       withMock (do         f <- mock ((any :: Param [[Int]]) ~> "ok") `expects` (called once `with` [[1, 2], [3, 5]])-        _ <- liftIO $ evaluate $ f [[1, 2], [3, 4]]+        liftIO $ evaluate $ f [[1, 2], [3, 4]]         pure ()         ) `shouldThrow` errorCall expectedError @@ -210,46 +211,50 @@             \    [Closest] 1. ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 2}}"       withMock (do         f <- mock ((any :: Param ComplexUser) ~> "ok") `expects` (called once `with` expected)-        _ <- liftIO $ evaluate $ f actual+        liftIO $ evaluate $ f actual         pure ()         ) `shouldThrow` errorCall expectedError      describe "robustness (broken formats)" do       it "handles unbalanced braces gracefully (fallback to standard message)" do+         f <- mock ((any :: Param String) ~> "ok")          let actual = "{ name = \"Alice\""              expected = "{ name = \"Bob\" }"-             expectedError =-                "function was not called with the expected arguments.\n\-                \\n\-                \  Closest match:\n\-                \    expected: \"{ name = \\\"Bob\\\" }\"\n\-                \     but got: \"{ name = \\\"Alice\\\"\"\n\-                \            " <> replicate 14 ' ' <> "^^^^^^^^\n\-                \\n\-                \  Call history (1 calls):\n\-                \    [Closest] 1. \"{ name = \\\"Alice\\\"\""+         evaluate $ f actual+         let expectedError =+               "function was not called with the expected arguments.\n\+               \\n\+               \  Closest match:\n\+               \    expected: \"{ name = \\\"Bob\\\" }\"\n\+               \     but got: \"{ name = \\\"Alice\\\"\"\n\+               \            " <> replicate 14 ' ' <> "^^^^^^^^\n\+               \\n\+               \  Call history (1 calls):\n\+               \    [Closest] 1. \"{ name = \\\"Alice\\\"\""          withMock (do-           f <- mock ((any :: Param String) ~> "ok") `expects` (called once `with` expected)-           _ <- liftIO $ evaluate $ f actual+           f' <- mock ((any :: Param String) ~> "ok") `expects` (called once `with` expected)+           liftIO $ evaluate $ f' actual            pure ()            ) `shouldThrow` errorCall expectedError        it "handles completely broken structure strings" do+         f <- mock ((any :: Param String) ~> "ok")          let actual = "NotARecord {,,,,,}"          let expected = "NotARecord { a = 1 }"+         evaluate $ f actual          let expectedError =-                "function was not called with the expected arguments.\n\-                \\n\-                \  Closest match:\n\-                \    expected: \"NotARecord { a = 1 }\"\n\-                \     but got: \"NotARecord {,,,,,}\"\n\-                \            " <> replicate 15 ' ' <> "^^^^^^^^^\n\-                \\n\-                \  Call history (1 calls):\n\-                \    [Closest] 1. \"NotARecord {,,,,,}\""+               "function was not called with the expected arguments.\n\+               \\n\+               \  Closest match:\n\+               \    expected: \"NotARecord { a = 1 }\"\n\+               \     but got: \"NotARecord {,,,,,}\"\n\+               \            " <> replicate 15 ' ' <> "^^^^^^^^^\n\+               \\n\+               \  Call history (1 calls):\n\+               \    [Closest] 1. \"NotARecord {,,,,,}\""          withMock (do-           f <- mock ((any :: Param String) ~> "ok") `expects` (called once `with` expected)-           _ <- liftIO $ evaluate $ f actual+           f'' <- mock ((any :: Param String) ~> "ok") `expects` (called once `with` expected)+           liftIO $ evaluate $ f'' actual            pure ()            ) `shouldThrow` errorCall expectedError @@ -274,7 +279,7 @@               \    [Closest] 1. Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 0}}}}}"         withMock (do           f <- mock ((any :: Param DeepNode) ~> "ok") `expects` (called once `with` expected)-          _ <- liftIO $ evaluate $ f actual+          liftIO $ evaluate $ f actual           pure ()           ) `shouldThrow` errorCall expectedError @@ -303,7 +308,7 @@               \    [Closest] 1. MultiLayer {layer1 = \"A\", sub = SubLayer {layer2 = \"B\", items = [Node {val = 1, next = Leaf 2}]}}"         withMock (do           f <- mock ((any :: Param MultiLayer) ~> "ok") `expects` (called once `with` expected)-          _ <- liftIO $ evaluate $ f actual+          liftIO $ evaluate $ f actual           pure ()           ) `shouldThrow` errorCall expectedError @@ -329,6 +334,6 @@               \    [Closest] 1. Config {theme = \"Light\", level = 1}"         withMock (do           f <- mock ((any :: Param Config) ~> "ok") `expects` (called once `with` expected)-          _ <- liftIO $ evaluate $ f actual+          liftIO $ evaluate $ f actual           pure ()           ) `shouldThrow` errorCall expectedError

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-}@@ -55,39 +56,35 @@     it "should work with expects and specific value" $ do       withMock $ do         let p = Post 1 "title"-        f <- mock (any ~> True)-          `expects` (called once `with` p)+        f <- mock (any @Post ~> True) `expects` (called once `with` p)         liftIO $ f p `shouldBe` True      it "should work with expects and ANY" $ do       withMock $ do         let p = Post 1 "title"-        f <- mock (any @Post ~> True)-          `expects` (called once `with` any @Post)+        f <- mock (any @Post ~> True) `expects` (called once `with` any @Post)         liftIO $ f p `shouldBe` True    describe "withMock basic functionality" $ do     it "simple mock with expects" $ do       withMock $ do -        mockFn <- mock (any ~> True)-          `expects` (called once `with` "a")+        mockFn <- mock (any @String ~> True) `expects` (called once `with` "a")         liftIO $ mockFn "a" `shouldBe` True      it "simple mock with expects using param" $ do       withMock $ do -        mockFn <- mock (any ~> True)-          `expects` (called once `with` param "a")+        mockFn <- mock (any @String ~> True) `expects` (called once `with` param "a")         liftIO $ mockFn "a" `shouldBe` True      it "fails when not called" $ do       withMock (do -        _ <- mock (any ~> True)+        mock (any @String ~> True)           `expects` (called once `with` "a")         pure ()) `shouldThrow` anyErrorCall      it "error message when not called" $ do       result <- try $ withMock $ do -        _ <- mock (any ~> True)+        mock (any @String ~> True)           `expects` (called once `with` "a")         pure ()       case result of@@ -101,8 +98,7 @@      it "atLeast expectation" $ do       withMock $ do -        mockFn <- mock (any ~> True)-          `expects` (called (atLeast 2) `with` "a")+        mockFn <- mock (any @String ~> True) `expects` (called (atLeast 1) `with` "a")          void $ liftIO $ evaluate $ mockFn "a"         void $ liftIO $ evaluate $ mockFn "a"@@ -110,14 +106,14 @@      it "anything expectation" $ do       withMock $ do -        mockFn <- mock (any ~> True)-          `expects` called once+        mockFn <- mock (any @String ~> True)+        pure mockFn `expects` called once          void $ liftIO $ evaluate $ mockFn "a"      it "anything expectation error message when not called" $ do       result <- try $ withMock $ do -        _ <- mock (any @String ~> True)+        mock (any @String ~> True)           `expects` called once         pure ()       case result of@@ -135,35 +131,35 @@      it "never expectation without args succeeds when not called" $ do       withMock $ do -        _ <- mock (any @String ~> True)+        mock (any @String ~> True)           `expects` called never         pure ()      it "never expectation without args fails when called" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` called never+        pure mockFn `expects` called never         liftIO $ mockFn "a" `shouldBe` True         pure ()) `shouldThrow` anyErrorCall      it "never expectation with args succeeds when not called with that arg" $ do       withMock $ do          mockFn <- mock (any @String ~> True)-          `expects` (called never `with` "z")+        pure mockFn `expects` (called never `with` "z")         liftIO $ mockFn "a" `shouldBe` True         pure ()      it "never expectation with args fails when called with that arg" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` (called never `with` "z")+        pure mockFn `expects` (called never `with` "z")         liftIO $ mockFn "z" `shouldBe` True         pure ()) `shouldThrow` anyErrorCall      it "multiple expectations in do block" $ do       withMock $ do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called (times 2) `with` "a"             called once `with` "b"         liftIO $ mockFn "a" `shouldBe` True@@ -174,7 +170,7 @@     it "multiple expectations in do block fails when not all satisfied" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called (times 2) `with` "a"             called once `with` "b"         liftIO $ mockFn "a" `shouldBe` True@@ -185,7 +181,7 @@     it "multiple expectations in do block with never" $ do       withMock $ do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called once `with` "a"             called never `with` "z"         liftIO $ mockFn "a" `shouldBe` True@@ -194,7 +190,7 @@     it "multiple expectations in do block with never fails when violated" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called once `with` "a"             called never `with` "z"         liftIO $ mockFn "a" `shouldBe` True@@ -204,7 +200,7 @@     it "multiple expectations with different counts" $ do       withMock $ do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called (times 3) `with` "a"             called (atLeast 2) `with` "b"             called once `with` "c"@@ -219,7 +215,7 @@     it "multiple expectations fails when count is insufficient" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called (times 3) `with` "a"             called once `with` "b"         liftIO $ mockFn "a" `shouldBe` True@@ -231,7 +227,7 @@     it "multiple expectations fails when atLeast is not satisfied" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called (atLeast 2) `with` "a"             called once `with` "b"         liftIO $ mockFn "a" `shouldBe` True@@ -242,7 +238,7 @@     it "multiple expectations with mixed never and count" $ do       withMock $ do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called (times 2) `with` "a"             called never `with` "z"             called once `with` "b"@@ -254,7 +250,7 @@     it "multiple expectations with never fails when never is violated" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             called (times 2) `with` "a"             called never `with` "z"             called once `with` "b"@@ -267,8 +263,8 @@   describe "withMock verification failures" $ do     it "fails when called fewer times than expected" $ do       withMock (do -        mockFn <- mock (any ~> True)-          `expects` do+        mockFn <- mock (any @String ~> True)+        pure mockFn `expects` do             called (times 3) `with` "a"          liftIO $ evaluate $ mockFn "a"@@ -277,8 +273,8 @@      it "fails when called with unexpected arguments" $ do       withMock (do -        mockFn <- mock (any ~> True)-          `expects` do+        mockFn <- mock (any @String ~> True)+        pure mockFn `expects` do             called once `with` "a"          liftIO $ evaluate $ mockFn "b"@@ -286,8 +282,8 @@      it "fails when called but never expected" $ do       withMock (do -        mockFn <- mock (any ~> True)-          `expects` do+        mockFn <- mock (any @String ~> True)+        pure mockFn `expects` do             called never `with` "z"          liftIO $ evaluate $ mockFn "z"@@ -307,7 +303,7 @@     it "calledInOrder succeeds when called in correct order" $ do       withMock $ do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             calledInOrder ["a", "b", "c"]          liftIO $ mockFn "a" `shouldBe` True@@ -318,7 +314,7 @@     it "calledInOrder fails when called in wrong order" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             calledInOrder ["a", "b", "c"]          liftIO $ mockFn "a" `shouldBe` True@@ -329,7 +325,7 @@     it "calledInOrder fails when not all calls are made" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             calledInOrder ["a", "b", "c"]          liftIO $ mockFn "a" `shouldBe` True@@ -340,7 +336,7 @@     it "calledInSequence succeeds when sequence is followed" $ do       withMock $ do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             calledInSequence ["a", "c"]          liftIO $ mockFn "a" `shouldBe` True@@ -351,7 +347,7 @@     it "calledInSequence fails when sequence is violated" $ do       withMock (do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             calledInSequence ["a", "c"]          liftIO $ mockFn "c" `shouldBe` True  -- Wrong: "a" should come first@@ -361,7 +357,7 @@     it "calledInSequence succeeds with extra calls in between" $ do       withMock $ do          mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             calledInSequence ["a", "c"]          liftIO $ mockFn "a" `shouldBe` True@@ -374,11 +370,11 @@     it "can define multiple mocks in withMock" $ do       withMock $ do          fn1 <- mock (any @String ~> True)-          `expects` do+        pure fn1 `expects` do             called once `with` "a"           fn2 <- mock (any @String ~> any @String ~> False)-          `expects` do+        pure fn2 `expects` do             called once `with` ("x" ~> "y")          liftIO $ fn1 "a" `shouldBe` True@@ -389,14 +385,14 @@     it "mocks from different withMock blocks do not interfere" $ do       -- First withMock block: expect one call       withMock $ do -        fn1 <- mock (any ~> True)-          `expects` do+        fn1 <- mock (any @String ~> True)+        pure fn1 `expects` do             called once `with` "a"         liftIO $ evaluate $ fn1 "a"        -- Second withMock block: expect zero (if leaked, would see 1 and fail)       withMock $ do -        _ <- mock (any ~> True)+        mock (any @String ~> True)           `expects` do             called never `with` "a"         pure ()@@ -404,21 +400,21 @@     it "multiple sequential withMock blocks are independent" $ do       -- Block 1: call with "x"       withMock $ do-        fn1 <- mock (any ~> True)-          `expects` do+        fn1 <- mock (any @String ~> True)+        pure fn1 `expects` do             called once `with` "x"         liftIO $ evaluate $ fn1 "x"        -- Block 2: call with "y"       withMock $ do-        fn2 <- mock (any ~> True)-          `expects` do+        fn2 <- mock (any @String ~> True)+        pure fn2 `expects` do             called once `with` "y"         liftIO $ evaluate $ fn2 "y"        -- Block 3: no calls       withMock $ do-        _ <- mock (any ~> True)+        mock (any ~> True)           `expects` do             called never `with` "z"         pure ()@@ -427,7 +423,7 @@     it "counts calls across parallel threads" $ do       withMock $ do         mockFn <- mock (any ~> True)-          `expects` do+        pure mockFn `expects` do             called (times 10)          withRunInIO $ \runInIO -> do@@ -440,7 +436,7 @@     it "handles concurrent calls with different arguments" $ do       withMock $ do         mockFn <- mock (any ~> True)-          `expects` do+        pure mockFn `expects` do             called (times 5) `with` "a"             called (times 5) `with` "b" @@ -458,7 +454,7 @@        withMock $ do         mockFn <- mock (any ~> True)-          `expects` do+        pure mockFn `expects` do             called (times total)          withRunInIO $ \runInIO -> do@@ -473,7 +469,7 @@     it "concurrent calls preserve order expectations" $ do       withMock $ do         mockFn <- mock (any @String ~> True)-          `expects` do+        pure mockFn `expects` do             calledInOrder ["first", "second", "third"]          withRunInIO $ \runInIO -> do