mockcat 1.2.0.0 → 1.2.1.0

raw patch · 25 files changed

+485/−152 lines, 25 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README-ja.md +6/−3
• README.md +6/−3
• mockcat.cabal +2/−1
• src/Test/MockCat/Internal/Builder.hs +36/−21
• src/Test/MockCat/Internal/Verify.hs +33/−21
• src/Test/MockCat/Mock.hs +8/−4
• src/Test/MockCat/Param.hs +105/−46
• src/Test/MockCat/TH.hs +73/−8
• src/Test/MockCat/TH/FunctionBuilder.hs +1/−0
• src/Test/MockCat/Verify.hs +10/−10
• src/Test/MockCat/WithMock.hs +2/−2
• test/Test/MockCat/ConfirmTHSpec.hs +40/−0
• test/Test/MockCat/MockSpec.hs +0/−10
• test/Test/MockCat/ParamSpec.hs +2/−2
• test/Test/MockCat/SharedSpecDefs.hs +9/−1
• test/Test/MockCat/ShouldBeCalledErrorDiffSpec.hs +23/−7
• test/Test/MockCat/ShouldBeCalledSpec.hs +2/−0
• test/Test/MockCat/StubSpec.hs +12/−0
• test/Test/MockCat/THCompareSpec.hs +6/−0
• test/Test/MockCat/TypeClassCommonSpec.hs +23/−0
• test/Test/MockCat/TypeClassSpec.hs +24/−1
• test/Test/MockCat/TypeClassTHSpec.hs +2/−0
• test/Test/MockCat/WithMockErrorDiffSpec.hs +23/−6
• test/Test/MockCat/WithMockSpec.hs +27/−6

@@ -6,6 +6,16 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.2.1.0] - 2026-01-01+### Added+- **Dynamic Language Extension Detection**: `mockcat` now automatically identifies and requests only necessary extensions (e.g., `MultiParamTypeClasses`, `UndecidableInstances`) based on the target class definition.+- **Granular Extension Optimization**: Simple multi-parameter type classes no longer require `AllowAmbiguousTypes` or `FunctionalDependencies` unless they are actually used.++### Fixed+- Resolved `NoVerification` scope issues in Template Haskell generated code.+- Resolved ambiguous `any` occurrences in internal Template Haskell logic.+- Fixed several typos in Template Haskell error messages.+ ## [1.2.0.0] - 2025-12-31 ### Changed - **Breaking Change**: Changed the fixity of `expects` operator to `infixl 0` to resolve precedence issues with `$`.

@@ -177,12 +177,12 @@  ```haskell {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}  class Monad m => FileSystem m where   readFile :: FilePath -> m String@@ -197,6 +197,9 @@ -- 純粋な値を自動的にモナド（m String など）に包んで返します。 makeAutoLiftMock [t|FileSystem|] ```++> [!NOTE]+> クラスの定義に応じてさらなる言語拡張（`MultiParamTypeClasses` や `UndecidableInstances` など）が必要な場合、Mockcat はコンパイル時に詳細なエラーメッセージを表示して通知します。  テストコード内では `runMockT` ブロックを使用します。 

@@ -179,12 +179,12 @@  ```haskell {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}  class Monad m => FileSystem m where   readFile :: FilePath -> m String@@ -199,6 +199,9 @@ -- Automatically wraps pure values into the monad (m String). makeAutoLiftMock [t|FileSystem|] ```++> [!NOTE]+> If the class definition requires additional extensions (e.g., `MultiParamTypeClasses`, `UndecidableInstances`), Mockcat will display a detailed error message during compilation to guide you.  Use `runMockT` block in your tests. 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           mockcat-version:        1.2.0.0+version:        1.2.1.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.@@ -94,6 +94,7 @@       Support.ParamSpecNormalize       Test.MockCat.AssociationListSpec       Test.MockCat.ConcurrencySpec+      Test.MockCat.ConfirmTHSpec       Test.MockCat.ConsSpec       Test.MockCat.DeferredTypeErrorsSpec       Test.MockCat.ExampleSpec

