mockcat 1.1.0.0 → 1.2.0.0

raw patch · 40 files changed

+1376/−943 lines, 40 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README-ja.md +32/−19
• README.md +32/−19
• mockcat.cabal +4/−1
• src/Test/MockCat/Internal/Builder.hs +5/−0
• src/Test/MockCat/Internal/Message.hs +69/−22
• src/Test/MockCat/Internal/Types.hs +51/−4
• src/Test/MockCat/Internal/Verify.hs +235/−0
• src/Test/MockCat/Mock.hs +92/−10
• src/Test/MockCat/MockT.hs +1/−2
• src/Test/MockCat/Param.hs +21/−1
• src/Test/MockCat/TH/FunctionBuilder.hs +232/−131
• src/Test/MockCat/TH/TypeUtils.hs +37/−11
• src/Test/MockCat/Verify.hs +38/−259
• src/Test/MockCat/WithMock.hs +20/−112
• test/Property/ConcurrentCountProp.hs +2/−1
• test/Property/LazyEvalProp.hs +3/−2
• test/Property/ReinforcementProps.hs +2/−1
• test/ReadmeVerifySpec.hs +2/−0
• test/Spec.hs +4/−0
• test/Test/MockCat/ConcurrencySpec.hs +5/−4
• test/Test/MockCat/DeferredTypeErrorsSpec.hs +40/−0
• test/Test/MockCat/ExampleSpec.hs +4/−0
• test/Test/MockCat/HPCFallbackSpec.hs +1/−2
• test/Test/MockCat/MockTSpec.hs +0/−1
• test/Test/MockCat/MultipleMocksSpec.hs +55/−0
• test/Test/MockCat/ParamSpec.hs +0/−1
• test/Test/MockCat/PartialMockCommonSpec.hs +11/−26
• test/Test/MockCat/PartialMockSpec.hs +26/−29
• test/Test/MockCat/PartialMockTHSpec.hs +0/−1
• test/Test/MockCat/SharedSpecDefs.hs +0/−3
• test/Test/MockCat/ShouldBeCalledErrorDiffSpec.hs +93/−57
• test/Test/MockCat/ShouldBeCalledSpec.hs +0/−1
• test/Test/MockCat/TH/FunctionBuilderSpec.hs +2/−23
• test/Test/MockCat/THCompareSpec.hs +12/−1
• test/Test/MockCat/TypeClassCommonSpec.hs +24/−23
• test/Test/MockCat/TypeClassSpec.hs +62/−66
• test/Test/MockCat/TypeClassTHSpec.hs +1/−0
• test/Test/MockCat/WithMockErrorDiffSpec.hs +110/−71
• test/Test/MockCat/WithMockSpec.hs +39/−39

@@ -6,6 +6,15 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.2.0.0] - 2025-12-31+### Changed+- **Breaking Change**: Changed the fixity of `expects` operator to `infixl 0` to resolve precedence issues with `$`.+    - **Impact**: Code using `mock $ ... expects ...` will now fail to compile.+    - **Migration**: Wrap the mock definition in parentheses: `mock (... ~> ...) expects ...`.+- **Breaking Change**: `expects` now strictly enforces that it can only be applied to a mock creation action (`m fn`).+    - Attempting to apply `expects` directly to a `MockSpec` (e.g. `(any ~> 1) expects ...`) or an already instantiated function will result in a compile-time `TypeError`.+- Removed redundant `Typeable` constraints from `expects`, enabling cleaner builds on GHC 9.8+.+ ## [1.1.0.0] - 2025-12-29 ### Added - **HPC Coverage Support**: Verification logic now robustly handles unstable `StableNames` caused by HPC instrumentation (`stack test --coverage`).

@@ -18,7 +18,7 @@  ```haskell -- 定義 (Define)-f <- mock $ "input" ~> "output"+f <- mock ("input" ~> "output")  -- 検証 (Verify) f `shouldBeCalled` "input"@@ -60,8 +60,8 @@  | | **Before: 手書き...** 😫 | **After: Mockcat** 🐱✨ | | :--- | :--- | :--- |-| **定義 (Stub)**<br />「この引数には<br />この値を返したい」 | <pre>f :: String -> IO String<br />f arg = case arg of<br />  "a" -> pure "b"<br />  _   -> error "unexpected"</pre><br />_単純な分岐を書くだけでも行数を消費します。_ | <pre>-- 検証不要なら stub (純粋)<br />let f = stub $<br />  "a" ~> "b"</pre><br />_完全な純粋関数として振る舞います。_ |-| **検証 (Verify)**<br />「正しく呼ばれたか<br />テストしたい」 | <pre>-- 記録の仕組みから作る必要がある<br />ref <- newIORef []<br />let f arg = do<br />      modifyIORef ref (arg:)<br />      ...<br /><br />-- 検証ロジック<br />calls <- readIORef ref<br />calls `shouldBe` ["a"]</pre><br />_※ これはよくある一例です。実際にはさらに補助コードが増えがちです。_ | <pre>-- 検証したいなら mock (内部で記録)<br />f <- mock $ "a" ~> "b"<br /><br />-- 検証したい内容を書くだけ<br />f `shouldBeCalled` "a"</pre><br />_記録は自動。<br />「何を検証するか」という本質に集中できます。_ |+| **定義 (Stub)**<br />「この引数には<br />この値を返したい」 | <pre>f :: String -> IO String<br />f arg = case arg of<br />  "a" -> pure "b"<br />  _   -> error "unexpected"</pre><br />_単純な分岐を書くだけでも行数を消費します。_ | <pre>-- 検証不要なら stub (純粋)<br />let f = stub ("a" ~> "b")</pre><br />_完全な純粋関数として振る舞います。_ |+| **検証 (Verify)**<br />「正しく呼ばれたか<br />テストしたい」 | <pre>-- 記録の仕組みから作る必要がある<br />ref <- newIORef []<br />let f arg = do<br />      modifyIORef ref (arg:)<br />      ...<br /><br />-- 検証ロジック<br />calls <- readIORef ref<br />calls `shouldBe` ["a"]</pre><br />_※ これはよくある一例です。実際にはさらに補助コードが増えがちです。_ | <pre>-- 検証したいなら mock (内部で記録)<br />f <- mock ("a" ~> "b")<br /><br />-- 検証したい内容を書くだけ<br />f `shouldBeCalled` "a"</pre><br />_記録は自動。<br />「何を検証するか」という本質に集中できます。_ |  ### 主な特徴 @@ -70,10 +70,16 @@ *   **値ではなく「条件」で検証**: 引数が `Eq` インスタンスを持っていなくても問題ありません。値の一致だけでなく、「どのような性質を満たすべきか」という条件 (Predicate) で検証できます。 *   **圧倒的に親切なエラー**: テスト失敗時、どこが違うのかを「構造差分」で表示します。     ```text-    Expected arguments were not called.-      expected: [Record { name = "Alice", age = 20 }]-       but got: [Record { name = "Alice", age = 21 }]-                                                ^^+    function was not called with the expected arguments.++      Closest match:+        expected: Record { name = "Alice", age = 20 }+         but got: Record { name = "Alice", age = 21 }+                                             ^^^+      Specific difference in `age`:+        expected: 20+         but got: 21+                  ^^     ``` *   **意図を導く型設計**: 型はあなたの記述を縛るものではなく、テストの意図（何を期待しているか）を自然に表現させるために存在します。 @@ -113,7 +119,7 @@ spec = do   it "Quick Start Demo" do     -- 1. モックを作成 ("Hello" を受け取ったら 42 を返す)-    f <- mock $ "Hello" ~> (42 :: Int)+    f <- mock ("Hello" ~> (42 :: Int))      -- 2. 関数として使う     let result = f "Hello"@@ -128,9 +134,9 @@ ### At a Glance: Matchers | Matcher | Description | Example | | :--- | :--- | :--- |-| **`any`** | どんな値でも許可 | `f <- mock $ any ~> True` |-| **`expect`** | 条件(述語)で検証 | `f <- mock $ expect (> 5) "gt 5" ~> True` |-| **`"val"`** | 値の一致 (Eq) | `f <- mock $ "val" ~> True` |+| **`any`** | どんな値でも許可 | `f <- mock (any ~> True)` |+| **`expect`** | 条件(述語)で検証 | `f <- mock (expect (> 5) "gt 5" ~> True)` |+| **`"val"`** | 値の一致 (Eq) | `f <- mock ("val" ~> True)` | | **`inOrder`** | 順序検証 | ``f `shouldBeCalled` inOrderWith ["a", "b"]`` | | **`inPartial`**| 部分順序 | ``f `shouldBeCalled` inPartialOrderWith ["a", "c"]`` | @@ -151,7 +157,7 @@  ```haskell -- "a" -> "b" -> True を返す関数-f <- mock $ "a" ~> "b" ~> True+f <- mock ("a" ~> "b" ~> True) ```  **柔軟なマッチング**:@@ -159,10 +165,10 @@  ```haskell -- 任意の文字列 (param any)-f <- mock $ any ~> True+f <- mock (any ~> True)  -- 条件式 (expect)-f <- mock $ expect (> 5) "> 5" ~> True+f <- mock (expect (> 5) "> 5" ~> True) ```  ### 2. 型クラスのモック (`makeMock`)@@ -228,6 +234,13 @@   f "arg" ``` +> [!IMPORTANT]+> `expects`（宣言的検証）を使用する場合、モック定義部分は必ず **括弧 `(...)`** で囲んでください。+> 以前のバージョンで使用できた `$` 演算子 (`mock $ ... expected ...`) は、優先順位の関係でコンパイルエラーになります。+>+> ❌ `mock $ any ~> True expects ...`+> ✅ `mock (any ~> True) expects ...`+ > [!NOTE] > `runMockT` ブロックの中でも、同様に `expects` を使った宣言的検証が可能です。 > つまり、「モック生成」と「期待値宣言」が１つのブロック内で完結する統一された体験を提供します。@@ -241,7 +254,7 @@  ```haskell -- どんな引数で呼ばれても True を返す-f <- mock $ any ~> True+f <- mock (any ~> True)  -- 何でもいいから呼ばれたことを検証 f `shouldBeCalled` any@@ -254,7 +267,7 @@  ```haskell -- 引数が "error" で始まる場合のみ False を返す-f <- mock $ do+f <- mock do   onCase $ expect (\s -> "error" `isPrefixOf` s) "start with error" ~> False   onCase $ any ~> True ```@@ -299,7 +312,7 @@ `IO` を返す関数で、呼び出しごとに副作用（結果）を変えたい場合に使います。  ```haskell-f <- mock $ do+f <- mock do   onCase $ "get" ~> pure @IO 1 -- 1回目   onCase $ "get" ~> pure @IO 2 -- 2回目 ```@@ -309,7 +322,7 @@ エラーメッセージに関数名を表示させたい場合は、ラベルを付けられます。  ```haskell-f <- mock (label "myAPI") $ "arg" ~> True+f <- mock (label "myAPI") ("arg" ~> True) ```  ---@@ -399,7 +412,7 @@ その場合は明示的に型注釈を付けてください。  ```haskell-mock $ ("value" :: String) ~> True+mock (("value" :: String) ~> True) ```  ---

@@ -18,7 +18,7 @@  ```haskell -- Define-f <- mock $ "input" ~> "output"+f <- mock ("input" ~> "output")  -- Verify f `shouldBeCalled` "input"@@ -60,8 +60,8 @@  | | **Before: Handwritten...** 😫 | **After: Mockcat** 🐱✨ | | :--- | :--- | :--- |-| **Definition (Stub)**<br />"I want to return<br />this value for this arg" | <pre>f :: String -> IO String<br />f arg = case arg of<br />  "a" -> pure "b"<br />  _   -> error "unexpected"</pre><br />_Even simple branching consumes many lines._ | <pre>-- Use stub if verification is unneeded (Pure)<br />let f = stub $<br />  "a" ~> "b"</pre><br />_Behaves as a completely pure function._ |-| **Verification (Verify)**<br />"I want to test<br />if it was called correctly" | <pre>-- Need to implement recording logic<br />ref <- newIORef []<br />let f arg = do<br />      modifyIORef ref (arg:)<br />      ...<br /><br />-- Verification logic<br />calls <- readIORef ref<br />calls `shouldBe` ["a"]</pre><br />_※ This is just one example. Real-world setups often require even more boilerplate._ | <pre>-- Use mock if verification is needed (Recorded internally)<br />f <- mock $ "a" ~> "b"<br /><br />-- Just state what you want to verify<br />f `shouldBeCalled` "a"</pre><br />_Recording is automatic.<br />Focus on the "Why" and "What", not the "How"._ |+| **Definition (Stub)**<br />"I want to return<br />this value for this arg" | <pre>f :: String -> IO String<br />f arg = case arg of<br />  "a" -> pure "b"<br />  _   -> error "unexpected"</pre><br />_Even simple branching consumes many lines._ | <pre>-- Use stub if verification is unneeded (Pure)<br />let f = stub ("a" ~> "b")</pre><br />_Behaves as a completely pure function._ |+| **Verification (Verify)**<br />"I want to test<br />if it was called correctly" | <pre>-- Need to implement recording logic<br />ref <- newIORef []<br />let f arg = do<br />      modifyIORef ref (arg:)<br />      ...<br /><br />-- Verification logic<br />calls <- readIORef ref<br />calls `shouldBe` ["a"]</pre><br />_※ This is just one example. Real-world setups often require even more boilerplate._ | <pre>-- Use mock if verification is needed (Recorded internally)<br />f <- mock ("a" ~> "b")<br /><br />-- Just state what you want to verify<br />f `shouldBeCalled` "a"</pre><br />_Recording is automatic.<br />Focus on the "Why" and "What", not the "How"._ |  ### Key Features @@ -70,10 +70,16 @@ *   **Verify by "Condition", not just Value**: Works even if arguments lack `Eq` instances. You can verify based on "what properties it should satisfy" (Predicates) rather than just strict equality. *   **Helpful Error Messages**: Shows "structural diffs" on failure, highlighting exactly what didn't match.     ```text-    Expected arguments were not called.-      expected: [Record { name = "Alice", age = 20 }]-       but got: [Record { name = "Alice", age = 21 }]-                                                ^^+    function was not called with the expected arguments.++      Closest match:+        expected: Record { name = "Alice", age = 20 }+         but got: Record { name = "Alice", age = 21 }+                                             ^^^+      Specific difference in `age`:+        expected: 20+         but got: 21+                  ^^     ``` *   **Intent-Driven Types**: Types exist not to restrict you, but to naturally guide you in expressing your testing intent. @@ -113,7 +119,7 @@ spec = do   it "Quick Start Demo" do     -- 1. Create a mock (Return 42 when receiving "Hello")-    f <- mock $ "Hello" ~> (42 :: Int)+    f <- mock ("Hello" ~> (42 :: Int))      -- 2. Use it as a function     let result = f "Hello"@@ -128,9 +134,9 @@ ### At a Glance: Matchers | Matcher | Description | Example | | :--- | :--- | :--- |-| **`any`** | Matches any value | `f <- mock $ any ~> True` |-| **`expect`** | Matches condition | `f <- mock $ expect (> 5) "gt 5" ~> True` |-| **`"val"`** | Matches value (Eq) | `f <- mock $ "val" ~> True` |+| **`any`** | Matches any value | `f <- mock (any ~> True)` |+| **`expect`** | Matches condition | `f <- mock (expect (> 5) "gt 5" ~> True)` |+| **`"val"`** | Matches value (Eq) | `f <- mock ("val" ~> True)` | | **`inOrder`** | Order verification | ``f `shouldBeCalled` inOrderWith ["a", "b"]`` | | **`inPartial`**| Partial order | ``f `shouldBeCalled` inPartialOrderWith ["a", "c"]`` | @@ -153,7 +159,7 @@  ```haskell -- Function that returns True for "a" -> "b"-f <- mock $ "a" ~> "b" ~> True+f <- mock ("a" ~> "b" ~> True) ```  **Flexible Matching**:@@ -161,10 +167,10 @@  ```haskell -- Arbitrary string (param any)-f <- mock $ any ~> True+f <- mock (any ~> True)  -- Condition (expect)-f <- mock $ expect (> 5) "> 5" ~> True+f <- mock (expect (> 5) "> 5" ~> True) ```  ### 2. Typeclass Mocking (`makeMock`)@@ -230,6 +236,13 @@   f "arg" ``` +> [!IMPORTANT]+> When using `expects` (declarative verification), you MUST wrap the mock definition in **parentheses `(...)`**.+> The `$` operator pattern used in previous versions (`mock $ ... expected ...`) will cause compilation errors due to precedence changes.+>+> ❌ `mock $ any ~> True expects ...`+> ✅ `mock (any ~> True) expects ...`+ > [!NOTE] > You can also use `expects` for declarative verification inside `runMockT` blocks. > This provides a unified experience where "Mock Creation" and "Expectation Declaration" complete within a single block.@@ -243,7 +256,7 @@  ```haskell -- Return True regardless of the argument-f <- mock $ any ~> True+f <- mock (any ~> True)  -- Verify that it was called (arguments don't matter) f `shouldBeCalled` any@@ -256,7 +269,7 @@  ```haskell -- Return False only if the argument starts with "error"-f <- mock $ do+f <- mock do   onCase $ expect (\s -> "error" `isPrefixOf` s) "start with error" ~> False   onCase $ any ~> True ```@@ -301,7 +314,7 @@ Used when you want a function returning `IO` to have different side effects (results) for each call.  ```haskell-f <- mock $ do+f <- mock do   onCase $ "get" ~> pure @IO 1 -- 1st call   onCase $ "get" ~> pure @IO 2 -- 2nd call ```@@ -311,7 +324,7 @@ You can attach labels to display function names in error messages.  ```haskell-f <- mock (label "myAPI") $ "arg" ~> True+f <- mock (label "myAPI") ("arg" ~> True) ```  ---@@ -401,7 +414,7 @@ Add explicit type annotations to resolve this.  ```haskell-mock $ ("value" :: String) ~> True+mock (("value" :: String) ~> True) ```  ---

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           mockcat-version:        1.1.0.0+version:        1.2.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.@@ -46,6 +46,7 @@       Test.MockCat.Internal.MockRegistry       Test.MockCat.Internal.Registry.Core       Test.MockCat.Internal.Types+      Test.MockCat.Internal.Verify       Test.MockCat.Mock       Test.MockCat.MockT       Test.MockCat.Param@@ -94,6 +95,7 @@       Test.MockCat.AssociationListSpec       Test.MockCat.ConcurrencySpec       Test.MockCat.ConsSpec+      Test.MockCat.DeferredTypeErrorsSpec       Test.MockCat.ExampleSpec       Test.MockCat.HPCFallbackSpec       Test.MockCat.HPCNestSpec@@ -101,6 +103,7 @@       Test.MockCat.Internal.MockRegistrySpec       Test.MockCat.MockSpec       Test.MockCat.MockTSpec+      Test.MockCat.MultipleMocksSpec       Test.MockCat.ParamSpec       Test.MockCat.PartialMockCommonSpec       Test.MockCat.PartialMockSpec