@@ -50,18 +50,19 @@ buildCurried :: forall args r fn. BuildCurried args r fn => (args -> IO r) -> fn buildCurried = buildCurriedImpl -instance (WrapParam a, fn ~ (a -> r)) => BuildCurried (Param a) r fn where-  buildCurriedImpl f a = perform (f (wrap a))+instance (ToParamArg a, Normalize a ~ Param a, fn ~ (a -> r)) => BuildCurried (Param a) r fn where+  buildCurriedImpl f a = perform (f (toParamArg a))  instance   ( BuildCurried rest r fn-  , WrapParam a+  , ToParamArg a+  , Normalize a ~ Param a   , fn' ~ (a -> fn)   ) =>   BuildCurried (Param a :> rest) r fn'   where   buildCurriedImpl input a =-    buildCurriedImpl @rest @r @fn (input . (\rest -> wrap a :> rest))+    buildCurriedImpl @rest @r @fn (input . (\rest -> toParamArg a :> rest))  -- | Class for building a curried pure function without relying on IO. class BuildCurriedPure args r fn | args r -> fn where@@ -71,18 +72,19 @@ buildCurriedPure :: forall args r fn. BuildCurriedPure args r fn => (args -> r) -> fn buildCurriedPure = buildCurriedPureImpl -instance (WrapParam a, fn ~ (a -> r)) => BuildCurriedPure (Param a) r fn where-  buildCurriedPureImpl f a = f (wrap a)+instance (ToParamArg a, Normalize a ~ Param a, fn ~ (a -> r)) => BuildCurriedPure (Param a) r fn where+  buildCurriedPureImpl f a = f (toParamArg a)  instance   ( BuildCurriedPure rest r fn-  , WrapParam a+  , ToParamArg a+  , Normalize a ~ Param a   , fn' ~ (a -> fn)   ) =>   BuildCurriedPure (Param a :> rest) r fn'   where   buildCurriedPureImpl input a =-    buildCurriedPureImpl @rest @r @fn (input . (\rest -> wrap a :> rest))+    buildCurriedPureImpl @rest @r @fn (input . (\rest -> toParamArg a :> rest))  -- | Class for building a curried function whose result stays in IO. class BuildCurriedIO args r fn | args r -> fn where@@ -92,18 +94,19 @@ buildCurriedIO :: forall args r fn. BuildCurriedIO args r fn => (args -> IO r) -> fn buildCurriedIO = buildCurriedIOImpl -instance (WrapParam a, fn ~ (a -> IO r)) => BuildCurriedIO (Param a) r fn where-  buildCurriedIOImpl f a = f (wrap a)+instance (ToParamArg a, Normalize a ~ Param a, fn ~ (a -> IO r)) => BuildCurriedIO (Param a) r fn where+  buildCurriedIOImpl f a = f (toParamArg a)  instance   ( BuildCurriedIO rest r fn-  , WrapParam a+  , ToParamArg a+  , Normalize a ~ Param a   , fn' ~ (a -> fn)   ) =>   BuildCurriedIO (Param a :> rest) r fn'   where   buildCurriedIOImpl input a =-    buildCurriedIOImpl @rest @r @fn (input . (\rest -> wrap a :> rest))+    buildCurriedIOImpl @rest @r @fn (input . (\rest -> toParamArg a :> rest))  -- | Class for creating a stub corresponding to the parameter description. class MockBuilder params fn verifyParams | params -> fn, params -> verifyParams where@@ -341,7 +344,7 @@   , ProjectionReturn params   , ArgsOf params ~ args   , ReturnOf params ~ Param r-  , Eq args+  , EqParams args   , Show args   ) @@ -349,13 +352,13 @@ extractReturnValue name params inputParams = do   validateOnly name (projArgs params) inputParams `seq` returnValue params -validateOnly :: (Eq a, Show a) => Maybe MockName -> a -> a -> ()+validateOnly :: (EqParams a, Show a) => Maybe MockName -> a -> a -> () validateOnly name expected actual = do   validateParamsPure name expected actual -validateParamsPure :: (Eq a, Show a) => Maybe MockName -> a -> a -> ()+validateParamsPure :: (EqParams a, Show a) => Maybe MockName -> a -> a -> () validateParamsPure name expected actual =-  if expected == actual+  if expected `eqParams` actual     then ()     else errorWithoutStackTrace $ message name expected actual @@ -379,7 +382,7 @@   args ->   Maybe r findReturnValuePure paramsList inputParams = do-  let matchedParams = filter (\params -> projArgs params == inputParams) paramsList+  let matchedParams = filter (\params -> projArgs params `eqParams` inputParams) paramsList   case matchedParams of     [] -> Nothing     _ -> do@@ -408,7 +411,7 @@   InvocationStep args r singleInvocationStep name params inputParams record@InvocationRecord {invocations, invocationCounts} = do   let expected = projArgs params-  if expected == inputParams+  if expected `eqParams` inputParams     then       (InvocationRecord {         invocations = invocations ++ [inputParams]@@ -424,7 +427,7 @@   InvocationStep args r casesInvocationStep name paramsList inputParams InvocationRecord {invocations, invocationCounts} = do   let newInvocations = invocations ++ [inputParams]-      matchedParams = filter (\params -> projArgs params == inputParams) paramsList+      matchedParams = filter (\params -> projArgs params `eqParams` inputParams) paramsList       expectedArgs = projArgs <$> paramsList     in case matchedParams of         [] ->@@ -432,9 +435,9 @@             Left (messageForMultiMock name expectedArgs inputParams)           )         _ ->-          let calledCount = fromMaybe 0 (lookup inputParams invocationCounts)+          let calledCount = fromMaybe 0 (lookupEqParams inputParams invocationCounts)               index = min calledCount (length matchedParams - 1)-              nextCounter = incrementCount inputParams invocationCounts+              nextCounter = incrementCountEqParams inputParams invocationCounts               nextRecord =                 InvocationRecord                   { invocations = newInvocations,@@ -447,3 +450,15 @@                   )                 Just selected ->                   (nextRecord, Right (returnValue selected))++lookupEqParams :: EqParams k => k -> [(k, v)] -> Maybe v+lookupEqParams _ [] = Nothing+lookupEqParams k ((x,y):xs)+  | eqParams k x = Just y+  | otherwise    = lookupEqParams k xs++incrementCountEqParams :: (EqParams k, Num v) => k -> [(k, v)] -> [(k, v)]+incrementCountEqParams k [] = [(k, 1)]+incrementCountEqParams k ((x,y):xs)+  | eqParams k x = (x, y + 1) : xs+  | otherwise    = (x, y) : incrementCountEqParams k xs

@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_GHC -Wno-missing-export-lists #-}@@ -10,16 +9,18 @@  import Control.Concurrent.STM (readTVarIO, TVar) import Control.Monad (guard, when)-import Data.List (intercalate, elemIndex)+import Data.List (intercalate) import Data.Maybe (catMaybes, isNothing) import Test.MockCat.Internal.Types import Test.MockCat.Internal.Message+import Test.MockCat.Param (EqParams(..))  import Prelude hiding (lookup)+import Data.Foldable (for_)  -- | 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 :: (EqParams params, Show params) => ResolvedMock params -> Expectation params -> IO () verifyExpectationDirect resolved (CountExpectation method args) =   verifyResolvedCount resolved args method verifyExpectationDirect resolved (CountAnyExpectation method) =@@ -43,7 +44,7 @@         ]  -- | Verify that mock was called with specific arguments using resolved mock directly.-verifyResolvedMatch :: (Eq params, Show params) => ResolvedMock params -> VerifyMatchType params -> IO ()+verifyResolvedMatch :: (EqParams params, Show params) => ResolvedMock params -> VerifyMatchType params -> IO () verifyResolvedMatch (ResolvedMock mockName recorder) matchType = do   invocationList <- readInvocationList (invocationRef recorder)   case doVerify mockName invocationList matchType of@@ -52,10 +53,10 @@       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 :: (EqParams 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)+  let callCount = length (filter (`eqParams` v) invocationList)   if compareCount method callCount     then pure ()     else@@ -76,11 +77,10 @@  -- | Verify overall call count (ignoring arguments) verifyResolvedCallCount :: ResolvedMock params -> CountVerifyMethod -> IO ()-verifyResolvedCallCount (ResolvedMock mockName recorder) method =-  verifyCallCount mockName recorder method+verifyResolvedCallCount (ResolvedMock mockName recorder) = verifyCallCount mockName recorder  -- | Verify call order using resolved mock directly.-verifyResolvedOrder :: (Eq params, Show params) => VerifyOrderMethod -> ResolvedMock params -> [params] -> IO ()+verifyResolvedOrder :: (EqParams 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@@ -102,9 +102,7 @@   IO () verifyCallCount maybeName recorder method = do   result <- tryVerifyCallCount maybeName recorder method-  case result of-    Nothing -> pure ()-    Just msg -> errorWithoutStackTrace msg+  for_ result errorWithoutStackTrace  tryVerifyCallCount ::   Maybe MockName ->@@ -149,16 +147,16 @@     showCountMethod (LessThan n) = "< " <> show n     showCountMethod (GreaterThan n) = "> " <> show n -doVerify :: (Eq a, Show a) => Maybe MockName -> InvocationList a -> VerifyMatchType a -> Maybe VerifyFailed+doVerify :: (EqParams a, Show a) => Maybe MockName -> InvocationList a -> VerifyMatchType a -> Maybe VerifyFailed doVerify name list (MatchAny a) = do-  guard $ notElem a list+  guard $ not (elemEqParams a list)   pure $ verifyFailedMessage name list a doVerify name list (MatchAll a) = do-  guard $ Prelude.any (a /=) list+  guard $ not (all (eqParams a) list)   pure $ verifyFailedMessage name list a  doVerifyOrder ::-  (Eq a, Show a) =>+  (EqParams a, Show a) =>   VerifyOrderMethod ->   Maybe MockName ->   InvocationList a ->@@ -169,7 +167,7 @@       pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues   | otherwise = do       let unexpectedOrders = collectUnExpectedOrder calledValues expectedValues-      guard $ length unexpectedOrders > 0+      guard $ not (null unexpectedOrders)       pure $ verifyFailedSequence name unexpectedOrders doVerifyOrder PartiallySequence name calledValues expectedValues   | length calledValues < length expectedValues = do@@ -190,13 +188,13 @@         intercalate "\n" $ ("    " <>) . show <$> calledValues       ] -isOrderNotMatched :: Eq a => InvocationList a -> [a] -> Bool+isOrderNotMatched :: EqParams a => InvocationList a -> [a] -> Bool isOrderNotMatched calledValues expectedValues =   isNothing $     foldl       ( \candidates e -> do           candidates >>= \c -> do-            index <- elemIndex e c+            index <- elemIndexEqParams e c             Just $ drop (index + 1) c       )       (Just calledValues)@@ -220,16 +218,30 @@       ( ("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 :: EqParams a => InvocationList a -> [a] -> [VerifyOrderResult a] collectUnExpectedOrder calledValues expectedValues =   catMaybes $     mapWithIndex       ( \i expectedValue -> do           let calledValue = calledValues !! i-          guard $ expectedValue /= calledValue+          guard $ not (expectedValue `eqParams` 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]++elemEqParams :: EqParams a => a -> [a] -> Bool+elemEqParams _ [] = False+elemEqParams x (y:ys) = eqParams x y || elemEqParams x ys++elemIndexEqParams :: EqParams a => a -> [a] -> Maybe Int+elemIndexEqParams x = go 0+  where+    go _ [] = Nothing+    go i (y:ys)+      | eqParams x y = Just i+      | otherwise    = go (i+1) ys++

@@ -110,9 +110,9 @@   ( ToMockParams b ~ (Head :> Param b)   , Normalize b ~ Param b   , Typeable b-  , ToParamArg b+  , WrapResult b   ) => CreateMock b where-    toParams value = Head :> toParamArg value+    toParams value = Head :> wrapResult value  -- | Label type for naming mock functions. newtype Label = Label MockName@@ -150,6 +150,8 @@   ( MonadIO m   , CreateMock p   , MockBuilder (ToMockParams p) fn verifyParams+  , Show verifyParams+  , EqParams verifyParams   , Typeable verifyParams   , Typeable fn   , IsMockSpec p ~ 'False@@ -168,7 +170,7 @@   , CreateMock params   , MockBuilder (ToMockParams params) fn verifyParams   , Show verifyParams-  , Eq verifyParams+  , EqParams verifyParams   , Typeable verifyParams   , Typeable fn   ) =>@@ -195,6 +197,8 @@   ( MonadIO m   , CreateMock p   , MockBuilder (ToMockParams p) fn verifyParams+  , Show verifyParams+  , EqParams verifyParams   , Typeable verifyParams   , Typeable fn   ) =>@@ -217,7 +221,7 @@   , CreateMock params   , MockBuilder (ToMockParams params) fn verifyParams   , Show verifyParams-  , Eq verifyParams+  , EqParams verifyParams   , Typeable verifyParams   , Typeable fn   ) =>

@@ -15,13 +15,17 @@ -- Parameters are used both for setting up expectations and for verification. module Test.MockCat.Param   ( Param(..),-    WrapParam(..),+    EqParams(..),+    WrapResult(wrapResult),     value,     param,     ConsGen(..),     MockSpec(..),     expect,     expect_,+    ToParamParam(..),+    ToParamArg(..),+    Normalize,     any,     ArgsOf,     ProjectionArgs,@@ -30,8 +34,7 @@     ProjectionReturn,     projReturn,     returnValue,-    Normalize,-    ToParamArg(..)+   ) where @@ -63,55 +66,54 @@   -- | A parameter that wraps a value without Eq or Show constraints.   ValueWrapper :: v -> String -> Param v --- | Class for wrapping raw values into Param.--- For types with Show and Eq, it uses ExpectValue to enable comparison and display.--- For other types, it uses ValueWrapper.-class WrapParam a where-  wrap :: a -> Param a -instance {-# OVERLAPPING #-} WrapParam String where-  wrap s = ExpectValue s (show s)+-- | Class for wrapping raw values into Param for results.+-- Does not require Eq or Show, but will use them if available for better display.+class WrapResult a where+  wrapResult :: a -> Param a -instance {-# OVERLAPPING #-} WrapParam Int where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPING #-} WrapResult String where+  wrapResult s = ExpectValue s (show s) -instance {-# OVERLAPPING #-} WrapParam Integer where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPING #-} WrapResult Int where+  wrapResult v = ExpectValue v (show v) -instance {-# OVERLAPPING #-} WrapParam Bool where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPING #-} WrapResult Integer where+  wrapResult v = ExpectValue v (show v) -instance {-# OVERLAPPING #-} WrapParam Double where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPING #-} WrapResult Bool where+  wrapResult v = ExpectValue v (show v) -instance {-# OVERLAPPING #-} WrapParam Float where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPING #-} WrapResult Double where+  wrapResult v = ExpectValue v (show v) -instance {-# OVERLAPPING #-} WrapParam Char where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPING #-} WrapResult Float where+  wrapResult v = ExpectValue v (show v) -instance {-# OVERLAPPING #-} WrapParam T.Text where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPING #-} WrapResult Char where+  wrapResult v = ExpectValue v (show v) -instance {-# OVERLAPPING #-} (Show a, Eq a) => WrapParam [a] where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPING #-} WrapResult T.Text where+  wrapResult v = ExpectValue v (show v) -instance {-# OVERLAPPING #-} (Show a, Eq a) => WrapParam (Maybe a) where-  wrap v = ExpectValue v (show v)+instance {-# OVERLAPPABLE #-} (Show a, Eq a) => WrapResult (Maybe a) where+  wrapResult v = ExpectValue v (show v) -instance {-# OVERLAPPABLE #-} WrapParam a where-  wrap v = ValueWrapper v "ValueWrapper"+instance {-# OVERLAPPABLE #-} WrapResult a where+  wrapResult v = ValueWrapper v "ValueWrapper"  instance Eq (Param a) where-  (ExpectValue a _) == (ExpectValue b _) = a == b-  (ExpectValue a _) == (ExpectCondition m2 _) = m2 a-  (ExpectCondition m1 _) == (ExpectValue b _) = m1 b-  (ExpectCondition _ l1) == (ExpectCondition _ l2) = l1 == l2-  ValueWrapper a _ == ExpectCondition m _ = m a-  ExpectCondition m _ == ValueWrapper a _ = m a+  ExpectValue a _ == ExpectValue b _ = a == b   ExpectValue a _ == ValueWrapper b _ = a == b+  ExpectValue a _ == ExpectCondition m _ = m a+  ValueWrapper a _ == ValueWrapper b _ = compareFunction a b   ValueWrapper a _ == ExpectValue b _ = a == b-  ValueWrapper _ _ == ValueWrapper _ _ = False+  ValueWrapper a _ == ExpectCondition m _ = m a+  ExpectCondition m _ == ExpectValue b _ = m b+  ExpectCondition m _ == ValueWrapper a _ = m a+  ExpectCondition _ "any" == ExpectCondition _ _ = True+  ExpectCondition _ _ == ExpectCondition _ "any" = True+  ExpectCondition _ l1 == ExpectCondition _ l2 = l1 == l2  instance Show (Param v) where   show (ExpectValue _ l) = l@@ -138,18 +140,75 @@ class ToParamArg a where   toParamArg :: a -> Normalize a + instance {-# OVERLAPPING #-} (Typeable (a -> b)) => ToParamArg (a -> b) where-  toParamArg f = ExpectCondition (compareFunction f) (showFunction f)+  toParamArg f = ValueWrapper f (showFunction f) -instance {-# OVERLAPPING #-} ToParamArg (Param a) where-  toParamArg = id+class EqParams a where+  eqParams :: a -> a -> Bool -instance {-# OVERLAPPABLE #-} (Normalize a ~ Param a, WrapParam a) => ToParamArg a where-  toParamArg = wrap+instance {-# OVERLAPPING #-} EqParams (Param a) where+  eqParams = (==) +instance {-# OVERLAPPING #-} (EqParams a, EqParams b) => EqParams (a :> b) where+  (a1 :> b1) `eqParams` (a2 :> b2) = a1 `eqParams` a2 && b1 `eqParams` b2++instance {-# OVERLAPPING #-} EqParams Head where+  eqParams _ _ = True++instance EqParams () where+  eqParams _ _ = True+++ instance {-# OVERLAPPING #-} ToParamArg Head where   toParamArg = id +instance {-# OVERLAPPING #-} ToParamArg Int where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} ToParamArg Integer where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} ToParamArg Double where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} ToParamArg Float where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} ToParamArg Bool where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} ToParamArg Char where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} ToParamArg Word where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} ToParamArg T.Text where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} (Show a, Eq a) => ToParamArg [a] where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPING #-} (Show a, Eq a) => ToParamArg (Maybe a) where+  toParamArg v = ExpectValue v (show v)++instance {-# OVERLAPPABLE #-} (Normalize a ~ Param a, Typeable a, Show a) => ToParamArg a where+  toParamArg v = ValueWrapper v (show v)++class ToParamParam a where+  toParamParam :: a -> Normalize a++instance {-# OVERLAPPING #-} ToParamParam (Param a) where+  toParamParam = id++instance {-# OVERLAPPING #-} (Typeable (a -> b)) => ToParamParam (a -> b) where+  toParamParam f = ValueWrapper f (showFunction f)++instance {-# OVERLAPPABLE #-} (Normalize a ~ Param a, Show a, Eq a) => ToParamParam a where+  toParamParam v = ExpectValue v (show v)+ class ToParamResult b where   toParamResult :: b -> Normalize b @@ -159,15 +218,15 @@ instance {-# OVERLAPPING #-} ToParamResult (a :> b) where   toParamResult = id -instance {-# OVERLAPPABLE #-} (Normalize b ~ Param b, WrapParam b) => ToParamResult b where-  toParamResult = wrap+instance {-# OVERLAPPABLE #-} (Normalize b ~ Param b, WrapResult b) => ToParamResult b where+  toParamResult = wrapResult  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)+instance (ToParamParam a, ToParamResult b) => ConsGen a b where+  a ~> b = toParamParam a :> toParamResult b  -- | Make a parameter to which any value is expected to apply. --   Use with type application to specify the type: @any \@String@

@@ -21,7 +21,7 @@   ) where -import Control.Monad (unless)+import Control.Monad (unless, when) import Data.List (elemIndex, nub) import Data.Maybe (catMaybes) import qualified Data.Map.Strict as Map@@ -31,6 +31,7 @@     Dec (..),     Exp (..),     Extension (..),+    FunDep,     Info (..),     Lit (..),     Name,@@ -256,10 +257,10 @@  doMakeMock :: Q Type -> MockType -> MockOptions -> Q [Dec] doMakeMock qType mockType options = do-  verifyRequiredExtensions   ty <- qType   let className = getClassName ty   classMetadata <- loadClassMetadata className+  verifyRequiredExtensions (cmRequirements classMetadata)   monadVarName <- selectMonadVarName classMetadata   makeMockDecs     ty@@ -271,28 +272,91 @@     (cmDecs classMetadata)     options -verifyRequiredExtensions :: Q ()-verifyRequiredExtensions =+data ClassRequirements = ClassRequirements+  { reqMultiParamTypeClasses :: Bool,+    reqFunctionalDependencies :: Bool,+    reqTypeFamilies :: Bool,+    reqTypeOperators :: Bool,+    reqHasContext :: Bool+  }++verifyRequiredExtensions :: ClassRequirements -> Q ()+verifyRequiredExtensions requirements = do+  -- Standard set of extensions required for Mockcat's machinery to function correctly   mapM_     verifyExtension-    [DataKinds, FlexibleInstances, FlexibleContexts, TypeFamilies]+    [ DataKinds,+      FlexibleInstances,+      FlexibleContexts,+      TypeApplications,+      ScopedTypeVariables,+      TypeFamilies+    ] +  -- Additional extensions required based on the specific type class definition+  when requirements.reqMultiParamTypeClasses (verifyExtension MultiParamTypeClasses)++  when+    ( (requirements.reqMultiParamTypeClasses && requirements.reqHasContext)+        || requirements.reqFunctionalDependencies+    )+    (verifyExtension UndecidableInstances)++  when requirements.reqFunctionalDependencies do+    verifyExtension AllowAmbiguousTypes+    verifyExtension FunctionalDependencies++  when requirements.reqTypeOperators (verifyExtension TypeOperators)+ loadClassMetadata :: Name -> Q ClassMetadata loadClassMetadata className = do   info <- reify className   case info of     ClassI (ClassD _ _ [] _ _) _ ->       fail $ "A type parameter is required for class " <> show className-    ClassI (ClassD cxt _ typeVars _ decs) _ ->+    ClassI (ClassD cxt name typeVars fundeps decs) _ ->       pure $         ClassMetadata           { cmName = className,             cmContext = cxt,             cmTypeVars = map convertTyVarBndr typeVars,-            cmDecs = decs+            cmDecs = decs,+            cmRequirements = detectRequirements cxt name typeVars fundeps decs           }     other -> error $ "unsupported type: " <> show other +detectRequirements :: Cxt -> Name -> [TyVarBndr a] -> [FunDep] -> [Dec] -> ClassRequirements+detectRequirements cxt className typeVars fundeps decs =+  ClassRequirements+    { reqMultiParamTypeClasses = length typeVars > 1,+      reqFunctionalDependencies = not (null fundeps),+      reqTypeFamilies = P.any isTypeFamilyDec decs,+      reqTypeOperators = P.any isOperatorName allNames,+      reqHasContext = not (null cxt)+    }+  where+    allNames = className : concatMap collectDecNames decs+    isTypeFamilyDec (OpenTypeFamilyD _) = True+    isTypeFamilyDec (ClosedTypeFamilyD _ _) = True+    isTypeFamilyDec (DataFamilyD _ _ _) = True+    isTypeFamilyDec (TySynInstD _) = True+    isTypeFamilyDec (DataInstD {}) = True+    isTypeFamilyDec _ = False++    isOperatorName n = P.any (`elem` (":!#$%&*+./<=>?@\\^|-~" :: String)) (nameBase n)++    collectDecNames (SigD n _) = [n]+    collectDecNames (OpenTypeFamilyD (TypeFamilyHead n _ _ _)) = [n]+    collectDecNames (ClosedTypeFamilyD (TypeFamilyHead n _ _ _) _) = [n]+    collectDecNames (DataFamilyD n _ _) = [n]+    collectDecNames (TySynInstD (TySynEqn _ lhs _)) = collectTypeNames lhs+    collectDecNames _ = []++    collectTypeNames (AppT t1 t2) = collectTypeNames t1 ++ collectTypeNames t2+    collectTypeNames (ConT n) = [n]+    collectTypeNames (VarT n) = [n]+    collectTypeNames _ = []+ selectMonadVarName :: ClassMetadata -> Q Name selectMonadVarName metadata = do   monadVarNames <- getMonadVarNames (cmContext metadata) (cmTypeVars metadata)@@ -451,7 +515,8 @@   { cmName :: Name,     cmContext :: Cxt,     cmTypeVars :: [TyVarBndr ()],-    cmDecs :: [Dec]+    cmDecs :: [Dec],+    cmRequirements :: ClassRequirements   }  getMonadVarNames :: Cxt -> [TyVarBndr a] -> Q [Name]

@@ -58,6 +58,7 @@ import Test.MockCat.MockT   ( MockT (..),     Definition (..),+    Verification (..),     getDefinitions,     addDefinition   )

@@ -48,7 +48,7 @@ -- | Class for verifying mock function. verify ::   ( ResolvableMock m-  , Eq (ResolvableParamsOf m)+  , EqParams (ResolvableParamsOf m)   , Show (ResolvableParamsOf m)   ) =>   m ->@@ -59,7 +59,7 @@   checkCandidates candidates $ \resolvedMock ->     doVerifyResolved resolvedMock matchType -doVerifyResolved :: (Eq params, Show params) => ResolvedMock params -> VerifyMatchType params -> IO (Maybe String)+doVerifyResolved :: (EqParams params, Show params) => ResolvedMock params -> VerifyMatchType params -> IO (Maybe String) doVerifyResolved (ResolvedMock mockName recorder) matchType = do   invocationList <- readInvocationList (invocationRef recorder)   case doVerify mockName invocationList matchType of@@ -312,8 +312,8 @@ instance ToNormalizedArg (Param a) where   toNormalizedArg = id -instance {-# OVERLAPPABLE #-} (NormalizeWithArg a ~ Param a, WrapParam a) => ToNormalizedArg a where-  toNormalizedArg = wrap+instance {-# OVERLAPPABLE #-} (NormalizeWithArg a ~ Param a, ToParamParam a, Normalize a ~ Param a) => ToNormalizedArg a where+  toNormalizedArg = toParamParam   @@ -381,7 +381,7 @@ -- | Instance for VerificationSpec (handles all verification types) instance {-# OVERLAPPING #-}   ( ResolvableMockWithParams m params-  , Eq params+  , EqParams params   , Show params   , RequireCallable "shouldBeCalled" m   ) => ShouldBeCalled m (VerificationSpec params) where@@ -390,12 +390,12 @@     checkCandidates candidates $ \resolvedMock ->       verifySpec resolvedMock spec -verifySpec :: (Eq params, Show params) => ResolvedMock params -> VerificationSpec params -> IO (Maybe String)+verifySpec :: (Typeable params, EqParams params, Show params) => ResolvedMock params -> VerificationSpec params -> IO (Maybe String) verifySpec (ResolvedMock mockName recorder) spec = do   invocationList <- readInvocationList (invocationRef recorder)   case spec of     CountVerification method args -> do-      let callCount = length (filter (args ==) invocationList)+      let callCount = length (filter (`eqParams` args) invocationList)       if compareCount method callCount         then pure Nothing         else pure $ Just $ countWithArgsMismatchMessage mockName method callCount@@ -421,7 +421,7 @@ -- | Instance for Param chains (e.g., "a" ~> "b") instance {-# OVERLAPPING #-}   ( ResolvableMockWithParams m (Param a :> rest)-  , Eq (Param a :> rest)+  , EqParams (Param a :> rest)   , Show (Param a :> rest)   , RequireCallable "shouldBeCalled" m   ) => ShouldBeCalled m (Param a :> rest) where@@ -431,7 +431,7 @@ -- | Instance for single Param (e.g., param "a") instance {-# OVERLAPPING #-}   ( ResolvableMockWithParams m (Param a)-  , Eq (Param a)+  , EqParams (Param a)   , Show (Param a)   , RequireCallable "shouldBeCalled" m   ) => ShouldBeCalled m (Param a) where@@ -442,7 +442,7 @@ --   This converts raw values to Param at runtime instance {-# OVERLAPPABLE #-}   ( ResolvableMockWithParams m (Param a)-  , Eq (Param a)+  , EqParams (Param a)   , Show (Param a)   , Show a   , Eq a

@@ -57,7 +57,7 @@   ) import qualified Test.MockCat.Internal.MockRegistry as MockRegistry -import Test.MockCat.Param (Param(..), param)+import Test.MockCat.Param (Param(..), param, EqParams(..)) import Data.Kind (Type) import Data.Proxy (Proxy(..)) @@ -117,7 +117,7 @@   , ExpParams exp ~ params   , BuildExpectations fn exp   , Show params-  , Eq params+  , EqParams params   ) =>   m fn ->   exp ->

@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE UndecidableInstances #-}+-- {-# LANGUAGE AllowAmbiguousTypes #-}+-- {-# LANGUAGE FunctionalDependencies #-}++module Test.MockCat.ConfirmTHSpec (spec) where++import Test.MockCat.SharedSpecDefs+import Test.MockCat.TH+import Test.Hspec+-- import Control.Monad.Reader.Class (MonadReader)++spec :: Spec+spec = pure ()++makeMock [t|Teletype|]+-- makeAutoLiftMock [t|FileOperation|]+-- makeAutoLiftMock [t|ApiOperation|]+-- makeMock [t|TestClass|]+-- makeAutoLiftMock [t|UserDefinedClass|]+-- makeAutoLiftMock [t|AssocTypeTest|]+-- makeAutoLiftMock [t|DefaultMethodTest|]+-- makeMock [t|ExplicitlyReturnMonadicValuesTest|]+-- makeMock [t|MultiApplyTest|]+-- makeMock [t|MonadStateSub|]+-- makeAutoLiftMock [t|MonadReader String|]+-- makeMock [t|MonadVar2_1Sub|]+-- makeMock [t|MonadVar2_2Sub|]+-- makeMock [t|MonadVar3_1Sub|]+-- makeMock [t|MonadVar3_2Sub|]+-- makeMock [t|MonadVar3_3Sub|]+-- makeMock [t|ParamThreeMonad Int Bool|]+-- makeMock [t|Finder Int String|]

@@ -75,14 +75,6 @@       it "can stub function with NoEq argument" do         let f = stub $ any @NoEq ~> "result"         f (NoEq "val") `shouldBe` "result"--      it "can mock function with NoShow argument using any" do-        f <- mock $ any @NoShow ~> "result"-        f (NoShow "val") `shouldBe` "result"--      it "can mock function with NoEqNoShow argument using any" do-        f <- mock $ any @NoEqNoShow ~> "result"-        f (NoEqNoShow "val") `shouldBe` "result"            it "can mock function with NoEq argument matching its value" do         -- Even without an Eq instance, you can match based on field values using 'expect'.@@ -214,5 +206,3 @@ errorContains sub (E.ErrorCall msg) = sub `isInfixOf` msg  data NoEq = NoEq String deriving (Show)-data NoShow = NoShow String deriving (Eq)-data NoEqNoShow = NoEqNoShow String

@@ -41,8 +41,8 @@         param 10 == param 11 `shouldBe` False       it "any (non-Eq type)" do         (P.any :: Param NoEq) == (P.any :: Param NoEq) `shouldBe` True-      it "ValueWrapper (non-Eq type) - always False" do-        wrap NoEq == wrap NoEq `shouldBe` False+      it "ValueWrapper (non-Eq type) - same pointer matches" do+        P.wrapResult NoEq == P.wrapResult NoEq `shouldBe` True      describe "Returns True if the expected value condition is met." do       it "any" do

@@ -39,7 +39,9 @@     TestClass(..),     Teletype(..),     UserInput(..),-    UserInputGetter(..)+    UserInputGetter(..),+    Post(..),+    UserDefinedClass(..)   ) where @@ -155,3 +157,9 @@ findValueNI = do   ids <- findIdsNI   mapM findByIdNI ids++data Post = Post { postId :: Int, title :: String }+  deriving (Eq, Show)++class Monad m => UserDefinedClass m where+  processPost :: Post -> m Bool

@@ -8,6 +8,7 @@  import Test.Hspec (Spec, describe, it, shouldThrow, errorCall) import Test.MockCat+import Test.MockCat.SharedSpecDefs (Post(..)) import Control.Exception (evaluate) import Prelude hiding (any) import GHC.Generics (Generic)@@ -25,13 +26,6 @@     items :: [DeepNode]   } deriving (Show, Eq, Generic) -instance WrapParam User where wrap v = ExpectValue v (show v)-instance WrapParam Config where wrap v = ExpectValue v (show v)-instance WrapParam ComplexUser where wrap v = ExpectValue v (show v)-instance WrapParam DeepNode where wrap v = ExpectValue v (show v)-instance WrapParam MultiLayer where wrap v = ExpectValue v (show v)-instance WrapParam SubLayer where wrap v = ExpectValue v (show v)- spec :: Spec spec = do   describe "Error Message Diff" do@@ -49,6 +43,28 @@             \  Call history (1 calls):\n\             \    [Closest] 1. \"hello haskell\""       f `shouldBeCalled` "hello world" `shouldThrow` errorCall expectedError++    it "shows diff for user-defined type (Post)" do+      f <- mock (Post 2 "wrong" ~> "ok")+      _ <- evaluate $ f (Post 2 "wrong")+      let expectedError =+            "function was not called with the expected arguments.\n\+            \\n\+            \  Closest match:\n\+            \    expected: Post {postId = 1, title = \"title\"}\n\+            \     but got: Post {postId = 2, title = \"wrong\"}\n\+            \              " <> replicate 15 ' ' <> "^^^^^^^^^^^^^^^^^^^\n\+            \  Specific differences:\n\+            \    - `postId`:\n\+            \        expected: 1\n\+            \         but got: 2\n\+            \    - `title`:\n\+            \        expected: \"title\"\n\+            \         but got: \"wrong\"\n\+            \\n\+            \  Call history (1 calls):\n\+            \    [Closest] 1. Post {postId = 2, title = \"wrong\"}"+      f `shouldBeCalled` Post 1 "title" `shouldThrow` errorCall expectedError      it "shows diff for long list" do       f <- mock ((any :: Param [Int]) ~> "ok")

@@ -753,3 +753,5 @@  data NoEq = NoEq String deriving (Show) ++

@@ -4,6 +4,7 @@  import Test.Hspec import Test.MockCat+import Test.MockCat.SharedSpecDefs (Post(..)) import Control.Exception (evaluate, ErrorCall(..)) import Data.List (isInfixOf) @@ -57,6 +58,17 @@             onCase $ "value2" ~> "value3" ~> False       f "value1" "value2" `shouldBe` True       f "value2" "value3" `shouldBe` False++  describe "user-defined type" $ do+    it "stub with user-defined type arguments and return value" $ do+      let f = stub $ Post 1 "title" ~> Post 2 "title2"+      f (Post 1 "title") `shouldBe` Post 2 "title2"++    it "stub with user-defined type partial application" $ do+      let f = stub $ Post 1 "title" ~> Post 2 "title2" ~> True+      f (Post 1 "title") (Post 2 "title2") `shouldBe` True++  errorContains :: String -> Selector ErrorCall errorContains sub (ErrorCall msg) = sub `isInfixOf` msg

@@ -3,7 +3,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-} {- HLINT ignore "Use fewer imports" -}  module Test.MockCat.THCompareSpec (spec) where

@@ -213,6 +213,10 @@   { _readFile :: MockFor (FilePath -> Text)   } +data UserDefinedTypeDeps = UserDefinedTypeDeps+  { _processPost :: MockFor (Post -> Bool)+  }+ -- backward-compatible constructor pattern synonyms (preserve old names used by test modules) pattern TtyDeps :: MockFor (IO String) -> MockFor (String -> IO ()) -> SequentialIODeps pattern TtyDeps r w <- SequentialIODeps { _readTTY = r, _writeTTY = w }@@ -276,6 +280,7 @@   , associatedTypeFamiliesDeps        :: AssociatedTypeFamiliesDeps   , concurrencyAndUnliftIODeps        :: ConcurrencyAndUnliftIODeps   , concurrencyDeps                   :: ConcurrencyAndUnliftIODeps+  , userDefinedTypeDeps               :: UserDefinedTypeDeps   }  -- SpecDeps is defined above; test modules construct a `SpecDeps` and call the individual specs@@ -300,6 +305,7 @@   , AssocTypeTest (MockT IO)   , ResultType (MockT IO) ~ Int   , MonadAsync (MockT IO)+  , UserDefinedClass (MockT IO)   ) =>   SpecDeps ->   Spec@@ -319,6 +325,7 @@   specAssociatedTypeFamiliesSupport deps.associatedTypeFamiliesDeps   specConcurrencyAndUnliftIO deps.concurrencyAndUnliftIODeps   specMonadReaderContextMocking deps.readerContextDeps+  specUserDefinedTypeSupport deps.userDefinedTypeDeps    -- Verification failures   specBasicVerificationFailureDetection deps.basicDeps@@ -623,6 +630,22 @@       pure content      result `shouldBe` pack "test content"++specUserDefinedTypeSupport ::+  ( UserDefinedClass (MockT IO)+  ) =>+  UserDefinedTypeDeps ->+  Spec+specUserDefinedTypeSupport (UserDefinedTypeDeps { _processPost }) = do+  it "User defined class method handles shared user-defined type correctly" do+    let p = Post 1 "title"+    runMockT @IO $ do+      _ <- _processPost $ do+         -- verify that we can match exactly on the user defined type+         onCase $ p ~> True+      +      result <- processPost p +      liftIO $ result `shouldBe` True  -- Verification Failure Tests 