@@ -35,6 +35,7 @@ import Test.MockCat.Internal.Types import Test.MockCat.Internal.Message + -- | Class for building a curried function. -- The purpose of this class is to automatically generate and provide -- an implementation for the corresponding curried function type (such as `a -> b -> ... -> IO r`)@@ -150,6 +151,8 @@         recorder = InvocationRecorder ref PureConstant     pure (BuiltMock fn recorder) ++ -- | Instance for building a stub for a value (backward compatibility). instance   MockBuilder (Param r) r ()@@ -219,6 +222,8 @@   ) => MockIOBuilder (Param a :> rest) fn args where   buildIO name params =     buildWithRecorderIO (\ref inputParams -> executeInvocation ref (singleInvocationStep name params inputParams))++   buildWithRecorder ::

@@ -92,28 +92,7 @@               "  expected: " <> expectedStr,               "  but the function was never called"             ]-        _ ->-          let actualStr = formatInvocationList invocationList-              diffLine = "            " <> diffPointer expectedStr actualStr-           in case structuralDiff expectedStr actualStr of-                [] ->-                  intercalate "\n"-                    [ mainMessage,-                      "  expected: " <> expectedStr,-                      "   but got: " <> actualStr,-                      diffLine-                    ]-                ds ->-                  let diffMessages = formatDifferences ds-                   in intercalate "\n"-                        [ mainMessage,-                          diffMessages,-                          "",-                          "Full context:",-                          "  expected: " <> expectedStr,-                          "   but got: " <> actualStr,-                          diffLine-                        ]+        _ -> countWithArgsMismatchMessageWithDiff name expected invocationList  data Difference = Difference   { diffPath :: String,@@ -231,6 +210,74 @@   let commonPrefixLen s1 s2 = length $ takeWhile id $ zipWith (==) s1 s2       scores = map (\e -> (commonPrefixLen actual e, e)) expectations    in snd $ maximumBy (comparing fst) scores++countWithArgsMismatchMessageWithDiff :: Show a => Maybe MockName -> a -> [a] -> String+countWithArgsMismatchMessageWithDiff mockName expected actuals =+  let expectedStr = formatStr (show expected)+      actualStrs = map (formatStr . show) actuals+      (nearest, nearestIdx) = chooseNearestWithIndex expectedStr actualStrs+      diffLine = "              " <> diffPointer expectedStr nearest++      header = "function" <> mockNameLabel mockName <> " was not called with the expected arguments."++      closestMatchSection =+        intercalate "\n"+          [ "  Closest match:"+          , "    expected: " <> expectedStr+          , "     but got: " <> nearest+          , diffLine+          ]++      diffs = case structuralDiff expectedStr nearest of+        [] -> ""+        ds -> formatDifferences ds++      historySection = formatCallHistory actualStrs nearestIdx+   in intercalate "\n" $+        [ header+        , ""+        , closestMatchSection+        ]+        ++ (if null diffs then [] else [diffs])+        +++        [ ""+        , historySection+        ]++chooseNearestWithIndex :: String -> [String] -> (String, Int)+chooseNearestWithIndex _ [] = ("", -1)+chooseNearestWithIndex pivot candidates =+  let commonPrefixLen s1 s2 = length $ takeWhile id $ zipWith (==) s1 s2+      scores = zipWith (\idx c -> (commonPrefixLen pivot c, c, idx)) [0..] candidates+      (_, bestStr, bestIdx) = maximumBy (comparing (\(score, _, _) -> score)) scores+   in (bestStr, bestIdx)++formatCallHistory :: [String] -> Int -> String+formatCallHistory actuals nearestIdx =+  let count = length actuals+      limit = 5+      (shown, hidden) = splitAt limit actuals+      +      formatItem idx s =+        let num = idx + 1+            prefix = if idx == nearestIdx then "    [Closest] " else "              "+            -- number alignment: "1. " vs "10. "+            numStr = show num <> "."+            paddedNum = if num < 10 then numStr <> " " else numStr+         in prefix <> paddedNum <> s++      items = zipWith formatItem [0..] shown+      +      moreMessage = +        if null hidden +          then [] +          else ["              ... (" <> show (length hidden) <> " more calls)"]++   in intercalate "\n"+        ( [ "  Call history (" <> show count <> " calls):" ]+          ++ items+          ++ moreMessage+        )   isRecord :: String -> Bool

@@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -Wno-missing-export-lists #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use null" #-}@@ -11,12 +13,15 @@  import Control.Monad (ap) import Control.Concurrent.STM (TVar)-import Data.Maybe+import Data.Maybe (listToMaybe) import GHC.IO (unsafePerformIO) import Test.MockCat.AssociationList (AssociationList) import Prelude hiding (lookup)-import Control.Monad.State ( State )+import Control.Monad.State ( State, MonadState, execState, modify )+import Control.Monad.Reader (MonadReader, ask) +type MockName = String+ data InvocationRecorder params = InvocationRecorder   { invocationRef :: TVar (InvocationRecord params)   , functionNature :: FunctionNature@@ -28,6 +33,11 @@   , builtMockRecorder :: InvocationRecorder params   } +data ResolvedMock params = ResolvedMock {+  resolvedMockName :: Maybe MockName,+  resolvedMockRecorder :: InvocationRecorder params+}+ data FunctionNature   = PureConstant   | IOConstant@@ -49,6 +59,7 @@   | GreaterThanEqual Int   | LessThan Int   | GreaterThan Int+  deriving (Eq)  instance Show CountVerifyMethod where   show (Equal e) = show e@@ -77,6 +88,7 @@ data VerifyOrderMethod   = ExactlySequence   | PartiallySequence+  deriving (Show, Eq)  data VerifyOrderResult a = VerifyOrderResult   { index :: Int,@@ -88,8 +100,6 @@  data VerifyMatchType a = MatchAny a | MatchAll a -type MockName = String- safeIndex :: [a] -> Int -> Maybe a safeIndex xs n   | n < 0 = Nothing@@ -98,3 +108,40 @@ {-# NOINLINE perform #-} perform :: IO a -> a perform = unsafePerformIO++-- | Mock expectation context holds verification actions to run at the end+--   of the `withMock` block. Storing `IO ()` avoids forcing concrete param+--   types at registration time.+newtype WithMockContext = WithMockContext (TVar [IO ()])++class MonadWithMockContext m where+  askWithMockContext :: m WithMockContext++instance {-# OVERLAPPABLE #-} (MonadReader WithMockContext m) => MonadWithMockContext m where+  askWithMockContext = ask++-- | Expectation specification+data Expectation params where+  -- | Count expectation with specific arguments+  CountExpectation :: CountVerifyMethod -> params -> Expectation params+  -- | Count expectation without arguments (any arguments)+  CountAnyExpectation :: CountVerifyMethod -> Expectation params+  -- | Order expectation+  OrderExpectation :: VerifyOrderMethod -> [params] -> Expectation params+  -- | Simple expectation (at least once) with arguments+  SimpleExpectation :: params -> Expectation params+  -- | Simple expectation (at least once) without arguments+  AnyExpectation :: Expectation params+  deriving (Show, Eq)++-- | Expectations builder (Monad instance for do syntax)+newtype Expectations params a = Expectations (State [Expectation params] a)+  deriving (Functor, Applicative, Monad, MonadState [Expectation params])++-- | Run the Expectations monad to get a list of Expectation+runExpectations :: Expectations params () -> [Expectation params]+runExpectations (Expectations s) = execState s []++-- | Add an expectation to the list+addExpectation :: Expectation params -> Expectations params ()+addExpectation e = modify (++ [e])

@@ -0,0 +1,235 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-}++module Test.MockCat.Internal.Verify where++import Control.Concurrent.STM (readTVarIO, TVar)+import Control.Monad (guard, when)+import Data.List (intercalate, elemIndex)+import Data.Maybe (catMaybes, isNothing)+import Test.MockCat.Internal.Types+import Test.MockCat.Internal.Message++import Prelude hiding (lookup)++-- | Verify an expectation directly against a resolved mock.+--   This is used by 'mock' when expectations are provided.+verifyExpectationDirect :: (Eq params, Show params) => ResolvedMock params -> Expectation params -> IO ()+verifyExpectationDirect resolved (CountExpectation method args) =+  verifyResolvedCount resolved args method+verifyExpectationDirect resolved (CountAnyExpectation method) =+  verifyResolvedCallCount resolved method+verifyExpectationDirect resolved (OrderExpectation method matchers) =+  verifyResolvedOrder method resolved matchers+verifyExpectationDirect resolved (SimpleExpectation args) =+  verifyResolvedMatch resolved (MatchAny args)+verifyExpectationDirect resolved AnyExpectation =+  verifyResolvedAny resolved++-- | Verify that a resolved mock function was called at least once.+verifyResolvedAny :: ResolvedMock params -> IO ()+verifyResolvedAny (ResolvedMock mockName recorder) = do+  invocationList <- readInvocationList (invocationRef recorder)+  when (null invocationList) $+    errorWithoutStackTrace $+      intercalate+        "\n"+        [ "Function" <> mockNameLabel mockName <> " was never called"+        ]++-- | Verify that mock was called with specific arguments using resolved mock directly.+verifyResolvedMatch :: (Eq params, Show params) => ResolvedMock params -> VerifyMatchType params -> IO ()+verifyResolvedMatch (ResolvedMock mockName recorder) matchType = do+  invocationList <- readInvocationList (invocationRef recorder)+  case doVerify mockName invocationList matchType of+    Nothing -> pure ()+    Just (VerifyFailed msg) ->+      errorWithoutStackTrace msg `seq` pure ()++-- | Verify call count with specific arguments using resolved mock directly.+verifyResolvedCount :: (Eq params, Show params) => ResolvedMock params -> params -> CountVerifyMethod -> IO ()+verifyResolvedCount (ResolvedMock mockName recorder) v method = do+  invocationList <- readInvocationList (invocationRef recorder)+  let callCount = length (filter (v ==) invocationList)+  if compareCount method callCount+    then pure ()+    else+      errorWithoutStackTrace $+        -- If we expected some calls (e.g. atLeast 1) but got 0, and there were OTHER calls,+        -- show the closest match diff to help debugging.+        if callCount == 0 && not (null invocationList)+           && expectsPositive method+          then countWithArgsMismatchMessageWithDiff mockName v invocationList+          else countWithArgsMismatchMessage mockName method callCount++expectsPositive :: CountVerifyMethod -> Bool+expectsPositive (Equal n) = n > 0+expectsPositive (GreaterThanEqual n) = n > 0+expectsPositive (GreaterThan _) = True+expectsPositive (LessThan _) = False -- usually "less than 2" allows 0, so 0 is valid.+expectsPositive (LessThanEqual _) = False -- "at most N" allows 0.++-- | Verify overall call count (ignoring arguments)+verifyResolvedCallCount :: ResolvedMock params -> CountVerifyMethod -> IO ()+verifyResolvedCallCount (ResolvedMock mockName recorder) method =+  verifyCallCount mockName recorder method++-- | Verify call order using resolved mock directly.+verifyResolvedOrder :: (Eq params, Show params) => VerifyOrderMethod -> ResolvedMock params -> [params] -> IO ()+verifyResolvedOrder method (ResolvedMock mockName recorder) matchers = do+  invocationList <- readInvocationList (invocationRef recorder)+  case doVerifyOrder method mockName invocationList matchers of+    Nothing -> pure ()+    Just (VerifyFailed msg) ->+      errorWithoutStackTrace msg `seq` pure ()++-- | Internal helper to read invocation list+readInvocationList :: TVar (InvocationRecord params) -> IO (InvocationList params)+readInvocationList ref = do+  record <- readTVarIO ref+  pure $ invocations record++-- | Helper to verify call count (low level)+verifyCallCount ::+  Maybe MockName ->+  InvocationRecorder params ->+  CountVerifyMethod ->+  IO ()+verifyCallCount maybeName recorder method = do+  result <- tryVerifyCallCount maybeName recorder method+  case result of+    Nothing -> pure ()+    Just msg -> errorWithoutStackTrace msg++tryVerifyCallCount ::+  Maybe MockName ->+  InvocationRecorder params ->+  CountVerifyMethod ->+  IO (Maybe String)+tryVerifyCallCount maybeName recorder method = do+  invocationList <- readInvocationList (invocationRef recorder)+  let callCount = length invocationList+  if compareCount method callCount+    then pure Nothing+    else pure $ Just $ countMismatchMessage maybeName method callCount++compareCount :: CountVerifyMethod -> Int -> Bool+compareCount (Equal e) a = a == e+compareCount (LessThanEqual e) a = a <= e+compareCount (LessThan e) a = a < e+compareCount (GreaterThanEqual e) a = a >= e+compareCount (GreaterThan e) a = a > e++countWithArgsMismatchMessage :: Maybe MockName -> CountVerifyMethod -> Int -> String+countWithArgsMismatchMessage mockName method callCount =+  intercalate+    "\n"+    [ "function" <> mockNameLabel mockName <> " was not called the expected number of times with the expected arguments.",+      "  expected: " <> show method,+      "   but got: " <> show callCount+    ]++countMismatchMessage :: Maybe MockName -> CountVerifyMethod -> Int -> String+countMismatchMessage maybeName method callCount =+  intercalate+    "\n"+    [ "function" <> mockNameLabel maybeName <> " was not called the expected number of times.",+      "  expected: " <> showCountMethod method,+      "   but got: " <> show callCount+    ]+  where+    showCountMethod (Equal n) = show n+    showCountMethod (LessThanEqual n) = "<= " <> show n+    showCountMethod (GreaterThanEqual n) = ">= " <> show n+    showCountMethod (LessThan n) = "< " <> show n+    showCountMethod (GreaterThan n) = "> " <> show n++doVerify :: (Eq a, Show a) => Maybe MockName -> InvocationList a -> VerifyMatchType a -> Maybe VerifyFailed+doVerify name list (MatchAny a) = do+  guard $ notElem a list+  pure $ verifyFailedMessage name list a+doVerify name list (MatchAll a) = do+  guard $ Prelude.any (a /=) list+  pure $ verifyFailedMessage name list a++doVerifyOrder ::+  (Eq a, Show a) =>+  VerifyOrderMethod ->+  Maybe MockName ->+  InvocationList a ->+  [a] ->+  Maybe VerifyFailed+doVerifyOrder ExactlySequence name calledValues expectedValues+  | length calledValues /= length expectedValues = do+      pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues+  | otherwise = do+      let unexpectedOrders = collectUnExpectedOrder calledValues expectedValues+      guard $ length unexpectedOrders > 0+      pure $ verifyFailedSequence name unexpectedOrders+doVerifyOrder PartiallySequence name calledValues expectedValues+  | length calledValues < length expectedValues = do+      pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues+  | otherwise = do+      guard $ isOrderNotMatched calledValues expectedValues+      pure $ verifyFailedPartiallySequence name calledValues expectedValues++verifyFailedPartiallySequence :: Show a => Maybe MockName -> InvocationList a -> [a] -> VerifyFailed+verifyFailedPartiallySequence name calledValues expectedValues =+  VerifyFailed $+    intercalate+      "\n"+      [ "function" <> mockNameLabel name <> " was not called with the expected arguments in the expected order.",+        "  expected order:",+        intercalate "\n" $ ("    " <>) . show <$> expectedValues,+        "  but got:",+        intercalate "\n" $ ("    " <>) . show <$> calledValues+      ]++isOrderNotMatched :: Eq a => InvocationList a -> [a] -> Bool+isOrderNotMatched calledValues expectedValues =+  isNothing $+    foldl+      ( \candidates e -> do+          candidates >>= \c -> do+            index <- elemIndex e c+            Just $ drop (index + 1) c+      )+      (Just calledValues)+      expectedValues++verifyFailedOrderParamCountMismatch :: Maybe MockName -> InvocationList a -> [a] -> VerifyFailed+verifyFailedOrderParamCountMismatch name calledValues expectedValues =+  VerifyFailed $+    intercalate+      "\n"+      [ "function" <> mockNameLabel name <> " was not called with the expected arguments in the expected order (count mismatch).",+        "  expected: " <> show (length expectedValues),+        "   but got: " <> show (length calledValues)+      ]++verifyFailedSequence :: Show a => Maybe MockName -> [VerifyOrderResult a] -> VerifyFailed+verifyFailedSequence name fails =+  VerifyFailed $+    intercalate+      "\n"+      ( ("function" <> mockNameLabel name <> " was not called with the expected arguments in the expected order.") : (verifyOrderFailedMesssage <$> fails)+      )++collectUnExpectedOrder :: Eq a => InvocationList a -> [a] -> [VerifyOrderResult a]+collectUnExpectedOrder calledValues expectedValues =+  catMaybes $+    mapWithIndex+      ( \i expectedValue -> do+          let calledValue = calledValues !! i+          guard $ expectedValue /= calledValue+          pure VerifyOrderResult {index = i, calledValue = calledValue, expectedValue}+      )+      expectedValues++mapWithIndex :: (Int -> a -> b) -> [a] -> [b]+mapWithIndex f xs = [f i x | (i, x) <- zip [0 ..] xs]