@@ -10,6 +10,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-}@@ -19,7 +20,7 @@ import Data.Text (Text) import Test.Hspec (Spec) import Test.MockCat-import Prelude hiding (readFile, writeFile)+import Prelude hiding (readFile, writeFile, any) import Data.Data import Data.List (find) import GHC.TypeLits (KnownSymbol, symbolVal)@@ -570,6 +571,27 @@   addDefinition (Definition (Proxy :: Proxy "_writeTTY") mockInstance NoVerification)   pure mockInstance +_processPost ::+  ( MockDispatch (IsMockSpec params) params (MockT m) (Post -> Bool)+  , MonadIO m+  ) =>+  params ->+  MockT m (Post -> Bool)+_processPost p = MockT $ do+  mockInstance <- unMockT $ mock (label "_processPost") p+  ensureVerifiable mockInstance+  addDefinition (Definition (Proxy :: Proxy "_processPost") mockInstance NoVerification)+  pure mockInstance++instance MonadIO m => UserDefinedClass (MockT m) where+  processPost p = MockT do+    defs <- getDefinitions+    let+      mockFn :: Post -> Bool+      mockFn = fromMaybe (error "no answer found stub function `_processPost`.") $ findParam (Proxy :: Proxy "_processPost") defs+      !result = mockFn p+    lift $ pure result+ spec :: Spec spec = do   -- build SpecDeps and call aggregated spec entrypoint@@ -598,5 +620,6 @@         , SpecCommon.assocTypeDeps                = SpecCommon.AssocTypeDeps _produce         , SpecCommon.concurrencyAndUnliftIODeps   = SpecCommon.ConcurrencyAndUnliftIODeps _readFile         , SpecCommon.concurrencyDeps              = SpecCommon.ConcurrencyDeps _readFile+        , SpecCommon.userDefinedTypeDeps          = SpecCommon.UserDefinedTypeDeps _processPost         }   SpecCommon.spec deps

@@ -41,6 +41,7 @@ makeAutoLiftMock [t|DefaultMethodTest|] makeAutoLiftMock [t|AssocTypeTest|] makeMock [t|TestClass|]+makeAutoLiftMock [t|UserDefinedClass|]  instance (MonadUnliftIO m) => MonadAsync (MockT m) where   mapConcurrently = traverse@@ -77,5 +78,6 @@         , SpecCommon.assocTypeDeps                = SpecCommon.AssocTypeDeps _produce         , SpecCommon.concurrencyAndUnliftIODeps   = SpecCommon.ConcurrencyAndUnliftIODeps _readFile         , SpecCommon.concurrencyDeps              = SpecCommon.ConcurrencyDeps _readFile+        , SpecCommon.userDefinedTypeDeps          = SpecCommon.UserDefinedTypeDeps _processPost         }   SpecCommon.spec deps

@@ -8,6 +8,7 @@  import Test.Hspec (Spec, describe, it, shouldThrow, errorCall) import Test.MockCat+import Test.MockCat.SharedSpecDefs (Post(..)) import Control.Exception (evaluate) import Control.Monad.IO.Class (liftIO) import Prelude hiding (any)@@ -27,13 +28,8 @@     items :: [DeepNode]   } deriving (Show, Eq, Generic) -instance WrapParam User where wrap v = ExpectValue v (show v)-instance WrapParam Config where wrap v = ExpectValue v (show v)-instance WrapParam ComplexUser where wrap v = ExpectValue v (show v)-instance WrapParam DeepNode where wrap v = ExpectValue v (show v)-instance WrapParam MultiLayer where wrap v = ExpectValue v (show v)-instance WrapParam SubLayer where wrap v = ExpectValue v (show v) + spec :: Spec spec = do   describe "Error Message Diff" do@@ -51,6 +47,27 @@       withMock (do         f <- mock ((any :: Param String) ~> "ok") `expects` (called once `with` "hello world")         _ <- liftIO $ evaluate $ f "hello haskell"+        pure ()+        ) `shouldThrow` errorCall expectedError++    it "shows diff for user-defined type (Post)" do+      let expectedError =+            "function was not called with the expected arguments.\n\+            \  Specific differences:\n\+            \    - `postId`:\n\+            \        expected: 1\n\+            \         but got: 2\n\+            \    - `title`:\n\+            \        expected: \"title\"\n\+            \         but got: \"wrong\"\n\+            \\n\+            \Full context:\n\+            \  expected: Post {postId = 1, title = \"title\"}\n\+            \   but got: Post {postId = 2, title = \"wrong\"}\n\+            \                           ^^^^^^^^^^^^^^^^^^^"+      withMock (do+        f <- mock (Post 1 "title" ~> "ok")+        _ <- liftIO $ evaluate $ f (Post 2 "wrong")         pure ()         ) `shouldThrow` errorCall expectedError 