@@ -1,4 +1,7 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE TypeFamilies #-}@@ -23,6 +26,7 @@   , mock   , mockM   , createNamedMockFnWithParams+  , CreateMockFn(..)   , stub   , shouldBeCalled   , times@@ -44,21 +48,26 @@   , casesIO   , label   , Label+  , MockDispatch(..)+  , IsMockSpec   ) where  import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.State (get, put)+import Control.Concurrent.STM (atomically, modifyTVar') import Data.Kind (Type) import Data.Proxy (Proxy(..)) import Data.Typeable (Typeable) import Prelude hiding (lookup) import Test.MockCat.Internal.Builder+import Test.MockCat.Internal.Verify (verifyExpectationDirect) import qualified Test.MockCat.Internal.MockRegistry as MockRegistry ( register ) import Test.MockCat.Internal.Types import Test.MockCat.Param import Test.MockCat.Verify import Test.MockCat.Cons (Head(..), (:>)(..)) + -- | Type family to convert raw values to mock parameters. --   Raw values (like "foo") are converted to Head :> Param a, --   while existing Param chains remain unchanged.@@ -125,13 +134,64 @@ class CreateStubFn a where   stubImpl :: a +-- | Type family to distinguish MockSpec from other parameters.+type family IsMockSpec p :: Bool where+  IsMockSpec (MockSpec p e) = 'True+  IsMockSpec other = 'False++-- | 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+  mockDispatchImpl :: Label -> p -> m fn++-- Generic instance for named mocks (flag ~ 'False)+instance+  ( MonadIO m+  , CreateMock p+  , MockBuilder (ToMockParams p) fn verifyParams+  , Typeable verifyParams+  , Typeable fn+  , IsMockSpec p ~ 'False+  ) =>+  MockDispatch 'False p m fn+  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++-- Specific instance for MockSpec (flag ~ 'True)+instance+  ( MonadIO m+  , MonadWithMockContext m+  , CreateMock params+  , MockBuilder (ToMockParams params) fn verifyParams+  , Show verifyParams+  , Eq verifyParams+  , Typeable verifyParams+  , Typeable fn+  ) =>+  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)+    _ <- liftIO $ MockRegistry.register (Just name) recorder fn+    +    WithMockContext ctxRef <- askWithMockContext+    let resolved = ResolvedMock (Just name) recorder+    let verifyAction = mapM_ (verifyExpectationDirect resolved) exps+    liftIO $ atomically $ modifyTVar' ctxRef (++ [verifyAction])++    pure fn+ -- | Create a mock function with verification hooks attached (unnamed version). --   The returned function mimics a pure function (via 'unsafePerformIO') but records its calls for later verification. -- --   > f <- mock $ "a" ~> "b" --   > f "a" `shouldBe` "b" --   > f `shouldBeCalled` "a"-instance+instance {-# OVERLAPPABLE #-}   ( MonadIO m   , CreateMock p   , MockBuilder (ToMockParams p) fn verifyParams@@ -145,23 +205,45 @@     BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock Nothing params     liftIO $ MockRegistry.register Nothing recorder fn --- | Create a named mock function.---   The name is used in error messages to help you identify which mock failed.+-- | Create a mock function from MockSpec.+--   MockSpec can optionally contain expectations.+--   If expectations are present, they are automatically registered. -----   > f <- mock (label "MyAPI") $ "a" ~> "b"+--   > f <- mock $ any ~> True+--   > f <- mock $ any ~> True `expects` do called once instance {-# OVERLAPPING #-}   ( MonadIO m-  , CreateMock p-  , MockBuilder (ToMockParams p) fn verifyParams+  , MonadWithMockContext m+  , CreateMock params+  , MockBuilder (ToMockParams params) fn verifyParams+  , Show verifyParams+  , Eq verifyParams   , Typeable verifyParams   , Typeable fn   ) =>+  CreateMockFn (MockSpec params [Expectation verifyParams] -> m fn)+  where+  mockImpl (MockSpec params exps) = do+    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock Nothing (toParams params)+    _ <- liftIO $ MockRegistry.register Nothing recorder fn+    +    WithMockContext ctxRef <- askWithMockContext+    let resolved = ResolvedMock Nothing recorder+    let verifyAction = mapM_ (verifyExpectationDirect resolved) exps+    liftIO $ atomically $ modifyTVar' ctxRef (++ [verifyAction])++    pure fn++-- | Create a named mock function.+--   The name is used in error messages to help you identify which mock failed.+--+--   > f <- mock (label "MyAPI") $ "a" ~> "b"+instance {-# OVERLAPPING #-} forall p m fn.+  ( MockDispatch (IsMockSpec p) p m fn+  ) =>   CreateMockFn (Label -> p -> m fn)   where-  mockImpl (Label name) p = do-    let params = toParams p-    BuiltMock { builtMockFn = fn, builtMockRecorder = recorder } <- buildMock (Just name) params-    liftIO $ MockRegistry.register (Just name) recorder fn+  mockImpl = mockDispatchImpl @(IsMockSpec p)  -- | Create a mock function with verification hooks attached. --

@@ -29,9 +29,8 @@ import Data.IORef (newIORef, IORef) import Data.Dynamic (Dynamic) import UnliftIO (MonadUnliftIO(..))-import Test.MockCat.Internal.Types (InvocationRecorder)+import Test.MockCat.Internal.Types (InvocationRecorder, WithMockContext(..), MonadWithMockContext(..)) import Test.MockCat.Verify (ResolvableParamsOf)-import Test.MockCat.WithMock (WithMockContext(..), MonadWithMockContext(..)) import Control.Concurrent.MVar (MVar) import qualified Data.Map.Strict as Map import qualified Test.MockCat.Internal.Registry.Core as Registry