@@ -29,6 +29,8 @@ -- Generate mocks for FileOperation makeAutoLiftMock [t|FileOperation|] ++ perCall :: Int -> a -> a perCall _ x = x @@ -43,6 +45,27 @@  spec :: Spec spec = do+  describe "user-defined type comparison" $ do+    it "should be able to compare user-defined types with Eq and Show" $ do+      withMock $ do+        let p = Post 1 "title"+        f <- mock (p ~> True)+        liftIO $ f p `shouldBe` True++    it "should work with expects and specific value" $ do+      withMock $ do+        let p = Post 1 "title"+        f <- mock (any ~> True)+          `expects` (called once `with` p)+        liftIO $ f p `shouldBe` True++    it "should work with expects and ANY" $ do+      withMock $ do+        let p = Post 1 "title"+        f <- mock (any @Post ~> True)+          `expects` (called once `with` any @Post)+        liftIO $ f p `shouldBe` True+   describe "withMock basic functionality" $ do     it "simple mock with expects" $ do       withMock $ do @@ -92,12 +115,6 @@          void $ liftIO $ evaluate $ mockFn "a" -    it "anything expectation fails when not called" $ 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          _ <- mock (any @String ~> True)@@ -111,6 +128,10 @@                 "   but got: 0"           msg `shouldBe` expected         _ -> fail "Expected ErrorCall"++++      it "never expectation without args succeeds when not called" $ do       withMock $ do