@@ -19,6 +19,7 @@     value,     param,     ConsGen(..),+    MockSpec(..),     expect,     expect_,     any,@@ -35,14 +36,25 @@ where  import Test.MockCat.Cons ((:>) (..), Head(..))+import Test.MockCat.Internal.Types (Cases) import Unsafe.Coerce (unsafeCoerce) import Prelude hiding (any) import Data.Typeable (Typeable, typeOf) import Foreign.Ptr (Ptr, ptrToIntPtr, castPtr, IntPtr) import qualified Data.Text as T (Text) -infixr 0 ~>+infixr 1 ~> +-- | MockSpec wraps stub parameters with optional expectations.+-- The 'exps' type parameter is () when no expectations are set,+-- or a list of expectations when 'expects' has been applied.+-- This design ensures 'expects' can only be applied to MockSpec,+-- not to the result of 'mock'.+data MockSpec params exps = MockSpec+  { specParams :: params+  , specExpectations :: exps+  } deriving (Show, Eq)+ data Param v where   -- | A parameter that expects a specific value.   ExpectValue :: (Show v, Eq v) => v -> String -> Param v@@ -119,6 +131,7 @@ -- | Type family to untie the knot for ConsGen instances type family Normalize a where   Normalize (a :> b) = a :> b+  Normalize Head = Head   Normalize (Param a) = Param a   Normalize a = Param a @@ -134,6 +147,9 @@ instance {-# OVERLAPPABLE #-} (Normalize a ~ Param a, WrapParam a) => ToParamArg a where   toParamArg = wrap +instance {-# OVERLAPPING #-} ToParamArg Head where+  toParamArg = id+ class ToParamResult b where   toParamResult :: b -> Normalize b @@ -149,6 +165,7 @@ class ConsGen a b where   (~>) :: a -> b -> Normalize a :> Normalize b +-- | Instance for chaining parameters instance (ToParamArg a, ToParamResult b) => ConsGen a b where   (~>) a b = (:>) (toParamArg a) (toParamResult b) @@ -179,8 +196,11 @@ -- | The type of the argument parameters of the parameters. type family ArgsOf params where   ArgsOf (Head :> Param r) = ()                        -- Constant value has no arguments+  ArgsOf (IO a) = ()   ArgsOf (Param a :> Param r) = Param a   ArgsOf (Param a :> rest) = Param a :> ArgsOf rest+  ArgsOf (Cases a b) = ArgsOf a+  ArgsOf a = ()  -- | Class for projecting the arguments of the parameter. class ProjectionArgs params where

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-}@@ -32,7 +33,7 @@   ) where -import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (lift) import Language.Haskell.TH   ( Dec (..),@@ -51,11 +52,9 @@   ) import Language.Haskell.TH.Lib import Language.Haskell.TH.Syntax (nameBase, Specificity (SpecifiedSpec))-import Test.MockCat.Mock ( MockBuilder )-import qualified Test.MockCat.Internal.MockRegistry as Registry-import Test.MockCat.Internal.Builder (buildMock)-import Test.MockCat.Internal.Types (BuiltMock(..))-import Test.MockCat.Cons (Head(..), (:>)(..))+import Test.MockCat.Mock (IsMockSpec, MockDispatch(..), label)+import Test.MockCat.Internal.Types (InvocationRecorder)+import Test.MockCat.Cons ((:>)(..)) import Test.MockCat.MockT   ( MockT (..),     Definition (..),@@ -66,7 +65,9 @@   ( isNotConstantFunctionType,     needsTypeable,     collectTypeVars,-    collectTypeableTargets+    collectTypeableTargets,+    splitApps,+    isTypeFamily   ) import Test.MockCat.TH.ContextBuilder   ( MockType (..)@@ -78,14 +79,14 @@ import Test.MockCat.Verify (ResolvableParamsOf) import Data.Dynamic (Dynamic, toDyn) import Data.Proxy (Proxy(..))-import Data.List (find, nubBy)+import Data.List (find, nubBy, nub) import Data.Typeable (Typeable) import Language.Haskell.TH.Ppr (pprint) import Unsafe.Coerce (unsafeCoerce) import GHC.TypeLits (KnownSymbol, symbolVal)   -import Test.MockCat.Param (Param, param)+import Test.MockCat.Param (Param) import Test.MockCat.TH.Types (MockOptions(..))  createMockBuilderVerifyParams :: Type -> Type@@ -121,12 +122,14 @@   ]  -- Helper to create Typeable predicates using the smart collection logic-createTypeablePreds :: [Type] -> [Pred]-createTypeablePreds targets =-  [ AppT (ConT ''Typeable) t-  | t <- nubBy (\a b -> pprint a == pprint b) (concatMap collectTypeableTargets targets)-  , needsTypeable t-  ]+createTypeablePreds :: [Type] -> Q [Pred]+createTypeablePreds targets = do+  allTargets <- concat <$> mapM collectTypeableTargets targets+  pure+    [ AppT (ConT ''Typeable) t+    | t <- nubBy (\a b -> pprint a == pprint b) allTargets+    , needsTypeable t+    ]   data MockFnContext = MockFnContext@@ -191,159 +194,199 @@ createNoInlinePragma :: Name -> Q Dec createNoInlinePragma name = pragInlD name NoInline FunLike AllPhases -doCreateMockFnDecs :: (Quote m) => MockType -> String -> Name -> Name -> Type -> Name -> Type -> m [Dec]-doCreateMockFnDecs mockType funNameStr mockFunName params funType monadVarName updatedType = do-  newFunSig <- do-    let verifyParams = createMockBuilderVerifyParams updatedType-        mockBuilderPred =-          AppT (AppT (AppT (ConT ''MockBuilder) (VarT params)) funType) verifyParams-        eqConstraint =-          [ AppT-              (AppT EqualityT (AppT (ConT ''ResolvableParamsOf) funType))-              verifyParams-          | not (null (collectTypeVars funType))+isAtomicNonFunction :: Type -> Q Bool+isAtomicNonFunction (AppT t _) = isAtomicNonFunction t+isAtomicNonFunction ListT = pure True+isAtomicNonFunction (TupleT _) = pure True+isAtomicNonFunction (ConT n)+  | n == ''(->) = pure False+  | otherwise = not <$> isTypeFamily (ConT n)+isAtomicNonFunction _ = pure False++doCreateMockFnDecs :: MockType -> String -> Name -> Name -> Type -> Name -> Type -> Q [Dec]+doCreateMockFnDecs mockType funNameStr mockFunName params funTypeInput monadVarName _ = do+  let funType = sanitizeType [monadVarName] funTypeInput+  let resultType =+        AppT+          (AppT ArrowT (VarT params))+          (AppT (AppT (ConT ''MockT) (VarT monadVarName)) funType)+      +      mockTType = AppT (ConT ''MockT) (VarT monadVarName)+      flag = AppT (ConT ''IsMockSpec) (VarT params)+      createMockFnPred =+        AppT (AppT (AppT (AppT (ConT ''MockDispatch) flag) (VarT params)) mockTType) funType+      +      recType = AppT (ConT ''InvocationRecorder) (AppT (ConT ''ResolvableParamsOf) funType)+      recConstraint = AppT (ConT ''Typeable) recType+      +      paramsType = AppT (ConT ''ResolvableParamsOf) funType+      paramsConstraint = AppT (ConT ''Typeable) paramsType+++  typeablePreds <- createTypeablePreds [funType]+          +  let baseCtx =+          [ createMockFnPred+          , AppT (ConT ''MonadIO) (VarT monadVarName)+          , recConstraint+          , paramsConstraint           ]-        baseCtx =-          ([mockBuilderPred | verifyParams /= TupleT 0])-            ++ [AppT (ConT ''MonadIO) (VarT monadVarName)]-        typeablePreds = createTypeablePreds [funType, verifyParams]-        ctx = case mockType of-          Partial ->-            baseCtx ++ partialAdditionalPredicates funType verifyParams ++ typeablePreds-          Total ->-            baseCtx ++ eqConstraint ++ typeablePreds-        resultType =-          AppT-            (AppT ArrowT (VarT params))-            (AppT (AppT (ConT ''MockT) (VarT monadVarName)) funType)-    sigD mockFunName (pure (ForallT [] ctx resultType))+          ++ typeablePreds+      +      ctx = case mockType of+              Partial -> baseCtx+              Total -> baseCtx+    +  let vars = collectFreeVars funType ++ [params, monadVarName]+  let tvs = map (\n -> PlainTV n SpecifiedSpec) (nub vars)+  let finalCtx = filter (not . isRedundantTypeable monadVarName) ctx+  newFunSig <- sigD mockFunName (pure (ForallT tvs finalCtx resultType)) -  mockBody <- createMockBody funNameStr [|p|] funType+  mockBody <- createMockBody funNameStr [|p|] (VarT params)   newFun <- funD mockFunName [clause [varP $ mkName "p"] (normalB (pure mockBody)) []]    pure $ newFunSig : [newFun] -doCreateConstantMockFnDecs :: (Quote m) => MockType -> String -> Name -> Type -> Name -> m [Dec]-doCreateConstantMockFnDecs Partial funNameStr mockFunName _ monadVarName = do-  stubVar <- newName "r"+doCreateConstantMockFnDecs :: MockType -> String -> Name -> Type -> Name -> Q [Dec]+doCreateConstantMockFnDecs Partial funNameStr mockFunName ty monadVarName = do+  let stubVar = mkName "p" +  let tySanitized = sanitizeType [monadVarName] ty+  let resultType =+        AppT+          (AppT ArrowT (VarT stubVar))+          (AppT (AppT (ConT ''MockT) (VarT monadVarName)) tySanitized)+      +  let mockTType = AppT (ConT ''MockT) (VarT monadVarName)+  let flag = AppT (ConT ''IsMockSpec) (VarT stubVar)+  let createMockFnPred =+          AppT (AppT (AppT (AppT (ConT ''MockDispatch) flag) (VarT stubVar)) mockTType) tySanitized++  let recType = AppT (ConT ''InvocationRecorder) (AppT (ConT ''ResolvableParamsOf) tySanitized)+  let recConstraint = AppT (ConT ''Typeable) recType+  +  let paramsType = AppT (ConT ''ResolvableParamsOf) tySanitized+  let paramsConstraint = AppT (ConT ''Typeable) paramsType++  typeablePreds <- createTypeablePreds [tySanitized]+  isAtomic <- isAtomicNonFunction tySanitized+  let constraints = if isAtomic then [] else [recConstraint, paramsConstraint]+   let ctx =-        [ AppT-            (AppT EqualityT (AppT (ConT ''ResolvableParamsOf) (VarT stubVar)))-            (TupleT 0)+        [ createMockFnPred         , AppT (ConT ''MonadIO) (VarT monadVarName)-        , AppT (ConT ''Typeable) (VarT stubVar)-        , AppT (ConT ''Show) (VarT stubVar)-        , AppT (ConT ''Eq) (VarT stubVar)         ]-      resultType =-        AppT-          (AppT ArrowT (VarT stubVar))-          (AppT (AppT (ConT ''MockT) (VarT monadVarName)) (VarT stubVar))+        ++ constraints+        ++ typeablePreds+  let finalCtx = filter (not . isRedundantTypeable monadVarName) ctx+  let vars = collectFreeVars tySanitized ++ [stubVar, monadVarName]+  let tvs = map (\n -> PlainTV n SpecifiedSpec) (nub vars)   newFunSig <-     sigD       mockFunName       ( pure           (ForallT-              [ PlainTV stubVar SpecifiedSpec-              , PlainTV monadVarName SpecifiedSpec-              ]-              ctx+              tvs+              finalCtx               resultType           )       )-  headParam <- [|Head :> param p|]-  mockBody <- createMockBody funNameStr (pure headParam) (VarT stubVar)+  mockBody <- createMockBody funNameStr [|p|] (VarT stubVar)   newFun <- funD mockFunName [clause [varP $ mkName "p"] (normalB (pure mockBody)) []]   pure $ newFunSig : [newFun] doCreateConstantMockFnDecs Total funNameStr mockFunName ty monadVarName = do-  (newFunSig, funTypeForBody) <- case ty of-    AppT (ConT _) (VarT mv) | mv == monadVarName -> do-      a <- newName "a"-      let ctx =-            [ AppT (ConT ''MonadIO) (VarT monadVarName)-            , AppT (AppT EqualityT (AppT (ConT ''ResolvableParamsOf) (VarT a))) (TupleT 0)-            , AppT (ConT ''Typeable) (VarT a)-            , AppT (ConT ''Show) (VarT a)-            , AppT (ConT ''Eq) (VarT a)-            ]-          resultType =-            AppT-              (AppT ArrowT (VarT a))-              (AppT (AppT (ConT ''MockT) (VarT monadVarName)) (VarT a))-      sig <- sigD-        mockFunName-        ( pure-            (ForallT-                [PlainTV a SpecifiedSpec, PlainTV monadVarName SpecifiedSpec]-                ctx-                resultType-            )-        )-      pure (sig, VarT a)+  case ty of+    -- Case 3: Generic (Polymorphic p)     _ -> do-      let headParamType = AppT (AppT (ConT ''(:>)) (ConT ''Head)) (AppT (ConT ''Param) ty)-          verifyParams' = createMockBuilderVerifyParams ty-          mockBuilderPred' = AppT (AppT (AppT (ConT ''MockBuilder) headParamType) ty) (TupleT 0)-          ctx =-            [ AppT (ConT ''MonadIO) (VarT monadVarName)-            ]-            ++ ([mockBuilderPred' | verifyParams' /= TupleT 0])-            ++ createTypeablePreds [ty]-          resultType =+      let params = mkName "p"+      let tySanitized = sanitizeType [monadVarName] ty+      let resultType =             AppT-              (AppT ArrowT ty)-              (AppT (AppT (ConT ''MockT) (VarT monadVarName)) ty)-      sig <- sigD mockFunName (pure (ForallT [PlainTV monadVarName SpecifiedSpec] ctx resultType))-      pure (sig, ty)-  headParam <- [|Head :> param p|]-  mockBody <- createMockBody funNameStr (pure headParam) funTypeForBody-  newFun <- funD mockFunName [clause [varP $ mkName "p"] (normalB (pure mockBody)) []]-  pure $ newFunSig : [newFun]+              (AppT ArrowT (VarT params))+              (AppT (AppT (ConT ''MockT) (VarT monadVarName)) tySanitized)+          +          mockTType = AppT (ConT ''MockT) (VarT monadVarName)+          flag = AppT (ConT ''IsMockSpec) (VarT params)+          createMockFnPred =+              AppT (AppT (AppT (AppT (ConT ''MockDispatch) flag) (VarT params)) mockTType) tySanitized -doCreateEmptyVerifyParamMockFnDecs :: (Quote m) => String -> Name -> Name -> Type -> Name -> Type -> m [Dec]-doCreateEmptyVerifyParamMockFnDecs funNameStr mockFunName params funType monadVarName updatedType = do+      let recType = AppT (ConT ''InvocationRecorder) (AppT (ConT ''ResolvableParamsOf) tySanitized)+      let recConstraint = AppT (ConT ''Typeable) recType+      +      let paramsType = AppT (ConT ''ResolvableParamsOf) tySanitized+      let paramsConstraint = AppT (ConT ''Typeable) paramsType++      typeablePreds <- createTypeablePreds [tySanitized]+      isAtomic <- isAtomicNonFunction tySanitized+      let constraints = if isAtomic then [] else [recConstraint, paramsConstraint]++      let ctx =+            [ createMockFnPred+            , AppT (ConT ''MonadIO) (VarT monadVarName)+            ]+            ++ constraints+            ++ typeablePreds+            +      let tvs = map (\n -> PlainTV n SpecifiedSpec) (nub (collectFreeVars tySanitized ++ [params, monadVarName]))+      let finalCtx = filter (not . isRedundantTypeable monadVarName) ctx+      newFunSig <- sigD mockFunName (pure (ForallT tvs finalCtx resultType))++      mockBody <- createMockBody funNameStr [|p|] (VarT params)+      newFun <- funD mockFunName [clause [varP params] (normalB (pure mockBody)) []]+      pure [newFunSig, newFun]++doCreateEmptyVerifyParamMockFnDecs :: String -> Name -> Name -> Type -> Name -> Type -> Q [Dec]+doCreateEmptyVerifyParamMockFnDecs funNameStr mockFunName params funTypeInput monadVarName updatedType = do+  let funType = sanitizeType [monadVarName] funTypeInput   newFunSig <- do     let verifyParams = createMockBuilderVerifyParams updatedType-        mockBuilderPred = AppT (AppT (AppT (ConT ''MockBuilder) (VarT params)) funType) verifyParams-        eqConstraint =-          [ AppT-              (AppT EqualityT (AppT (ConT ''ResolvableParamsOf) funType))-              verifyParams-          | not (null (collectTypeVars funType))-          ]-        ctx =-          [mockBuilderPred]-            ++ [AppT (ConT ''MonadIO) (VarT monadVarName)]-            ++ eqConstraint-            ++ createTypeablePreds [funType, verifyParams]         resultType =           AppT             (AppT ArrowT (VarT params))             (AppT (AppT (ConT ''MockT) (VarT monadVarName)) funType)-    sigD mockFunName (pure (ForallT [] ctx resultType))+        +        mockTType = AppT (ConT ''MockT) (VarT monadVarName)+        flag = AppT (ConT ''IsMockSpec) (VarT params)+        createMockFnPred =+          AppT (AppT (AppT (AppT (ConT ''MockDispatch) flag) (VarT params)) mockTType) funType -  mockBody <- createMockBody funNameStr [|p|] funType+        recType = AppT (ConT ''InvocationRecorder) (AppT (ConT ''ResolvableParamsOf) funType)+        recConstraint = AppT (ConT ''Typeable) recType+        +        paramsType = AppT (ConT ''ResolvableParamsOf) funType+        paramsConstraint = AppT (ConT ''Typeable) paramsType++    typeablePreds <- createTypeablePreds [funType, verifyParams]+    let ctx =+          [createMockFnPred]+            ++ [AppT (ConT ''MonadIO) (VarT monadVarName)]+            ++ [recConstraint, paramsConstraint]+            ++ typeablePreds+        +    let finalCtx = filter (not . isRedundantTypeable monadVarName) ctx+    +    let vars = collectFreeVars funType ++ [params, monadVarName]+    let tvs = map (\n -> PlainTV n SpecifiedSpec) (nub vars)+    sigD mockFunName (pure (ForallT tvs finalCtx resultType))++  mockBody <- createMockBody funNameStr [|p|] (VarT params)   newFun <- funD mockFunName [clause [varP $ mkName "p"] (normalB (pure mockBody)) []]    pure $ newFunSig : [newFun]  createMockBody :: (Quote m) => String -> m Exp -> Type -> m Exp-createMockBody funNameStr paramsExp _funType = do+createMockBody funNameStr paramsExp paramsType = do   params <- paramsExp+  let flag = AppT (ConT ''IsMockSpec) paramsType   [|     MockT $ do-      -- Build the mock instance and its verifier directly so we have access-      -- to the verifier value (avoids runtime type-mismatch when resolving).-      BuiltMock { builtMockFn = mockInstance, builtMockRecorder = verifier } <- liftIO $ buildMock (Just $(litE (stringL funNameStr))) $(pure params)-      -- Register and get the canonical wrapper (preserved for async safety)-      canonicalInstance <- liftIO $ Registry.register (Just $(litE (stringL funNameStr))) verifier mockInstance+      mockInstance <- unMockT $ $(appTypeE (varE 'mockDispatchImpl) (pure flag)) (label $(litE (stringL funNameStr))) $(pure params)       addDefinition         ( Definition             (Proxy :: Proxy $(litT (strTyLit funNameStr)))-            canonicalInstance+            mockInstance             NoVerification         )-      pure canonicalInstance+      pure mockInstance     |]  createFnName :: Name -> MockOptions -> String@@ -355,11 +398,40 @@   let definition = find (\(Definition s _ _) -> symbolVal s == symbolVal pa) definitions   fmap (\(Definition _ mockFunction _) -> toDyn mockFunction) definition +collectFreeVars :: Type -> [Name]+collectFreeVars (ForallT bndrs _ t) =+  let boundNames = map getTVName bndrs+   in filter (`notElem` boundNames) (collectFreeVars t)+collectFreeVars (AppT t1 t2) = collectFreeVars t1 ++ collectFreeVars t2+collectFreeVars (SigT t _) = collectFreeVars t+collectFreeVars (VarT n) = [n]+collectFreeVars _ = []++getTVName :: TyVarBndr flag -> Name+getTVName (PlainTV n _) = n+getTVName (KindedTV n _ _) = n+ typeToNames :: Type -> [Q Name] typeToNames (AppT (AppT ArrowT _) t2) = newName "a" : typeToNames t2 typeToNames (ForallT _ _ ty) = typeToNames ty typeToNames _ = [] +sanitizeType :: [Name] -> Type -> Type+sanitizeType kept (AppT t1 t2) = AppT (sanitizeType kept t1) (sanitizeType kept t2)+sanitizeType kept (SigT t k) = SigT (sanitizeType kept t) (sanitizeType kept k)+sanitizeType kept (VarT n)+  | n `elem` kept = VarT n+  | otherwise = VarT (mkName (nameBase n))+sanitizeType kept (ForallT bndrs ctx t) =+  let sanitizeBndr (PlainTV n flag)+        | n `elem` kept = PlainTV n flag+        | otherwise = PlainTV (mkName (nameBase n)) flag+      sanitizeBndr (KindedTV n flag k)+        | n `elem` kept = KindedTV n flag (sanitizeType kept k)+        | otherwise = KindedTV (mkName (nameBase n)) flag (sanitizeType kept k)+  in ForallT (map sanitizeBndr bndrs) (map (sanitizeType kept) ctx) (sanitizeType kept t)+sanitizeType _ t = t+ safeIndex :: [a] -> Int -> Maybe a safeIndex [] _ = Nothing safeIndex (x : _) 0 = Just x@@ -380,8 +452,8 @@       let findDef = find (\(Definition s _ _) -> symbolVal s == $(litE (stringL fnNameStr))) defs       case findDef of         Just (Definition _ mf _) -> do-          let mock = unsafeCoerce mf-          let $(bangP $ varP r) = $(generateStubFn args [|mock|])+          let mockFn = unsafeCoerce mf+          let $(bangP $ varP r) = $(generateStubFn args [|mockFn|])           $(pure returnExp)         Nothing -> error $ "no answer found stub function `" ++ fnNameStr ++ "`."     |]@@ -397,14 +469,43 @@       let findDef = find (\(Definition s _ _) -> symbolVal s == $(litE (stringL fnNameStr))) defs       case findDef of         Just (Definition _ mf _) -> do-          let mock = unsafeCoerce mf-          let $(bangP $ varP r) = $(generateStubFn args [|mock|])+          let mockFn = unsafeCoerce mf+          let $(bangP $ varP r) = $(generateStubFn args [|mockFn|])           $(pure returnExp)         Nothing -> lift $ $(foldl appE (varE fnName) args)     |]  generateStubFn :: [Q Exp] -> Q Exp -> Q Exp-generateStubFn [] mock = mock-generateStubFn args mock = foldl appE mock args+generateStubFn [] mockFn = mockFn+generateStubFn args mockFn = foldl appE mockFn args+++isRedundantTypeable :: Name -> Pred -> Bool+isRedundantTypeable monadName (AppT (ConT n) t)+  | n == ''Typeable =+      if null (collectFreeVars t)+        then True+        else case t of+          VarT vn | nameBase vn == nameBase monadName -> False+          _ -> if any (\v -> nameBase v == nameBase monadName) (collectFreeVars t)+                 then not (isProtectedType t)+                 else False+  where+    isProtectedType ty =+      let (headTy, _) = splitApps ty+      in case headTy of+           ConT hn -> nameBase hn `elem` protectedTypes+           _ -> False++    protectedTypes =+      [ "ResolvableParamsOf"+      , "ResultType"+      , "InvocationRecorder"+      , "PrependParam"+      , "FunctionParams"+      ]+isRedundantTypeable _ _ = False++  

@@ -6,12 +6,14 @@     collectTypeVars,     needsTypeable,     collectTypeableTargets,-    isStandardTypeCon+    isStandardTypeCon,+    isTypeFamily+   ) where  import qualified Data.Map.Strict as Map-import Language.Haskell.TH (Name, Type (..))+import Language.Haskell.TH (Name, Type (..), Q, reify, Info(FamilyI), recover) import Test.MockCat.Param (Param) import Test.MockCat.Cons ((:>)) @@ -63,22 +65,46 @@ collectTypeVars (ForallT _ _ t) = collectTypeVars t collectTypeVars (ImplicitParamT _ t) = collectTypeVars t collectTypeVars _ = []+    +peel :: Type -> Type+peel (SigT t _) = peel t+peel (ParensT t) = peel t+peel t = t -collectTypeableTargets :: Type -> [Type]+collectTypeableTargets :: Type -> Q [Type] collectTypeableTargets ty =   case ty of-    VarT _ -> [ty]+    VarT _ -> pure [ty]     AppT _ _ ->-      let (f, args) = splitApps ty-      in if isStandardTypeCon f-         then concatMap collectTypeableTargets args-         else [ty]+      let (headTy, args) = splitApps ty+       in do+         isTF <- isTypeFamily headTy+         if isTF+           then pure [ty]+           else case peel headTy of+             ConT _ -> concat <$> mapM collectTypeableTargets args+             ListT -> pure [ty]+             TupleT _ -> concat <$> mapM collectTypeableTargets args+             VarT _ -> do+               headResult <- pure (peel headTy)+               argsResult <- concat <$> mapM collectTypeableTargets args+               pure (headResult : argsResult)+             ArrowT -> concat <$> mapM collectTypeableTargets args+             _ -> concat <$> mapM collectTypeableTargets args     SigT t _ -> collectTypeableTargets t     ParensT t -> collectTypeableTargets t-    InfixT t1 _ t2 -> collectTypeableTargets t1 ++ collectTypeableTargets t2-    UInfixT t1 _ t2 -> collectTypeableTargets t1 ++ collectTypeableTargets t2+    InfixT t1 _ t2 -> (++) <$> collectTypeableTargets t1 <*> collectTypeableTargets t2+    UInfixT t1 _ t2 -> (++) <$> collectTypeableTargets t1 <*> collectTypeableTargets t2     ForallT _ _ t -> collectTypeableTargets t-    _ -> []+    _ -> pure []++isTypeFamily :: Type -> Q Bool+isTypeFamily (ConT name) = recover (pure False) $ do+  info <- reify name+  case info of+    FamilyI _ _ -> pure True+    _ -> pure False+isTypeFamily _ = pure False  isStandardTypeCon :: Type -> Bool isStandardTypeCon ArrowT = True

@@ -18,10 +18,20 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-} module Test.MockCat.Verify where -import Control.Concurrent.STM (TVar, readTVarIO)++import Test.MockCat.Internal.Verify+  ( tryVerifyCallCount+  , compareCount+  , countWithArgsMismatchMessage+  , doVerify+  , doVerifyOrder+  , readInvocationList+  ) import Test.MockCat.Internal.Types-import Control.Monad (guard, when)-import Data.List (elemIndex, intercalate)+++import Control.Monad ()+import Data.List (intercalate) import Data.Maybe import Test.MockCat.Param import Prelude hiding (lookup)@@ -56,195 +66,8 @@     Nothing -> pure Nothing     Just (VerifyFailed msg) -> pure (Just msg) -doVerify :: (Eq a, Show a) => Maybe MockName -> InvocationList a -> VerifyMatchType a -> Maybe VerifyFailed-doVerify name list (MatchAny a) = do-  guard $ notElem a list-  pure $ verifyFailedMessage name list a-doVerify name list (MatchAll a) = do-  guard $ Prelude.any (a /=) list-  pure $ verifyFailedMessage name list a -readInvocationList :: TVar (InvocationRecord params) -> IO (InvocationList params)-readInvocationList ref = do-  record <- readTVarIO ref-  pure $ invocations record --- | Verify that a resolved mock function was called at least once.---   This is used internally by typeclass mock verification.-verifyResolvedAny :: ResolvedMock params -> IO ()-verifyResolvedAny (ResolvedMock mockName recorder) = do-  invocationList <- readInvocationList (invocationRef recorder)-  when (null invocationList) $-    errorWithoutStackTrace $-      intercalate-        "\n"-        [ "Function" <> mockNameLabel mockName <> " was never called"-        ]---- | Verify that mock was called with specific arguments using resolved mock directly.---   This avoids StableName lookup and is HPC-safe.-verifyResolvedMatch :: (Eq params, Show params) => ResolvedMock params -> VerifyMatchType params -> IO ()-verifyResolvedMatch (ResolvedMock mockName recorder) matchType = do-  invocationList <- readInvocationList (invocationRef recorder)-  case doVerify mockName invocationList matchType of-    Nothing -> pure ()-    Just (VerifyFailed msg) ->-      errorWithoutStackTrace msg `seq` pure ()---- | Verify call count with specific arguments using resolved mock directly.---   This avoids StableName lookup and is HPC-safe.-verifyResolvedCount :: Eq params => ResolvedMock params -> params -> CountVerifyMethod -> IO ()-verifyResolvedCount (ResolvedMock mockName recorder) v method = do-  invocationList <- readInvocationList (invocationRef recorder)-  let callCount = length (filter (v ==) invocationList)-  if compareCount method callCount-    then pure ()-    else-      errorWithoutStackTrace $-        countWithArgsMismatchMessage mockName method callCount---- | Verify call order using resolved mock directly.---   This avoids StableName lookup and is HPC-safe.-verifyResolvedOrder :: (Eq params, Show params) => VerifyOrderMethod -> ResolvedMock params -> [params] -> IO ()-verifyResolvedOrder method (ResolvedMock mockName recorder) matchers = do-  invocationList <- readInvocationList (invocationRef recorder)-  case doVerifyOrder method mockName invocationList matchers of-    Nothing -> pure ()-    Just (VerifyFailed msg) ->-      errorWithoutStackTrace msg `seq` pure ()--compareCount :: CountVerifyMethod -> Int -> Bool-compareCount (Equal e) a = a == e-compareCount (LessThanEqual e) a = a <= e-compareCount (LessThan e) a = a < e-compareCount (GreaterThanEqual e) a = a >= e-compareCount (GreaterThan e) a = a > e--verifyCount ::-  ( ResolvableMock m-  , Eq (ResolvableParamsOf m)-  ) =>-  m ->-  ResolvableParamsOf m ->-  CountVerifyMethod ->-  IO ()-verifyCount m v method = do-  candidates <- requireResolved m-  checkCandidates candidates $ \(ResolvedMock mockName recorder) -> do-    invocationList <- readInvocationList (invocationRef recorder)-    let callCount = length (filter (v ==) invocationList)-    if compareCount method callCount-      then pure Nothing-      else-        pure $ Just $ countWithArgsMismatchMessage mockName method callCount---- | Generate error message for count mismatch with arguments-countWithArgsMismatchMessage :: Maybe MockName -> CountVerifyMethod -> Int -> String-countWithArgsMismatchMessage mockName method callCount =-  intercalate-    "\n"-    [ "function" <> mockNameLabel mockName <> " was not called the expected number of times with the expected arguments.",-      "  expected: " <> show method,-      "   but got: " <> show callCount-    ]----verifyOrder ::-  (ResolvableMock m-  , Eq (ResolvableParamsOf m)-  , Show (ResolvableParamsOf m)) =>-  VerifyOrderMethod ->-  m ->-  [ResolvableParamsOf m] ->-  IO ()-verifyOrder method m matchers = do-  candidates <- requireResolved m-  checkCandidates candidates $ \(ResolvedMock mockName recorder) -> do-    invocationList <- readInvocationList (invocationRef recorder)-    case doVerifyOrder method mockName invocationList matchers of-      Nothing -> pure Nothing-      Just (VerifyFailed msg) -> pure (Just msg)--doVerifyOrder ::-  (Eq a, Show a) =>-  VerifyOrderMethod ->-  Maybe MockName ->-  InvocationList a ->-  [a] ->-  Maybe VerifyFailed-doVerifyOrder ExactlySequence name calledValues expectedValues-  | length calledValues /= length expectedValues = do-      pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues-  | otherwise = do-      let unexpectedOrders = collectUnExpectedOrder calledValues expectedValues-      guard $ length unexpectedOrders > 0-      pure $ verifyFailedSequence name unexpectedOrders-doVerifyOrder PartiallySequence name calledValues expectedValues-  | length calledValues < length expectedValues = do-      pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues-  | otherwise = do-      guard $ isOrderNotMatched calledValues expectedValues-      pure $ verifyFailedPartiallySequence name calledValues expectedValues--verifyFailedPartiallySequence :: Show a => Maybe MockName -> InvocationList a -> [a] -> VerifyFailed-verifyFailedPartiallySequence name calledValues expectedValues =-  VerifyFailed $-    intercalate-      "\n"-      [ "function" <> mockNameLabel name <> " was not called with the expected arguments in the expected order.",-        "  expected order:",-        intercalate "\n" $ ("    " <>) . show <$> expectedValues,-        "  but got:",-        intercalate "\n" $ ("    " <>) . show <$> calledValues-      ]--isOrderNotMatched :: Eq a => InvocationList a -> [a] -> Bool-isOrderNotMatched calledValues expectedValues =-  isNothing $-    foldl-      ( \candidates e -> do-          candidates >>= \c -> do-            index <- elemIndex e c-            Just $ drop (index + 1) c-      )-      (Just calledValues)-      expectedValues--verifyFailedOrderParamCountMismatch :: Maybe MockName -> InvocationList a -> [a] -> VerifyFailed-verifyFailedOrderParamCountMismatch name calledValues expectedValues =-  VerifyFailed $-    intercalate-      "\n"-      [ "function" <> mockNameLabel name <> " was not called with the expected arguments in the expected order (count mismatch).",-        "  expected: " <> show (length expectedValues),-        "   but got: " <> show (length calledValues)-      ]--verifyFailedSequence :: Show a => Maybe MockName -> [VerifyOrderResult a] -> VerifyFailed-verifyFailedSequence name fails =-  VerifyFailed $-    intercalate-      "\n"-      ( ("function" <> mockNameLabel name <> " was not called with the expected arguments in the expected order.") : (verifyOrderFailedMesssage <$> fails)-      )----collectUnExpectedOrder :: Eq a => InvocationList a -> [a] -> [VerifyOrderResult a]-collectUnExpectedOrder calledValues expectedValues =-  catMaybes $-    mapWithIndex-      ( \i expectedValue -> do-          let calledValue = calledValues !! i-          guard $ expectedValue /= calledValue-          pure VerifyOrderResult {index = i, calledValue = calledValue, expectedValue}-      )-      expectedValues--mapWithIndex :: (Int -> a -> b) -> [a] -> [b]-mapWithIndex f xs = [f i x | (i, x) <- zip [0 ..] xs]- -- Legacy shouldApply* helpers removed. Use shouldBeCalled API instead.  type family PrependParam a rest where@@ -298,6 +121,31 @@ -- | Constraint alias for resolvable mock types with specific params. type ResolvableMockWithParams m params = (ResolvableParamsOf m ~ params, ResolvableMock m) ++++++verificationFailure :: IO a+verificationFailure =+  errorWithoutStackTrace verificationFailureMessage++++requireResolved ::+  forall target params.+  ( params ~ ResolvableParamsOf target+  , Typeable params+  , Typeable (InvocationRecorder params)+  ) =>+  target ->+  IO [ResolvedMock params]+requireResolved target = do+  candidates <- resolveForVerification target+  case candidates of+    [] -> verificationFailure+    _ -> pure $ map (\(name, recorder) -> ResolvedMock name recorder) candidates+ resolveForVerification ::   forall target params.   ( params ~ ResolvableParamsOf target@@ -324,74 +172,6 @@           pure $ (name, verifier) : matchRest         Nothing -> findCompatible rest ---- | Verify that the mock was called the expected number of times---   Returns Nothing on success, or Just errorMessage on failure.-tryVerifyCallCount ::-  Maybe MockName ->-  InvocationRecorder params ->-  CountVerifyMethod ->-  IO (Maybe String)-tryVerifyCallCount maybeName recorder method = do-  invocationList <- readInvocationList (invocationRef recorder)-  let callCount = length invocationList-  if compareCount method callCount-    then pure Nothing-    else pure $ Just $ countMismatchMessage maybeName method callCount---- | Verify that a function was called the expected number of times---   Throw error if verification fails.-verifyCallCount ::-  Maybe MockName ->-  InvocationRecorder params ->-  CountVerifyMethod ->-  IO ()-verifyCallCount maybeName recorder method = do-  result <- tryVerifyCallCount maybeName recorder method-  case result of-    Nothing -> pure ()-    Just msg -> errorWithoutStackTrace msg----- | Generate error message for count mismatch-countMismatchMessage :: Maybe MockName -> CountVerifyMethod -> Int -> String-countMismatchMessage maybeName method callCount =-  intercalate-    "\n"-    [ "function" <> mockNameLabel maybeName <> " was not called the expected number of times.",-      "  expected: " <> showCountMethod method,-      "   but got: " <> show callCount-    ]-  where-    showCountMethod (Equal n) = show n-    showCountMethod (LessThanEqual n) = "<= " <> show n-    showCountMethod (GreaterThanEqual n) = ">= " <> show n-    showCountMethod (LessThan n) = "< " <> show n-    showCountMethod (GreaterThan n) = "> " <> show n--verificationFailure :: IO a-verificationFailure =-  errorWithoutStackTrace verificationFailureMessage--data ResolvedMock params = ResolvedMock {-  resolvedMockName :: Maybe MockName,-  resolvedMockRecorder :: InvocationRecorder params-}--requireResolved ::-  forall target params.-  ( params ~ ResolvableParamsOf target-  , Typeable params-  , Typeable (InvocationRecorder params)-  ) =>-  target ->-  IO [ResolvedMock params]-requireResolved target = do-  candidates <- resolveForVerification target-  case candidates of-    [] -> verificationFailure-    _ -> pure $ map (\(name, recorder) -> ResolvedMock name recorder) candidates- verificationFailureMessage :: String verificationFailureMessage =   intercalate@@ -634,7 +414,6 @@         Just (VerifyFailed msg) -> pure $ Just msg              AnyVerification -> do-      -- Logic for AnyVerification (called at least once)       if null invocationList         then pure $ Just $ intercalate "\n" ["Function" <> mockNameLabel mockName <> " was never called"]         else pure Nothing

@@ -9,25 +9,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}  {- | withMock: Declarative mock expectations DSL--This module provides a declarative way to define mock functions with expectations-that are automatically verified when the 'withMock' block completes.--Example:--@-withMock $ do-  mockFn <- mock (any ~> True)-    `expects` do-      called once `with` "a"-  -  evaluate $ mockFn "a"-@ -} module Test.MockCat.WithMock   ( withMock@@ -40,83 +25,44 @@   , once   , never   , atLeast+  , atMost+  , greaterThan+  , lessThan   , anything   , WithMockContext(..)   , MonadWithMockContext(..)   , Expectation(..)   , Expectations(..)+  , verifyExpectationDirect   ) where -import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Reader (ReaderT(..), runReaderT, MonadReader(..), ask)-import Control.Concurrent.STM (TVar, newTVarIO, readTVarIO, modifyTVar', atomically)-import Control.Monad.State (State, get, put, modify, execState)-import Test.MockCat.Verify-  ( ResolvableParamsOf-  , ResolvableMock--  , verifyResolvedAny-  , verifyCallCount-  , verifyResolvedMatch-  , verifyResolvedCount-  , verifyResolvedOrder-  , ResolvedMock(..)-  , VerificationSpec(..)-  , TimesSpec(..)-  , times-  , once-  , never-  , atLeast-  , anything-+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (ReaderT(..), runReaderT)+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.Types-  ( CountVerifyMethod(..)-  , VerifyOrderMethod(..)-  , VerifyMatchType(..)+  ( VerifyOrderMethod(..)+  , WithMockContext(..)+  , MonadWithMockContext(..)+  , Expectation(..)+  , Expectations(..)+  , runExpectations+  , addExpectation   , InvocationRecorder(..)+  , ResolvedMock(..)   ) import qualified Test.MockCat.Internal.MockRegistry as MockRegistry+ import Test.MockCat.Param (Param(..), param) import Data.Kind (Type) import Data.Proxy (Proxy(..)) --- | Mock expectation context holds verification actions to run at the end---   of the `withMock` block. Storing `IO ()` avoids forcing concrete param---   types at registration time.-newtype WithMockContext = WithMockContext (TVar [IO ()]) -class MonadWithMockContext m where-  askWithMockContext :: m WithMockContext -instance {-# OVERLAPPABLE #-} (MonadReader WithMockContext m) => MonadWithMockContext m where-  askWithMockContext = ask---- | Expectation specification-data Expectation params where-  -- | Count expectation with specific arguments-  CountExpectation :: CountVerifyMethod -> params -> Expectation params-  -- | Count expectation without arguments (any arguments)-  CountAnyExpectation :: CountVerifyMethod -> Expectation params-  -- | Order expectation-  OrderExpectation :: VerifyOrderMethod -> [params] -> Expectation params-  -- | Simple expectation (at least once) with arguments-  SimpleExpectation :: params -> Expectation params-  -- | Simple expectation (at least once) without arguments-  AnyExpectation :: Expectation params---- | Expectations builder (Monad instance for do syntax)-newtype Expectations params a = Expectations (State [Expectation params] a)-  deriving (Functor, Applicative, Monad)---- | Run Expectations to get a list of expectations-runExpectations :: Expectations params a -> [Expectation params]-runExpectations (Expectations s) = execState s []---- | Add an expectation to the builder-addExpectation :: Expectation params -> Expectations params ()-addExpectation exp = Expectations $ modify (++ [exp])- -- | Run a block with mock expectations that are automatically verified withMock :: ReaderT WithMockContext IO a -> IO a withMock action = do@@ -128,30 +74,6 @@   sequence_ actions   pure result --- | Verify a single expectation using already-resolved mock.---   This avoids StableName lookup and is HPC-safe.-verifyExpectationDirect ::-  ( Show params-  , Eq params-  ) =>-  ResolvedMock params ->-  Expectation params ->-  IO ()-verifyExpectationDirect resolved expectation = do-  case expectation of-    CountExpectation (Equal 1) args ->-      verifyResolvedMatch resolved (MatchAny args)-    CountExpectation method args ->-      verifyResolvedCount resolved args method-    CountAnyExpectation count ->-      verifyCallCount (resolvedMockName resolved) (resolvedMockRecorder resolved) count-    OrderExpectation method argsList ->-      verifyResolvedOrder method resolved argsList-    SimpleExpectation args ->-      verifyResolvedMatch resolved (MatchAny args)-    AnyExpectation ->-      verifyResolvedAny resolved- -- | Attach expectations to a mock function --   Supports both single expectation and multiple expectations in a do block infixl 0 `expects`@@ -165,10 +87,6 @@   type ExpParams (Expectations params ()) = params   extractParams _ = Proxy -instance ExtractParams (VerificationSpec params) where-  type ExpParams (VerificationSpec params) = params-  extractParams _ = Proxy- instance ExtractParams (fn -> Expectations params ()) where   type ExpParams (fn -> Expectations params ()) = params   extractParams _ = Proxy@@ -184,15 +102,6 @@ instance forall fn params. (ResolvableParamsOf fn ~ params) => BuildExpectations fn (Expectations params ()) where   buildExpectations _ = runExpectations -instance forall fn params. (ResolvableParamsOf fn ~ params) => BuildExpectations fn (VerificationSpec params) where-  buildExpectations _ spec =-    case spec of-      CountVerification method args -> [CountExpectation method args]-      CountAnyVerification method -> [CountAnyExpectation method]-      OrderVerification method argsList -> [OrderExpectation method argsList]-      SimpleVerification args -> [SimpleExpectation args]-      AnyVerification -> [AnyExpectation]- -- | 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@@ -308,4 +217,3 @@   where   calledInSequence args =     addExpectation (OrderExpectation PartiallySequence (map param args))-

@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DataKinds #-}@@ -32,7 +33,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 #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}@@ -24,7 +25,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.@@ -37,7 +38,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 #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}@@ -60,7 +61,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)

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-}@@ -16,6 +17,7 @@ import Test.MockCat import Prelude hiding (readFile, writeFile, any) import Control.Monad (when)+  -- ------------------------------------------------------- -- 2. Typeclass Mocking Definitions

@@ -24,6 +24,8 @@ import Test.MockCat.THCompareSpec as THCompare import ReadmeVerifySpec as ReadmeVerify import qualified Test.MockCat.HPCFallbackSpec as HPCFallback+import qualified Test.MockCat.DeferredTypeErrorsSpec as DeferredTypeErrors+import qualified Test.MockCat.MultipleMocksSpec as MultipleMocks import Test.MockCat.UnsafeCheck () import Test.QuickCheck (property) import qualified Property.ConcurrentCountProp as ConcurrencyProp@@ -63,6 +65,8 @@     WithMockErrorDiff.spec     ReadmeVerify.spec     HPCFallback.spec+    DeferredTypeErrors.spec+    MultipleMocks.spec     describe "Property Concurrency" $ do       it "total apply count is preserved across threads" $ property ConcurrencyProp.prop_concurrent_total_apply_count     describe "Property Lazy Evaluation" $ do

@@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-}@@ -51,7 +52,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,7 +63,7 @@           callsPerThread = 20 :: Int           total = threads * callsPerThread :: Int       _ <- (runMockT $ do-        _ <- _action (any ~> (1 :: Int))+        _ <- _action ((any ~> (1 :: Int)))           `expects` do             called (times total)         parallelCallActionWithDelay threads callsPerThread@@ -71,7 +72,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@@ -81,7 +82,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 

@@ -0,0 +1,40 @@+{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}++module Test.MockCat.DeferredTypeErrorsSpec (spec) where++import Test.Hspec+import Test.MockCat+import Control.Exception (evaluate)+import Control.Monad.IO.Class (liftIO)+import Prelude hiding (any)++spec :: Spec+spec = describe "Compile-time restrictions (Deferred Type Errors)" do+  it "expects throws type error when applied directly to MockSpec instead of mock result" do+    -- This expression should fail to typecheck because `expects` requires `m fn` (monadic action),+    -- but here it is applied to `MockSpec` (pure value).+    -- With -fdefer-type-errors, this becomes a runtime error.+    let expression = (any ~> True) `expects` do+          called once+    +    evaluate expression `shouldThrow` anyException++  it "expects throws type error when applied to instantiated mock function (f)" do+    -- f <- mock ... returns a function `f`.+    -- expects expects `m fn`, not `fn`.+    -- This verifies that we cannot "attach" expectations to an existing function variable.+    -- We type-annotate the block to ensure 'mock' has a concreter context (MockT IO),+    -- so that the error is specifically about 'f' not matching 'm fn'.+    let expression :: MockT IO ()+        expression = do+          f <- mock (any ~> (1 :: Int))+          let val = f `expects` do+                called once+          _ <- liftIO $ evaluate val+          pure ()+    +    -- Since the type error is deferred inside the IO action logic, we must run it to trigger the exception.+    runMockT expression `shouldThrow` anyException+

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-}@@ -42,6 +43,7 @@ makeMock [t|Teletype|]  + class Monad m => StrictTest m where   strictFunc :: String -> m () @@ -49,6 +51,8 @@   strictFunc _ = pure ()  makeMock [t|StrictTest|]++  spec :: Spec spec = do

@@ -1,5 +1,4 @@ {-# LANGUAGE BlockArguments #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}  module Test.MockCat.HPCFallbackSpec (spec) where@@ -16,7 +15,7 @@     it "distinguishes mocks of different types" do       -- Case 1: Different types should be distinguishable by type check in fallback       f <- mock $ "a" ~> (1 :: Int)-      g <- mock $ (1 :: Int) ~> "b"+      g <- mock ((1 :: Int) ~> "b")              -- Verify f (String -> Int)       f "a" `shouldBe` 1

@@ -19,4 +19,3 @@             called once `with` "foo"       _ <- liftIO $ evaluate (f "foo")       pure ()-

@@ -0,0 +1,55 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.MockCat.MultipleMocksSpec (spec) where++import Test.Hspec+import Test.MockCat+import Control.Exception (evaluate, try, SomeException)+import Control.Monad.IO.Class (liftIO)+import Data.Either (isLeft)+import Prelude hiding (any)++spec :: Spec+spec = describe "Multiple Mocks Isolation" do+  it "expects attaches only to the target mock, not others of the same type" do+    -- This test ensures that `expects` is tightly bound to the specific mock instance+    -- it is chained from, even when multiple mocks share the same type signature.+    withMock do+      -- Define two mocks of the same type (String -> Int)+      -- f expects "A" once+      -- f expects matchers to be satisfied once+      f <- mock ("A" ~> (1 :: Int)) `expects` do+        called once+      +      -- g expects matchers to be satisfied once+      g <- mock ("B" ~> (2 :: Int)) `expects` do+        called once++      -- Call them to satisfy expectations+      _ <- liftIO $ evaluate $ f "A"+      _ <- liftIO $ evaluate $ g "B"+      +      pure ()++  it "fails when calls are crossed between identical mocks (expects isolation)" do+    -- Verify that calling f with "B" (g's expectation) does not count for g,+    -- and violates f's expectation (if strictly checked).+    -- Here we verify that f is NOT g.+    result :: Either SomeException () <- try $ withMock do+       f <- mock ("A" ~> (1 :: Int)) `expects` do+         called once+       +       _ <- 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"+       pure ()++    -- We expect failure because expectations were not met.+    result `shouldSatisfy` isLeft++

@@ -1,7 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# OPTIONS_GHC -Wno-type-defaults #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-} module Test.MockCat.ParamSpec (spec) where  import Prelude hiding (and, or)

@@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -17,6 +16,9 @@   , PartialMockDeps(..)   ) where +++import Test.MockCat.Internal.Types (InvocationRecorder) import Prelude hiding (readFile, writeFile) import Test.Hspec (Spec, it, shouldBe, describe, shouldThrow, Selector) import Test.MockCat@@ -41,30 +43,13 @@  -- Dependency record to group builders data PartialMockDeps = PartialMockDeps-  { _getInput    :: forall r m. (Verify.ResolvableParamsOf r ~ (), MonadIO m, Typeable r, Show r, Eq r) => r -> MockT m r-  , _getBy       :: forall params. ( MockBuilder params (String -> IO Int) (Param String)-                                   , Typeable (String -> IO Int)-                                   , Verify.ResolvableParamsOf (String -> IO Int) ~ Param String-                                   ) => params -> MockT IO (String -> IO Int)-  , _echo        :: forall params. ( MockBuilder params (String -> IO ()) (Param String)-                                   , Typeable (String -> IO ())-                                   , Verify.ResolvableParamsOf (String -> IO ()) ~ Param String-                                   ) => params -> MockT IO (String -> IO ())-  , _writeFile   :: forall params m. ( MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text)-                                     , MonadIO m-                                     , Typeable (FilePath -> Text -> ())-                                     , Verify.ResolvableParamsOf (FilePath -> Text -> ()) ~ (Param FilePath :> Param Text)-                                     ) => params -> MockT m (FilePath -> Text -> ())-  , _findIds     :: forall r m. (Verify.ResolvableParamsOf r ~ (), MonadIO m, Typeable r, Show r, Eq r) => r -> MockT m r-  , _findById    :: forall params m. ( MockBuilder params (Int -> String) (Param Int)-                                     , MonadIO m-                                     , Typeable (Int -> String)-                                     , Verify.ResolvableParamsOf (Int -> String) ~ Param Int-                                     ) => params -> MockT m (Int -> String)-  , _findByIdNI  :: forall params. ( MockBuilder params (Int -> IO String) (Param Int)-                                     , Typeable (Int -> IO String)-                                     , Verify.ResolvableParamsOf (Int -> IO String) ~ Param Int-                                     ) => 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 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)   }  -- Main Entry Point@@ -275,7 +260,7 @@    it "fails when _findIds is defined but findIds is never called" do     (runMockT @IO do-      _ <- _findIds ([1 :: Int, 2] :: [Int])+      _ <- _findIds (Head :> param ([1 :: Int, 2] :: [Int]))         `expects` do           called once       -- findIds is never called

@@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}@@ -32,6 +31,7 @@ import qualified Test.MockCat.Verify as Verify  + ensureVerifiable ::   ( MonadIO m   , Verify.ResolvableMock target@@ -112,46 +112,44 @@       Nothing -> lift $ echoExplicitPartial label  _readFile ::-  ( MockBuilder params (FilePath -> Text) (Param FilePath)+  ( MockDispatch (IsMockSpec params) params (MockT m) (FilePath -> Text)   , MonadIO m   ) =>   params ->   MockT m (FilePath -> Text) _readFile p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "readFile" p+  mockInstance <- unMockT $ mock (label "readFile") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "readFile") mockInstance NoVerification)   pure mockInstance  _writeFile ::-  ( MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text)+  ( MockDispatch (IsMockSpec params) params (MockT m) (FilePath -> Text -> ())   , MonadIO m   ) =>   params ->   MockT m (FilePath -> Text -> ()) _writeFile p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "writeFile" p+  mockInstance <- unMockT $ mock (label "writeFile") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "writeFile") mockInstance NoVerification)   pure mockInstance  _getInput ::-  ( Verify.ResolvableParamsOf r ~ ()+  ( MockDispatch (IsMockSpec params) params (MockT m) String   , MonadIO m-  , Typeable r-  , Show r-  , Eq r+  , Typeable (Verify.ResolvableParamsOf String)   ) =>-  r ->-  MockT m r+  params ->+  MockT m String _getInput value = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "getInput" (Head :> param value)+  mockInstance <- unMockT $ mock (label "getInput") value   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "getInput") mockInstance NoVerification)   pure mockInstance  _toUserInput ::-  ( MockBuilder params (String -> m (Maybe UserInput)) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m (Maybe UserInput))   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m (Maybe UserInput)) ~ Param String@@ -159,29 +157,29 @@   params ->   MockT m (String -> m (Maybe UserInput)) _toUserInput p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "toUserInput" p+  mockInstance <- unMockT $ mock (label "toUserInput") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "toUserInput") mockInstance NoVerification)   pure mockInstance  _getByPartial ::-  ( MockBuilder params (String -> IO Int) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT IO) (String -> IO Int)   ) =>   params ->   MockT IO (String -> IO Int) _getByPartial p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "getBy" p+  mockInstance <- unMockT $ mock (label "getBy") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "getBy") mockInstance NoVerification)   pure mockInstance  _echoPartial ::-  ( MockBuilder params (String -> IO ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT IO) (String -> IO ())   ) =>   params ->   MockT IO (String -> IO ()) _echoPartial p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "echo" p+  mockInstance <- unMockT $ mock (label "echo") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "echo") mockInstance NoVerification)   pure mockInstance@@ -212,16 +210,15 @@   _findIds ::-  ( Verify.ResolvableParamsOf r ~ ()+  ( MockDispatch (IsMockSpec p) p (MockT m) [a]   , MonadIO m-  , Typeable r-  , Show r-  , Eq r+  , Typeable [a]   ) =>-  r ->-  MockT m r+  p ->+  MockT m [a] _findIds p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_findIds" (Head :> param p)+  mockInstance <- unMockT $ mock (label "_findIds") p+   ensureVerifiable mockInstance   addDefinition     ( Definition@@ -232,13 +229,13 @@   pure mockInstance  _findById ::-  ( MockBuilder params (Int -> String) (Param Int)+  ( MockDispatch (IsMockSpec params) params (MockT m) (Int -> String)   , MonadIO m   ) =>   params ->   MockT m (Int -> String) _findById p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_findById" p+  mockInstance <- unMockT $ mock (label "_findById") p   ensureVerifiable mockInstance   addDefinition     ( Definition@@ -249,12 +246,12 @@   pure mockInstance  _findByIdNI ::-  ( MockBuilder params (Int -> IO String) (Param Int)+  ( MockDispatch (IsMockSpec params) params (MockT IO) (Int -> IO String)   ) =>   params ->   MockT IO (Int -> IO String) _findByIdNI p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_findByIdNI" p+  mockInstance <- unMockT $ mock (label "_findByIdNI") p   ensureVerifiable mockInstance   addDefinition     ( Definition

@@ -1,7 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-}

@@ -1,7 +1,5 @@ {-# LANGUAGE BlockArguments #-}-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE AllowAmbiguousTypes #-}@@ -9,7 +7,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeApplications #-}  module Test.MockCat.SharedSpecDefs   ( FileOperation(..),

@@ -16,9 +16,6 @@ data Config = Config { theme :: String, level :: Int } deriving (Show, Eq, Generic) data ComplexUser = ComplexUser { name :: String, config :: Config } deriving (Show, Eq, Generic) data DeepNode = Leaf Int | Node { val :: Int, next :: DeepNode } deriving (Show, Eq, Generic)--- No longer partial if we use it carefully, but let's just use it.--- Actually, to avoid the warning entirely, we could use different field names or separate types,--- but for a test it is fine. I will just use anyException for the RED phase. data MultiLayer = MultiLayer   { layer1 :: String,     sub :: SubLayer@@ -39,49 +36,60 @@ spec = do   describe "Error Message Diff" do     it "shows diff for string arguments" do-      f <- mock $ (any :: Param String) ~> "ok"+      f <- mock ((any :: Param String) ~> "ok")       _ <- evaluate $ f "hello haskell"       let expectedError =             "function was not called with the expected arguments.\n\-            \  expected: \"hello world\"\n\-            \   but got: \"hello haskell\"\n\-            \                   ^^^^^^^^"+            \\n\+            \  Closest match:\n\+            \    expected: \"hello world\"\n\+            \     but got: \"hello haskell\"\n\+            \            " <> replicate 9 ' ' <> "^^^^^^^^\n\+            \\n\+            \  Call history (1 calls):\n\+            \    [Closest] 1. \"hello haskell\""       f `shouldBeCalled` "hello world" `shouldThrow` errorCall expectedError      it "shows diff for long list" do-      f <- mock $ (any :: Param [Int]) ~> "ok"+      f <- mock ((any :: Param [Int]) ~> "ok")       _ <- evaluate $ f [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]\n\+            \     but got: [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]\n\+            \            " <> replicate 18 ' ' <> "^^^^^^^^^^^^^^^\n\             \  Specific difference in `[5]`:\n\             \    expected: 6\n\             \     but got: 0\n\             \              ^\n\             \\n\-            \Full context:\n\-            \  expected: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]\n\-            \   but got: [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]\n\-            \                            ^^^^^^^^^^^^^^^"+            \  Call history (1 calls):\n\+            \    [Closest] 1. [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]"       f `shouldBeCalled` [1..10] `shouldThrow` errorCall expectedError      it "shows diff for record" do-      f <- mock $ (any :: Param User) ~> "ok"+      f <- mock ((any :: Param User) ~> "ok")       _ <- evaluate $ f (User "Fagen" 20)       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: User {name = \"Fagen\", age = 30}\n\+            \     but got: User {name = \"Fagen\", age = 20}\n\+            \            " <> replicate 30 ' ' <> "^^^\n\             \  Specific difference in `age`:\n\             \    expected: 30\n\             \     but got: 20\n\             \              ^^\n\             \\n\-            \Full context:\n\-            \  expected: User {name = \"Fagen\", age = 30}\n\-            \   but got: User {name = \"Fagen\", age = 20}\n\-            \                                        ^^^"+            \  Call history (1 calls):\n\+            \    [Closest] 1. User {name = \"Fagen\", age = 20}"       f `shouldBeCalled` User "Fagen" 30 `shouldThrow` errorCall expectedError      it "shows diff for inOrderWith" do-      f <- mock $ (any :: Param String) ~> "ok"+      f <- mock ((any :: Param String) ~> "ok")       _ <- evaluate $ f "a"       _ <- evaluate $ f "b"       let expectedError =@@ -107,44 +115,55 @@       evaluate (f "aaa" 200) `shouldThrow` errorCall expectedError      it "shows diff for nested record" do-      f <- mock $ (any :: Param ComplexUser) ~> "ok"+      f <- mock ((any :: Param ComplexUser) ~> "ok")       _ <- evaluate $ f (ComplexUser "Alice" (Config "Light" 1))       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: ComplexUser {name = \"Alice\", config = Config {theme = \"Dark\", level = 1}}\n\+            \     but got: ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 1}}\n\+            \            " <> replicate 57 ' ' <> replicate 19 '^' <> "\n\             \  Specific difference in `config.theme`:\n\             \    expected: \"Dark\"\n\             \     but got: \"Light\"\n\             \               ^^^^^^\n\             \\n\-            \Full context:\n\-            \  expected: ComplexUser {name = \"Alice\", config = Config {theme = \"Dark\", level = 1}}\n\-            \   but got: ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 1}}\n\-            \                                                                   ^^^^^^^^^^^^^^^^^^^"+            \  Call history (1 calls):\n\+            \    [Closest] 1. ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 1}}"       f `shouldBeCalled` ComplexUser "Alice" (Config "Dark" 1) `shouldThrow` errorCall expectedError      it "shows diff for nested list" do-      f <- mock $ (any :: Param [[Int]]) ~> "ok"+      f <- mock ((any :: Param [[Int]]) ~> "ok")       _ <- evaluate $ f [[1, 2], [3, 4]]       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: [[1,2], [3,5]]\n\+            \     but got: [[1,2], [3,4]]\n\+            \            " <> replicate 13 ' ' <> "^^^\n\             \  Specific difference in `[1][1]`:\n\             \    expected: 5\n\             \     but got: 4\n\             \              ^\n\             \\n\-            \Full context:\n\-            \  expected: [[1,2], [3,5]]\n\-            \   but got: [[1,2], [3,4]]\n\-            \                       ^^^"+            \  Call history (1 calls):\n\+            \    [Closest] 1. [[1,2], [3,4]]"       f `shouldBeCalled` [[1, 2], [3, 5]] `shouldThrow` errorCall expectedError      it "shows multiple differences in nested record" do-      f <- mock $ (any :: Param ComplexUser) ~> "ok"+      f <- mock ((any :: Param ComplexUser) ~> "ok")       let actual = ComplexUser "Alice" (Config "Light" 2)           expected = ComplexUser "Bob" (Config "Dark" 1)       _ <- evaluate $ f actual       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: ComplexUser {name = \"Bob\", config = Config {theme = \"Dark\", level = 1}}\n\+            \     but got: ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 2}}\n\+            \            " <> replicate 23 ' ' <> replicate 53 '^' <> "\n\             \  Specific differences:\n\             \    - `name`:\n\             \        expected: \"Bob\"\n\@@ -156,64 +175,80 @@             \        expected: 1\n\             \         but got: 2\n\             \\n\-            \Full context:\n\-            \  expected: ComplexUser {name = \"Bob\", config = Config {theme = \"Dark\", level = 1}}\n\-            \   but got: ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 2}}\n\-            \                                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"+            \  Call history (1 calls):\n\+            \    [Closest] 1. ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 2}}"       f `shouldBeCalled` expected `shouldThrow` errorCall expectedError      describe "robustness (broken formats)" do       it "handles unbalanced braces gracefully (fallback to standard message)" do-         f <- mock $ (any :: Param String) ~> "ok"+         f <- mock ((any :: Param String) ~> "ok")          let actual = "{ name = \"Alice\""              expected = "{ name = \"Bob\" }"          _ <- evaluate $ f actual          let expectedError =                "function was not called with the expected arguments.\n\-               \  expected: \"{ name = \\\"Bob\\\" }\"\n\-               \   but got: \"{ name = \\\"Alice\\\"\"\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\\\"\""          f `shouldBeCalled` expected `shouldThrow` errorCall expectedError        it "handles completely broken structure strings" do-         f <- mock $ (any :: Param String) ~> "ok"+         f <- mock ((any :: Param String) ~> "ok")          let actual = "NotARecord {,,,,,}"-             expected = "NotARecord { a = 1 }"+         let expected = "NotARecord { a = 1 }"          _ <- evaluate $ f actual          let expectedError =                "function was not called with the expected arguments.\n\-               \  expected: \"NotARecord { a = 1 }\"\n\-               \   but got: \"NotARecord {,,,,,}\"\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 {,,,,,}\""          f `shouldBeCalled` expected `shouldThrow` errorCall expectedError      describe "extreme structural cases" do       it "handles extremely deep nesting" do-        f <- mock $ (any :: Param DeepNode) ~> "ok"+        f <- mock ((any :: Param DeepNode) ~> "ok")         -- 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         let expectedError =               "function was not called with the expected arguments.\n" <>+              "\n" <>+              "  Closest match:\n" <>+              "    expected: Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 1}}}}}\n" <>+              "     but got: Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 0}}}}}\n" <>+              "            " <> replicate 117 ' ' <> "^^^^^^\n" <>               "  Specific difference in `next.next.next.next.next`:\n" <>               "    expected: Leaf 1\n" <>               "     but got: Leaf 0\n" <>               "              " <> replicate 5 ' ' <> "^\n" <>               "\n" <>-              "Full context:\n" <>-              "  expected: Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 1}}}}}\n" <>-              "   but got: Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 0}}}}}\n" <>-              "            " <> replicate 115 ' ' <> "^^^^^^"+              "  Call history (1 calls):\n" <>+              "    [Closest] 1. Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 0}}}}}"         f `shouldBeCalled` expected `shouldThrow` errorCall expectedError        it "shows mismatches across multiple layers" do-        f <- mock $ (any :: Param MultiLayer) ~> "ok"+        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         let expectedError =               "function was not called with the expected arguments.\n" <>+              "\n" <>+              "  Closest match:\n" <>+              "    expected: MultiLayer {layer1 = \"X\", sub = SubLayer {layer2 = \"Y\", items = [Node {val = 1, next = Leaf 3}]}}\n" <>+              "     but got: MultiLayer {layer1 = \"A\", sub = SubLayer {layer2 = \"B\", items = [Node {val = 1, next = Leaf 2}]}}\n" <>+              "            " <> replicate 24 ' ' <> replicate 75 '^' <> "\n" <>               "  Specific differences:\n" <>               "    - `layer1`:\n" <>               "        expected: \"X\"\n" <>@@ -225,19 +260,22 @@               "        expected: Leaf 3\n" <>               "         but got: Leaf 2\n" <>               "\n" <>-              "Full context:\n" <>-              "  expected: MultiLayer {layer1 = \"X\", sub = SubLayer {layer2 = \"Y\", items = [Node {val = 1, next = Leaf 3}]}}\n" <>-              "   but got: MultiLayer {layer1 = \"A\", sub = SubLayer {layer2 = \"B\", items = [Node {val = 1, next = Leaf 2}]}}\n" <>-              "            " <> replicate 22 ' ' <> replicate 75 '^'+              "  Call history (1 calls):\n" <>+              "    [Closest] 1. MultiLayer {layer1 = \"A\", sub = SubLayer {layer2 = \"B\", items = [Node {val = 1, next = Leaf 2}]}}"         f `shouldBeCalled` expected `shouldThrow` errorCall expectedError        it "handles cases where almost everything is different" do-        f <- mock $ (any :: Param Config) ~> "ok"+        f <- mock ((any :: Param Config) ~> "ok")         let actual = Config "Light" 1             expected = Config "Dark" 99         _ <- evaluate $ f actual         let expectedError =               "function was not called with the expected arguments.\n" <>+              "\n" <>+              "  Closest match:\n" <>+              "    expected: Config {theme = \"Dark\", level = 99}\n" <>+              "     but got: Config {theme = \"Light\", level = 1}\n" <>+              "            " <> replicate 19 ' ' <> replicate 18 '^' <> "\n" <>               "  Specific differences:\n" <>               "    - `theme`:\n" <>               "        expected: \"Dark\"\n" <>@@ -246,8 +284,6 @@               "        expected: 99\n" <>               "         but got: 1\n" <>               "\n" <>-              "Full context:\n" <>-              "  expected: Config {theme = \"Dark\", level = 99}\n" <>-              "   but got: Config {theme = \"Light\", level = 1}\n" <>-              "            " <> replicate 17 ' ' <> replicate 18 '^'+              "  Call history (1 calls):\n" <>+              "    [Closest] 1. Config {theme = \"Light\", level = 1}"         f `shouldBeCalled` expected `shouldThrow` errorCall expectedError

@@ -3,7 +3,6 @@ {-# OPTIONS_GHC -Wno-type-defaults #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# OPTIONS_GHC -fno-hpc #-}-{- HLINT ignore "Use newtype instead of data" -}  module Test.MockCat.ShouldBeCalledSpec (spec) where 

@@ -4,6 +4,7 @@  import qualified Data.Text as T import Language.Haskell.TH+ import Test.Hspec import Test.MockCat.Cons ((:>)) import Test.MockCat.Param (Param)@@ -91,31 +92,8 @@           preds = partialAdditionalPredicates funType verifyParams       normalize preds `shouldBe` [] -  describe "createTypeablePreds" $ do-    it "decomposes and extracts types containing type variables and removes duplicates" $ do-      let a = mkName "a"-          b = mkName "b"-          funType = AppT (AppT ArrowT (VarT a)) (VarT b)-          verifyParams = AppT (ConT ''Param) (VarT a)-          preds = createTypeablePreds [funType, verifyParams]-      normalize preds `shouldMatchList`-        [ "Typeable a"-        , "Typeable b"-        ] -    it "extracts type families without decomposing them" $ do-      let m = mkName "m"-          assoc = AppT (ConT (mkName "ResultType")) (VarT m)-          preds = createTypeablePreds [assoc]-      normalize preds `shouldMatchList`-        [ "Typeable (ResultType m)"-        ] -    it "generates nothing for concrete types only" $ do-      let ty = AppT (ConT ''Maybe) (ConT ''Int)-          preds = createTypeablePreds [ty]-      normalize preds `shouldBe` []- normalize :: [Pred] -> [String] normalize = fmap (cleanup . pprint)   where@@ -131,4 +109,5 @@         . T.replace (T.pack "GHC.Types.") (T.pack "")         . T.replace (T.pack "Test.MockCat.Param.") (T.pack "")         . T.replace (T.pack "Test.MockCat.Verify.") (T.pack "")+        . T.replace (T.pack "([a])") (T.pack "[a]")         . T.pack

@@ -55,6 +55,8 @@       , "Show."       , "Classes."       , "Internal."+      , "Test.MockCat.Mock."+      , "Test.MockCat.Types."       ])   where     stripPrefixes [] t = t@@ -83,6 +85,7 @@     , ("((:>)", "(")     , ("(:>) ", "")     , ("(:>)", "")+    , ("([a])", "[a]")     ]   . T.replace (T.pack "Head (Param") (T.pack "Head :>Param")   . T.replace (T.pack "Head :> Param") (T.pack "Head :>Param")@@ -93,6 +96,14 @@   . T.replace (T.pack "Param r r ()") (T.pack "Param r) r ()")   -- Then handle the general case of ") r ()" -> " r ()" but only if not already fixed   . T.replace (T.pack ") r ()") (T.pack " r ()")+  . T.replace (T.pack "Typeable m,") T.empty+  . T.replace (T.pack ", Typeable m") T.empty+  . T.replace (T.pack "Typeable a,") T.empty+  . T.replace (T.pack ", Typeable a") T.empty+  . T.replace (T.pack " )") (T.pack ")")+  . T.replace (T.pack "Typeable [a]") (T.pack "Typeable a")+  . T.replace (T.pack "Typeable ([a])") (T.pack "Typeable a")+  . T.replace (T.pack "Typeable (ResultType m)") (T.pack "Typeable m")   where     applyReplacements reps txt =       L.foldl'@@ -365,7 +376,7 @@           expectationFailure "TH generated signature not found: _toUserInput"         Just sig ->           normalizeSignature sig-            `shouldSatisfy` not . T.isInfixOf (T.pack "ResolvableParamsOf") . T.pack+            `shouldNotSatisfy` T.isInfixOf (T.pack "ResolvableParamsOf") . T.pack      it "_produce signature matches handwritten" $       assertHelperSigMatches typeClassSpecPath generatedAssocSigMap "_produce"

@@ -10,13 +10,13 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ConstraintKinds #-}-{-# OPTIONS_GHC -Wno-orphans #-}-{-# OPTIONS_GHC -Wno-name-shadowing #-}-{-# OPTIONS_GHC -Wno-missing-export-lists #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE OverloadedRecordDot #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-} {- HLINT ignore "Use newtype instead of data" -}  module Test.MockCat.TypeClassCommonSpec where@@ -24,6 +24,7 @@ import Prelude hiding (readFile, writeFile, any) import Test.Hspec import Test.MockCat+ import Data.Kind (Type) import Data.Text (Text, pack, isInfixOf) import Control.Exception (ErrorCall(..), displayException)@@ -131,9 +132,9 @@   ArgsOfF r = ()  -- Generic Mock alias for a function type f-type MockFor f = forall params. (MockBuilder params f (ArgsOfF f)) => params -> MockT IO f+type MockFor f = forall params. (MockDispatch (IsMockSpec params) params (MockT IO) f) => params -> MockT IO f -- Generic Mock alias for an arbitrary base monad m-type MockForM m f = forall params. (MockBuilder params f (ArgsOfF f)) => params -> MockT m f+type MockForM m f = forall params. (MockDispatch (IsMockSpec params) params (MockT m) f) => params -> MockT m f  -- Per-spec dependency records to group required builders/mocks data BasicDeps = BasicDeps@@ -148,7 +149,7 @@   }  data MultipleDeps = MultipleDeps-  { _ask      :: Environment -> MockT IO Environment+  { _ask      :: MockFor Environment   , _readFile :: MockFor (FilePath -> Text)   , _writeFile:: MockFor (FilePath -> Text -> ())   , _post     :: MockFor (Text -> ())@@ -157,7 +158,7 @@   data ReaderContextDeps = ReaderContextDeps-  { _ask      :: Environment -> MockT IO Environment+  { _ask      :: MockFor Environment   , _readFile :: MockFor (FilePath -> Text)   , _writeFile:: MockFor (FilePath -> Text -> ())   }@@ -201,11 +202,11 @@   }  data DefaultMethodDeps = DefaultMethodDeps-  { _defaultAction :: Int -> MockT IO Int+  { _defaultAction :: MockFor Int   }  data AssociatedTypeFamiliesDeps = AssociatedTypeFamiliesDeps-  { _produce :: Int -> MockT IO Int+  { _produce :: MockFor Int   }  data ConcurrencyAndUnliftIODeps = ConcurrencyAndUnliftIODeps@@ -241,7 +242,7 @@ pattern ExplicitReturnDeps a b <- ExplicitMonadicReturnDeps { _getByExplicit = a, _echoExplicit = b }   where ExplicitReturnDeps a b = ExplicitMonadicReturnDeps { _getByExplicit = a, _echoExplicit = b } -pattern AssocTypeDeps :: (Int -> MockT IO Int) -> AssociatedTypeFamiliesDeps+pattern AssocTypeDeps :: MockFor Int -> AssociatedTypeFamiliesDeps pattern AssocTypeDeps f <- AssociatedTypeFamiliesDeps { _produce = f }   where AssocTypeDeps f = AssociatedTypeFamiliesDeps { _produce = f } @@ -347,7 +348,7 @@    it "Program skips file write when input content contains 'ngWord'" do     result <- runMockT do-      _ <- _readFile ("input.txt" ~> pack "contains ngWord")+      _ <- _readFile  ("input.txt" ~> pack "contains ngWord")       _ <- _writeFile ("output.txt" ~> any ~> ())         `expects` do           called never@@ -367,8 +368,8 @@      result <- runMockT do       _ <- _readFile $ "input.txt" ~> pack "content"-      _ <- _writeFile ("output.text" ~> pack "modifiedContent" ~> ())-      _ <- _post (pack "modifiedContent" ~> ())+      _ <- _writeFile $ ("output.text" ~> pack "modifiedContent" ~> ())+      _ <- _post $ (pack "modifiedContent" ~> ())       operationProgram2 "input.txt" "output.text" modifyContentStub      result `shouldBe` ()@@ -389,7 +390,7 @@       _ <- _ask env       _ <- _readFile ("input.txt" ~> pack "content")       _ <- _writeFile ("output.text" ~> pack "modifiedContent" ~> ())-      _ <- _post ((pack "modifiedContent" <> pack ("+" <> show env)) ~> ())+      _ <- _post (pack "modifiedContent" <> pack ("+" <> show env) ~> ())       apiFileOperationProgram modifyContentStub      result `shouldBe` ()@@ -406,8 +407,8 @@   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" ~> ())+      _ <- _readFile  ("input.txt" ~> pack "content")+      _ <- _writeFile  ("output.txt" ~> pack "content" ~> ())       operationProgram3     r `shouldBe` () @@ -564,7 +565,7 @@ specDefaultMethodMocking (DefaultMethodDeps { _defaultAction }) = do   it "Default method is successfully overridden and stubbed value is returned" do     result <- runMockT do-      _ <- _defaultAction (99 :: Int)+      _ <- _defaultAction (Head :> param (99 :: Int))       defaultAction     result `shouldBe` 99 @@ -577,7 +578,7 @@ specAssociatedTypeFamiliesSupport (AssociatedTypeFamiliesDeps { _produce }) = do   it "Associated Type family is correctly resolved and mocked stub value is returned" do     v <- runMockT do-      _ <- _produce (321 :: Int)+      _ <- _produce (Head :> param (321 :: Int))       produce     v `shouldBe` 321 @@ -652,7 +653,7 @@         _ <- _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")@@ -660,7 +661,7 @@      it "Error when write stub expects call but only readFile is executed" do       (runMockT @IO do-        _ <- _readFile ("input.txt" ~> pack "content")+        _ <- _readFile  ("input.txt" ~> pack "content")         _ <- _writeFile ("output.txt" ~> pack "content" ~> ())           `expects` do             called once@@ -676,7 +677,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 (Environment "input.txt" "output.txt")+        _ <- _ask (Head :> param (Environment "input.txt" "output.txt"))           `expects` do             called once         -- ask is never called@@ -801,14 +802,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 (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 (321 :: Int)+        _ <- _produce (Head :> param (321 :: Int))           `expects` do             called once         pure ()) `shouldThrow` missingCall "_produce"

@@ -8,12 +8,11 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DuplicateRecordFields #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE DuplicateRecordFields #-}  module Test.MockCat.TypeClassSpec (spec) where @@ -35,9 +34,9 @@ import qualified Test.MockCat.Verify as Verify import Test.MockCat.SharedSpecDefs import qualified Test.MockCat.TypeClassCommonSpec as SpecCommon-import Test.MockCat.Internal.Types (BuiltMock(..))-import qualified Test.MockCat.Internal.MockRegistry as Registry (register)+import Test.MockCat.Internal.Types (InvocationRecorder) + -- | No-op. Previously used StableName-based verification check, which breaks under HPC. --   TH-generated code doesn't need this, so we make it a no-op for consistency. ensureVerifiable :: Applicative m => a -> m ()@@ -82,52 +81,51 @@ --   state f = lift (state f)  _ask ::-  ( Verify.ResolvableParamsOf env ~ ()+  ( MockDispatch (IsMockSpec params) params (MockT m) env   , MonadIO m+  , Verify.ResolvableParamsOf env ~ ()   , Typeable env-  , Show env-  , Eq env   ) =>-  env ->+  params ->   MockT m env _ask p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "ask" (Head :> param p)+  mockInstance <- unMockT $ mock (label "ask") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "ask") mockInstance NoVerification)   pure mockInstance  _readFile ::-  ( MockBuilder params (FilePath -> Text) (Param FilePath)+  ( MockDispatch (IsMockSpec params) params (MockT m) (FilePath -> Text)   , MonadIO m   ) =>   params ->   MockT m (FilePath -> Text) _readFile p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "readFile" p+  mockInstance <- unMockT $ mock (label "readFile") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "readFile") mockInstance NoVerification)   pure mockInstance  _writeFile ::-  ( MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text)+  ( MockDispatch (IsMockSpec params) params (MockT m) (FilePath -> Text -> ())   , MonadIO m   ) =>   params ->   MockT m (FilePath -> Text -> ()) _writeFile p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "writeFile" p+  mockInstance <- unMockT $ mock (label "writeFile") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "writeFile") mockInstance NoVerification)   pure mockInstance  _post ::-  ( MockBuilder params (Text -> ()) (Param Text)+  ( MockDispatch (IsMockSpec params) params (MockT m) (Text -> ())   , MonadIO m   ) =>   params ->   MockT m (Text -> ()) _post p = MockT $ do-  mockFn <- liftIO $ createNamedMockFnWithParams "post" p+  mockFn <- unMockT $ mock (label "post") p   ensureVerifiable mockFn   addDefinition (Definition (Proxy :: Proxy "post") mockFn NoVerification)   pure mockFn@@ -292,7 +290,7 @@   mapConcurrently = traverse  _getBy ::-  ( MockBuilder params (String -> m Int) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m Int)   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m Int) ~ Param String@@ -300,13 +298,13 @@   params ->   MockT m (String -> m Int) _getBy p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_getBy" p+  mockInstance <- unMockT $ mock (label "_getBy") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_getBy") mockInstance NoVerification)   pure mockInstance  _echo ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -314,13 +312,13 @@   params ->   MockT m (String -> m ()) _echo p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_echo" p+  mockInstance <- unMockT $ mock (label "_echo") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_echo") mockInstance NoVerification)   pure mockInstance  _fn2_1Sub ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -328,13 +326,13 @@   params ->   MockT m (String -> m ()) _fn2_1Sub p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fn2_1Sub" p+  mockInstance <- unMockT $ mock (label "_fn2_1Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn2_1Sub") mockInstance NoVerification)   pure mockInstance  _fn2_2Sub ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -342,13 +340,13 @@   params ->   MockT m (String -> m ()) _fn2_2Sub p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fn2_2Sub" p+  mockInstance <- unMockT $ mock (label "_fn2_2Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn2_2Sub") mockInstance NoVerification)   pure mockInstance  _fn3_1Sub ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -356,13 +354,13 @@   params ->   MockT m (String -> m ()) _fn3_1Sub p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fn3_1Sub" p+  mockInstance <- unMockT $ mock (label "_fn3_1Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn3_1Sub") mockInstance NoVerification)   pure mockInstance  _fn3_2Sub ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -370,13 +368,13 @@   params ->   MockT m (String -> m ()) _fn3_2Sub p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fn3_2Sub" p+  mockInstance <- unMockT $ mock (label "_fn3_2Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn3_2Sub") mockInstance NoVerification)   pure mockInstance  _fn3_3Sub ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -384,13 +382,13 @@   params ->   MockT m (String -> m ()) _fn3_3Sub p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fn3_3Sub" p+  mockInstance <- unMockT $ mock (label "_fn3_3Sub") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fn3_3Sub") mockInstance NoVerification)   pure mockInstance  _getValueBy ::-  ( MockBuilder params (String -> m String) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m String)   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m String) ~ Param String@@ -398,13 +396,13 @@   params ->   MockT m (String -> m String) _getValueBy p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_getValueBy" p+  mockInstance <- unMockT $ mock (label "_getValueBy") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_getValueBy") mockInstance NoVerification)   pure mockInstance  _fnState ::-  ( MockBuilder params (Maybe s -> m s) (Param (Maybe s))+  ( MockDispatch (IsMockSpec params) params (MockT m) (Maybe s -> m s)   , MonadIO m   , Typeable m   , Typeable s@@ -413,12 +411,12 @@   params ->   MockT m (Maybe s -> m s) _fnState p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fnState" p+  mockInstance <- unMockT $ mock (label "_fnState") p   addDefinition (Definition (Proxy :: Proxy "_fnState") mockInstance NoVerification)   pure mockInstance  _fnState2 ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -426,13 +424,12 @@   params ->   MockT m (String -> m ()) _fnState2 p = MockT $ do-  BuiltMock { builtMockFn = mockInstance, builtMockRecorder = verifier } <- liftIO $ buildMock (Just "_fnState2") p-  registeredFn <- liftIO $ Registry.register (Just "_fnState2") verifier mockInstance-  addDefinition (Definition (Proxy :: Proxy "_fnState2") registeredFn NoVerification)+  mockInstance <- unMockT $ mock (label "_fnState2") p+  addDefinition (Definition (Proxy :: Proxy "_fnState2") mockInstance NoVerification)   pure mockInstance  _fnParam3_1 ::-  ( MockBuilder params (Int -> Bool -> m String) (Param Int :> Param Bool)+  ( MockDispatch (IsMockSpec params) params (MockT m) (Int -> Bool -> m String)   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (Int -> Bool -> m String) ~ (Param Int :> Param Bool)@@ -440,13 +437,13 @@   params ->   MockT m (Int -> Bool -> m String) _fnParam3_1 p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fnParam3_1" p+  mockInstance <- unMockT $ mock (label "_fnParam3_1") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fnParam3_1") mockInstance NoVerification)   pure mockInstance  _fnParam3_2 ::-  ( MockBuilder params (m Int) ()+  ( MockDispatch (IsMockSpec params) params (MockT m) (m Int)   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (m Int) ~ ()@@ -454,13 +451,13 @@   params ->   MockT m (m Int) _fnParam3_2 p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fnParam3_2" p+  mockInstance <- unMockT $ mock (label "_fnParam3_2") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fnParam3_2") mockInstance NoVerification)   pure mockInstance  _fnParam3_3 ::-  ( MockBuilder params (m Bool) ()+  ( MockDispatch (IsMockSpec params) params (MockT m) (m Bool)   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (m Bool) ~ ()@@ -468,13 +465,13 @@   params ->   MockT m (m Bool) _fnParam3_3 p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_fnParam3_3" p+  mockInstance <- unMockT $ mock (label "_fnParam3_3") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_fnParam3_3") mockInstance NoVerification)   pure mockInstance  _getByExplicit ::-  ( MockBuilder params (String -> m Int) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m Int)   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m Int) ~ Param String@@ -482,13 +479,13 @@   params ->   MockT m (String -> m Int) _getByExplicit p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_getByExplicit" p+  mockInstance <- unMockT $ mock (label "_getByExplicit") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_getByExplicit") mockInstance NoVerification)   pure mockInstance  _echoExplicit ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -496,37 +493,36 @@   params ->   MockT m (String -> m ()) _echoExplicit p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_echoExplicit" p+  mockInstance <- unMockT $ mock (label "_echoExplicit") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_echoExplicit") mockInstance NoVerification)   pure mockInstance  _defaultAction ::   ( MonadIO m+  , MockDispatch (IsMockSpec params) params (MockT m) a   , Verify.ResolvableParamsOf a ~ ()   , Typeable a-  , Show a-  , Eq a   ) =>-  a ->+  params ->   MockT m a-_defaultAction value = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_defaultAction" (Head :> param value)+_defaultAction p = MockT $ do+  mockInstance <- unMockT $ mock (label "_defaultAction") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_defaultAction") mockInstance NoVerification)   pure mockInstance  _produce ::-  ( MonadIO m-  , Verify.ResolvableParamsOf a ~ ()-  , Typeable a-  , Show a-  , Eq a+  ( MockDispatch (IsMockSpec p) p (MockT m) (ResultType m)+  , MonadIO m+  , Typeable (InvocationRecorder (Verify.ResolvableParamsOf (ResultType m)))+  , Typeable (Verify.ResolvableParamsOf (ResultType m))+  , Typeable (ResultType m)   ) =>-  a ->-  MockT m a-_produce value = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_produce" (Head :> param value)+  p ->+  MockT m (ResultType m)+_produce p = MockT $ do+  mockInstance <- unMockT $ mock (label "_produce") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_produce") mockInstance NoVerification)   pure mockInstance@@ -547,7 +543,7 @@     lift result  _readTTY ::-  ( MockBuilder params (m String) ()+  ( MockDispatch (IsMockSpec params) params (MockT m) (m String)   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (m String) ~ ()@@ -555,13 +551,13 @@   params ->   MockT m (m String) _readTTY p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_readTTY" p+  mockInstance <- unMockT $ mock (label "_readTTY") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_readTTY") mockInstance NoVerification)   pure mockInstance  _writeTTY ::-  ( MockBuilder params (String -> m ()) (Param String)+  ( MockDispatch (IsMockSpec params) params (MockT m) (String -> m ())   , MonadIO m   , Typeable m   , Verify.ResolvableParamsOf (String -> m ()) ~ Param String@@ -569,7 +565,7 @@   params ->   MockT m (String -> m ()) _writeTTY p = MockT $ do-  mockInstance <- liftIO $ createNamedMockFnWithParams "_writeTTY" p+  mockInstance <- unMockT $ mock (label "_writeTTY") p   ensureVerifiable mockInstance   addDefinition (Definition (Proxy :: Proxy "_writeTTY") mockInstance NoVerification)   pure mockInstance

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}

@@ -40,9 +40,14 @@     it "shows diff for string arguments" do       let expectedError =             "function was not called with the expected arguments.\n\-            \  expected: \"hello world\"\n\-            \   but got: \"hello haskell\"\n\-            \                   ^^^^^^^^"+            \\n\+            \  Closest match:\n\+            \    expected: \"hello world\"\n\+            \     but got: \"hello haskell\"\n\+            \            " <> replicate 9 ' ' <> "^^^^^^^^\n\+            \\n\+            \  Call history (1 calls):\n\+            \    [Closest] 1. \"hello haskell\""       withMock (do         f <- mock ((any :: Param String) ~> "ok") `expects` (called once `with` "hello world")         _ <- liftIO $ evaluate $ f "hello haskell"@@ -52,15 +57,18 @@     it "shows diff for long list" do       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]\n\+            \     but got: [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]\n\+            \            " <> replicate 18 ' ' <> "^^^^^^^^^^^^^^^\n\             \  Specific difference in `[5]`:\n\             \    expected: 6\n\             \     but got: 0\n\             \              ^\n\             \\n\-            \Full context:\n\-            \  expected: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]\n\-            \   but got: [1, 2, 3, 4, 5, 0, 7, 8, 9, 10]\n\-            \                            ^^^^^^^^^^^^^^^"+            \  Call history (1 calls):\n\+            \    [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]@@ -70,15 +78,18 @@     it "shows diff for record" do       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: User {name = \"Fagen\", age = 30}\n\+            \     but got: User {name = \"Fagen\", age = 20}\n\+            \            " <> replicate 30 ' ' <> "^^^\n\             \  Specific difference in `age`:\n\             \    expected: 30\n\             \     but got: 20\n\             \              ^^\n\             \\n\-            \Full context:\n\-            \  expected: User {name = \"Fagen\", age = 30}\n\-            \   but got: User {name = \"Fagen\", age = 20}\n\-            \                                        ^^^"+            \  Call history (1 calls):\n\+            \    [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)@@ -106,7 +117,7 @@             \    \"bbb\", 200\n\             \  but got:\n\             \    \"aaa\", 200\n\-            \           ^^^"+            \    " <> replicate 7 ' ' <> "^^^"       withMock (do         f <- mock $ do           onCase $ "aaa" ~> (100 :: Int) ~> "ok"@@ -118,15 +129,18 @@     it "shows diff for nested record" do       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: ComplexUser {name = \"Alice\", config = Config {theme = \"Dark\", level = 1}}\n\+            \     but got: ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 1}}\n\+            \            " <> replicate 57 ' ' <> replicate 19 '^' <> "\n\             \  Specific difference in `config.theme`:\n\             \    expected: \"Dark\"\n\             \     but got: \"Light\"\n\             \               ^^^^^^\n\             \\n\-            \Full context:\n\-            \  expected: ComplexUser {name = \"Alice\", config = Config {theme = \"Dark\", level = 1}}\n\-            \   but got: ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 1}}\n\-            \                                                                   ^^^^^^^^^^^^^^^^^^^"+            \  Call history (1 calls):\n\+            \    [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))@@ -136,15 +150,18 @@     it "shows diff for nested list" do       let expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: [[1,2], [3,5]]\n\+            \     but got: [[1,2], [3,4]]\n\+            \            " <> replicate 13 ' ' <> "^^^\n\             \  Specific difference in `[1][1]`:\n\             \    expected: 5\n\             \     but got: 4\n\             \              ^\n\             \\n\-            \Full context:\n\-            \  expected: [[1,2], [3,5]]\n\-            \   but got: [[1,2], [3,4]]\n\-            \                       ^^^"+            \  Call history (1 calls):\n\+            \    [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]]@@ -156,6 +173,11 @@           expected = ComplexUser "Bob" (Config "Dark" 1)           expectedError =             "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: ComplexUser {name = \"Bob\", config = Config {theme = \"Dark\", level = 1}}\n\+            \     but got: ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 2}}\n\+            \            " <> replicate 23 ' ' <> replicate 53 '^' <> "\n\             \  Specific differences:\n\             \    - `name`:\n\             \        expected: \"Bob\"\n\@@ -167,10 +189,8 @@             \        expected: 1\n\             \         but got: 2\n\             \\n\-            \Full context:\n\-            \  expected: ComplexUser {name = \"Bob\", config = Config {theme = \"Dark\", level = 1}}\n\-            \   but got: ComplexUser {name = \"Alice\", config = Config {theme = \"Light\", level = 2}}\n\-            \                                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"+            \  Call history (1 calls):\n\+            \    [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@@ -183,9 +203,14 @@              expected = "{ name = \"Bob\" }"              expectedError =                 "function was not called with the expected arguments.\n\-                \  expected: \"{ name = \\\"Bob\\\" }\"\n\-                \   but got: \"{ name = \\\"Alice\\\"\"\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@@ -194,12 +219,17 @@        it "handles completely broken structure strings" do          let actual = "NotARecord {,,,,,}"-             expected = "NotARecord { a = 1 }"-             expectedError =+         let expected = "NotARecord { a = 1 }"+         let expectedError =                 "function was not called with the expected arguments.\n\-                \  expected: \"NotARecord { a = 1 }\"\n\-                \   but got: \"NotARecord {,,,,,}\"\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@@ -212,16 +242,19 @@         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}}}}}             expectedError =-              "function was not called with the expected arguments.\n" <>-              "  Specific difference in `next.next.next.next.next`:\n" <>-              "    expected: Leaf 1\n" <>-              "     but got: Leaf 0\n" <>-              "              " <> replicate 5 ' ' <> "^\n" <>-              "\n" <>-              "Full context:\n" <>-              "  expected: Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 1}}}}}\n" <>-              "   but got: Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 0}}}}}\n" <>-              "            " <> replicate 115 ' ' <> "^^^^^^"+              "function was not called with the expected arguments.\n\+              \\n\+              \  Closest match:\n\+              \    expected: Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 1}}}}}\n\+              \     but got: Node {val = 1, next = Node {val = 2, next = Node {val = 3, next = Node {val = 4, next = Node {val = 5, next = Leaf 0}}}}}\n\+              \            " <> replicate 117 ' ' <> "^^^^^^\n\+              \  Specific difference in `next.next.next.next.next`:\n\+              \    expected: Leaf 1\n\+              \     but got: Leaf 0\n\+              \              " <> replicate 5 ' ' <> "^\n\+              \\n\+              \  Call history (1 calls):\n\+              \    [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@@ -232,22 +265,25 @@         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}]}}             expectedError =-              "function was not called with the expected arguments.\n" <>-              "  Specific differences:\n" <>-              "    - `layer1`:\n" <>-              "        expected: \"X\"\n" <>-              "         but got: \"A\"\n" <>-              "    - `sub.layer2`:\n" <>-              "        expected: \"Y\"\n" <>-              "         but got: \"B\"\n" <>-              "    - `sub.items[0].next`:\n" <>-              "        expected: Leaf 3\n" <>-              "         but got: Leaf 2\n" <>-              "\n" <>-              "Full context:\n" <>-              "  expected: MultiLayer {layer1 = \"X\", sub = SubLayer {layer2 = \"Y\", items = [Node {val = 1, next = Leaf 3}]}}\n" <>-              "   but got: MultiLayer {layer1 = \"A\", sub = SubLayer {layer2 = \"B\", items = [Node {val = 1, next = Leaf 2}]}}\n" <>-              "            " <> replicate 22 ' ' <> replicate 75 '^'+              "function was not called with the expected arguments.\n\+              \\n\+              \  Closest match:\n\+              \    expected: MultiLayer {layer1 = \"X\", sub = SubLayer {layer2 = \"Y\", items = [Node {val = 1, next = Leaf 3}]}}\n\+              \     but got: MultiLayer {layer1 = \"A\", sub = SubLayer {layer2 = \"B\", items = [Node {val = 1, next = Leaf 2}]}}\n\+              \            " <> replicate 24 ' ' <> replicate 75 '^' <> "\n\+              \  Specific differences:\n\+              \    - `layer1`:\n\+              \        expected: \"X\"\n\+              \         but got: \"A\"\n\+              \    - `sub.layer2`:\n\+              \        expected: \"Y\"\n\+              \         but got: \"B\"\n\+              \    - `sub.items[0].next`:\n\+              \        expected: Leaf 3\n\+              \         but got: Leaf 2\n\+              \\n\+              \  Call history (1 calls):\n\+              \    [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@@ -258,19 +294,22 @@         let actual = Config "Light" 1             expected = Config "Dark" 99             expectedError =-              "function was not called with the expected arguments.\n" <>-              "  Specific differences:\n" <>-              "    - `theme`:\n" <>-              "        expected: \"Dark\"\n" <>-              "         but got: \"Light\"\n" <>-              "    - `level`:\n" <>-              "        expected: 99\n" <>-              "         but got: 1\n" <>-              "\n" <>-              "Full context:\n" <>-              "  expected: Config {theme = \"Dark\", level = 99}\n" <>-              "   but got: Config {theme = \"Light\", level = 1}\n" <>-              "            " <> replicate 17 ' ' <> replicate 18 '^'+              "function was not called with the expected arguments.\n\+              \\n\+              \  Closest match:\n\+              \    expected: Config {theme = \"Dark\", level = 99}\n\+              \     but got: Config {theme = \"Light\", level = 1}\n\+              \            " <> replicate 19 ' ' <> replicate 18 '^' <> "\n\+              \  Specific differences:\n\+              \    - `theme`:\n\+              \        expected: \"Dark\"\n\+              \         but got: \"Light\"\n\+              \    - `level`:\n\+              \        expected: 99\n\+              \         but got: 1\n\+              \\n\+              \  Call history (1 calls):\n\+              \    [Closest] 1. Config {theme = \"Light\", level = 1}"         withMock (do           f <- mock ((any :: Param Config) ~> "ok") `expects` (called once `with` expected)           _ <- liftIO $ evaluate $ f actual

@@ -1,5 +1,5 @@ {-# LANGUAGE BlockArguments #-}-{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DataKinds #-}@@ -7,6 +7,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -44,39 +45,39 @@ spec = do   describe "withMock basic functionality" $ do     it "simple mock with expects" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any ~> True)           `expects` (called once `with` "a")         liftIO $ mockFn "a" `shouldBe` True      it "simple mock with expects using param" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any ~> True)           `expects` (called once `with` param "a")         liftIO $ mockFn "a" `shouldBe` True      it "fails when not called" $ do-      withMock (do+      withMock (do          _ <- mock (any ~> True)           `expects` (called once `with` "a")         pure ()) `shouldThrow` anyErrorCall      it "error message when not called" $ do-      result <- try $ withMock $ do+      result <- try $ withMock $ do          _ <- mock (any ~> True)           `expects` (called once `with` "a")         pure ()       case result of         Left (ErrorCall msg) -> do           let expected =-                "function was not called with the expected arguments.\n" <>-                "  expected: \"a\"\n" <>-                "  but the function was never called"+                "function was not called the expected number of times with the expected arguments.\n" <>+                "  expected: 1\n" <>+                "   but got: 0"           msg `shouldBe` expected         _ -> fail "Expected ErrorCall"      it "atLeast expectation" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any ~> True)           `expects` (called (atLeast 2) `with` "a") @@ -85,20 +86,20 @@         void $ liftIO $ evaluate $ mockFn "a"      it "anything expectation" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any ~> True)           `expects` called once          void $ liftIO $ evaluate $ mockFn "a"      it "anything expectation fails when not called" $ do-      withMock (do+      withMock (do          _ <- mock (any @String ~> True)           `expects` called once         pure ()) `shouldThrow` anyErrorCall      it "anything expectation error message when not called" $ do-      result <- try $ withMock $ do+      result <- try $ withMock $ do          _ <- mock (any @String ~> True)           `expects` called once         pure ()@@ -112,34 +113,34 @@         _ -> fail "Expected ErrorCall"      it "never expectation without args succeeds when not called" $ do-      withMock $ do+      withMock $ do          _ <- mock (any @String ~> True)           `expects` called never         pure ()      it "never expectation without args fails when called" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `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+      withMock $ do          mockFn <- mock (any @String ~> True)           `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+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` (called never `with` "z")         liftIO $ mockFn "z" `shouldBe` True         pure ()) `shouldThrow` anyErrorCall      it "multiple expectations in do block" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any @String ~> True)           `expects` do             called (times 2) `with` "a"@@ -150,7 +151,7 @@         pure ()      it "multiple expectations in do block fails when not all satisfied" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` do             called (times 2) `with` "a"@@ -161,7 +162,7 @@         pure ()) `shouldThrow` anyErrorCall      it "multiple expectations in do block with never" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any @String ~> True)           `expects` do             called once `with` "a"@@ -170,7 +171,7 @@         pure ()      it "multiple expectations in do block with never fails when violated" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` do             called once `with` "a"@@ -180,7 +181,7 @@         pure ()) `shouldThrow` anyErrorCall      it "multiple expectations with different counts" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any @String ~> True)           `expects` do             called (times 3) `with` "a"@@ -195,7 +196,7 @@         pure ()      it "multiple expectations fails when count is insufficient" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` do             called (times 3) `with` "a"@@ -207,7 +208,7 @@         pure ()) `shouldThrow` anyErrorCall      it "multiple expectations fails when atLeast is not satisfied" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` do             called (atLeast 2) `with` "a"@@ -218,7 +219,7 @@         pure ()) `shouldThrow` anyErrorCall      it "multiple expectations with mixed never and count" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any @String ~> True)           `expects` do             called (times 2) `with` "a"@@ -230,7 +231,7 @@         pure ()      it "multiple expectations with never fails when never is violated" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` do             called (times 2) `with` "a"@@ -244,7 +245,7 @@    describe "withMock verification failures" $ do     it "fails when called fewer times than expected" $ do-      withMock (do+      withMock (do          mockFn <- mock (any ~> True)           `expects` do             called (times 3) `with` "a"@@ -254,7 +255,7 @@         pure ()) `shouldThrow` anyErrorCall      it "fails when called with unexpected arguments" $ do-      withMock (do+      withMock (do          mockFn <- mock (any ~> True)           `expects` do             called once `with` "a"@@ -263,7 +264,7 @@         pure ()) `shouldThrow` anyErrorCall      it "fails when called but never expected" $ do-      withMock (do+      withMock (do          mockFn <- mock (any ~> True)           `expects` do             called never `with` "z"@@ -283,7 +284,7 @@    describe "order verification" $ do     it "calledInOrder succeeds when called in correct order" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any @String ~> True)           `expects` do             calledInOrder ["a", "b", "c"]@@ -294,7 +295,7 @@         pure ()      it "calledInOrder fails when called in wrong order" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` do             calledInOrder ["a", "b", "c"]@@ -305,7 +306,7 @@         pure ()) `shouldThrow` anyErrorCall      it "calledInOrder fails when not all calls are made" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` do             calledInOrder ["a", "b", "c"]@@ -316,7 +317,7 @@         pure ()) `shouldThrow` anyErrorCall      it "calledInSequence succeeds when sequence is followed" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any @String ~> True)           `expects` do             calledInSequence ["a", "c"]@@ -327,7 +328,7 @@         pure ()      it "calledInSequence fails when sequence is violated" $ do-      withMock (do+      withMock (do          mockFn <- mock (any @String ~> True)           `expects` do             calledInSequence ["a", "c"]@@ -337,7 +338,7 @@         pure ()) `shouldThrow` anyErrorCall      it "calledInSequence succeeds with extra calls in between" $ do-      withMock $ do+      withMock $ do          mockFn <- mock (any @String ~> True)           `expects` do             calledInSequence ["a", "c"]@@ -350,10 +351,10 @@    describe "multiple mocks" $ do     it "can define multiple mocks in withMock" $ do-      withMock $ do+      withMock $ do          fn1 <- mock (any @String ~> True)           `expects` do-            called once `with` "a"+            called once `with` "a"           fn2 <- mock (any @String ~> any @String ~> False)           `expects` do@@ -366,14 +367,14 @@   describe "withMock scope isolation" $ do     it "mocks from different withMock blocks do not interfere" $ do       -- First withMock block: expect one call-      withMock $ do+      withMock $ do          fn1 <- mock (any ~> True)           `expects` do             called once `with` "a"         liftIO $ evaluate $ fn1 "a"        -- Second withMock block: expect zero (if leaked, would see 1 and fail)-      withMock $ do+      withMock $ do          _ <- mock (any ~> True)           `expects` do             called never `with` "a"@@ -459,4 +460,3 @@           runInIO $ void $ liftIO $ evaluate $ mockFn "first"           runInIO $ void $ liftIO $ evaluate $ mockFn "second"           runInIO $ void $ liftIO $ evaluate $ mockFn "third"-