mockcat 1.0.0.0 → 1.0.1.0

raw patch · 11 files changed

+86/−75 lines, 11 filesdep ~inspection-testingPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: inspection-testing

API changes (from Hackage documentation)

Files

• README-ja.md +2/−2
• README.md +2/−2
• mockcat.cabal +3/−3
• src/Test/MockCat/Internal/Message.hs +70/−60
• src/Test/MockCat/WithMock.hs +2/−2
• test/Property/AdditionalProps.hs +1/−1
• test/Spec.hs +1/−0
• test/Test/MockCat/PartialMockCommonSpec.hs +0/−2
• test/Test/MockCat/THCompareSpec.hs +3/−2
• test/Test/MockCat/TypeClassCommonSpec.hs +1/−0
• test/Test/MockCat/UnsafeCheck.hs +1/−1

@@ -60,8 +60,8 @@  | | **Before: 手書き...** 😫 | **After: Mockcat** 🐱✨ | | :--- | :--- | :--- |-| **定義 (Stub)**<br>「この引数には<br>この値を返したい」 | <pre lang="haskell">f :: String -> IO String<br>f arg = case arg of<br>  "a" -> pure "b"<br>  _   -> error "unexpected"</pre><br>_単純な分岐を書くだけでも行数を消費します。_ | <pre lang="haskell">-- 検証不要なら stub (純粋)<br>let f = stub $<br>  "a" ~> "b"<br><br><br></pre><br>_完全に純粋な関数として振る舞います。_ |-| **検証 (Verify)**<br>「正しく呼ばれたか<br>テストしたい」 | <pre lang="haskell">-- 記録の仕組みから作る必要がある<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 lang="haskell">-- 検証したいなら 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 $<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 />「何を検証するか」という本質に集中できます。_ |  ### 主な特徴 

@@ -60,8 +60,8 @@  | | **Before: Handwritten...** 😫 | **After: Mockcat** 🐱✨ | | :--- | :--- | :--- |-| **Definition (Stub)**<br>"I want to return<br>this value for this arg" | <pre lang="haskell">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 lang="haskell">-- Use stub if verification is unneeded (Pure)<br>let f = stub $<br>  "a" ~> "b"<br><br><br></pre><br>_Behaves as a completely pure function._ |-| **Verification (Verify)**<br>"I want to test<br>if it was called correctly" | <pre lang="haskell">-- 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 lang="haskell">-- 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 $<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"._ |  ### Key Features 

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.39.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           mockcat-version:        1.0.0.0+version:        1.0.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.@@ -128,7 +128,7 @@     , containers >=0.6 && <0.8     , hashable >=1.4 && <1.6     , hspec >=2.11 && <2.13-    , inspection-testing >=0.4 && <0.6+    , inspection-testing >=0.4 && <0.7     , mockcat     , mtl >=2.2.2 && <2.4     , stm ==2.5.*

@@ -48,13 +48,20 @@  -- Normalize a show-produced string for consistency in diffs formatStr :: String -> String-formatStr s-  | null s = s-  | head s == '(' && last s == ')' = "(" <> formatInner (init (tail s)) <> ")"-  | head s == '[' && last s == ')' = "[" <> formatInner (init (tail s)) <> "]" -- Wait, mismatch parens? No, just typo in my thought.-  | head s == '[' && last s == ']' = "[" <> formatInner (init (tail s)) <> "]"-  | head s == '{' && last s == '}' = "{" <> formatInner (init (tail s)) <> "}"-  | otherwise = formatInner s+formatStr s =+  case s of+    [] -> s+    c:cs ->+      case reverse cs of+        [] -> formatInner s+        l:ls ->+          let inner = reverse ls+          in case (c, l) of+               ('(', ')') -> "(" <> formatInner inner <> ")"+               ('[', ')') -> "[" <> formatInner inner <> "]" -- Preserving the weird legacy case+               ('[', ']') -> "[" <> formatInner inner <> "]"+               ('{', '}') -> "{" <> formatInner inner <> "}"+               _          -> formatInner s   where     formatInner inner =       let tokens = map (trim . quoteToken . trim) (splitByComma inner)@@ -62,14 +69,15 @@  -- Helper: quote a token if it looks like an unquoted alpha token quoteToken :: String -> String-quoteToken s-  | null s = s-  | head s == '"' = s-  | head s == '(' = s-  | head s == '[' = s-  | any isSpecial s = s -- Don't quote if it contains special characters indicating it's not a simple token-  | not (null s) && isLower (head s) = '"' : s ++ "\""-  | otherwise = s+quoteToken s = case s of+  [] -> s+  '"':_ -> s+  '(':_ -> s+  '[':_ -> s+  c:_+    | any isSpecial s -> s+    | isLower c -> '"' : s ++ "\""+    | otherwise -> s   where     isSpecial c = c `elem` "{}= " @@ -107,7 +115,7 @@   deriving (Show, Eq)  formatDifferences :: [Difference] -> String-formatDifferences [d] = +formatDifferences [d] =   let label = if null (diffPath d) then "Specific difference:" else "Specific difference in `" <> diffPath d <> "`:"    in intercalate "\n"         [ "  " <> label,@@ -115,7 +123,7 @@           "     but got: " <> diffActual d,           "              " <> diffPointer (diffExpected d) (diffActual d)         ]-formatDifferences ds = +formatDifferences ds =   "  Specific differences:\n" <> intercalate "\n" (map formatDiff ds)   where     formatDiff d =@@ -130,37 +138,41 @@ structuralDiff = structuralDiff' ""  structuralDiff' :: String -> String -> String -> [Difference]-structuralDiff' path expected actual =-  if isList expected && isList actual-    then-      let items1 = extractListItems expected-          items2 = extractListItems actual-          -- We need to track indices for lists-          indexedMismatches = filter (\(_, (i1, i2)) -> i1 /= i2) (zip [0 :: Int ..] (zip items1 items2))-      in concatMap (\(idx, (i1, i2)) ->-           let newPath = path <> "[" <> show idx <> "]"-               nested = structuralDiff' newPath i1 i2-            in if null nested-                 then [Difference newPath i1 i2]-                 else nested-         ) indexedMismatches-    else if isRecord expected && isRecord actual-      then-        let fields1 = extractFields expected-            fields2 = extractFields actual-            mismatches = filter (\(f1, f2) -> f1 /= f2 && isField f1 && isField f2) (zip fields1 fields2)-         in concatMap (\(f1, f2) -> -              let fieldName = getFieldName f1-                  val1 = getFieldValue f1-                  val2 = getFieldValue f2-                  newPath = if null path then fieldName else path <> "." <> fieldName-                  nested = structuralDiff' newPath val1 val2-               in if null nested-                    then [Difference newPath val1 val2]-                    else nested-            ) mismatches-    else []+structuralDiff' path expected actual+  | isList expected && isList actual = diffLists path expected actual+  | isRecord expected && isRecord actual = diffRecords path expected actual+  | otherwise = [] +diffLists :: String -> String -> String -> [Difference]+diffLists path expected actual =+  let items1 = extractListItems expected+      items2 = extractListItems actual+      -- We need to track indices for lists+      indexedMismatches = filter (\(_, (i1, i2)) -> i1 /= i2) (zip [0 :: Int ..] (zip items1 items2))+   in concatMap (\(idx, (i1, i2)) ->+        let newPath = path <> "[" <> show idx <> "]"+            nested = structuralDiff' newPath i1 i2+         in if null nested+              then [Difference newPath i1 i2]+              else nested+      ) indexedMismatches++diffRecords :: String -> String -> String -> [Difference]+diffRecords path expected actual =+  let fields1 = extractFields expected+      fields2 = extractFields actual+      mismatches = filter (\(f1, f2) -> f1 /= f2 && isField f1 && isField f2) (zip fields1 fields2)+   in concatMap (\(f1, f2) ->+        let fieldName = getFieldName f1+            val1 = getFieldValue f1+            val2 = getFieldValue f2+            newPath = if null path then fieldName else path <> "." <> fieldName+            nested = structuralDiff' newPath val1 val2+         in if null nested+              then [Difference newPath val1 val2]+              else nested+      ) mismatches+ -- utilities for message formatting trim :: String -> String trim = f . f@@ -170,7 +182,7 @@ splitByComma :: String -> [String] splitByComma = go (0 :: Int) (0 :: Int) (0 :: Int) ""   where-    go _ _ _ acc [] = if null acc then [] else [trim $ reverse acc]+    go _ _ _ acc [] = [trim $ reverse acc | not (null acc)]     go p l b acc (c : cs)       | c == '(' = go (p + 1) l b (c : acc) cs       | c == ')' = go (max 0 (p - 1)) l b (c : acc) cs@@ -178,20 +190,14 @@       | c == ']' = go p (max 0 (l - 1)) b (c : acc) cs       | c == '{' = go p l (b + 1) (c : acc) cs       | c == '}' = go p l (max 0 (b - 1)) (c : acc) cs-      | c == ',' && p == 0 && l == 0 && b == 0 = (trim $ reverse acc) : go 0 0 0 "" cs+      | c == ',' && p == 0 && l == 0 && b == 0 = trim (reverse acc) : go 0 0 0 "" cs       | otherwise = go p l b (c : acc) cs  formatInvocationList :: Show a => InvocationList a -> String-formatInvocationList invocationList-  | null invocationList = "Function was never called"-  | length invocationList == 1 =-    -- show single element without surrounding list brackets, but quote tokens appropriately-    let s = formatStr (show (head invocationList))-     in s-  | otherwise =-    -- for multiple invocations, show as a list but ensure tokens are quoted where appropriate-    let ss = map (formatStr . show) invocationList-     in "[" <> intercalate ", " ss <> "]"+formatInvocationList invocationList = case invocationList of+  [] -> "Function was never called"+  [x] -> formatStr (show x)+  _ -> "[" <> intercalate ", " (map (formatStr . show) invocationList) <> "]"  _replace :: Show a => String -> a -> String _replace r s = unpack $ replace (pack r) (pack "") (pack (show s))@@ -249,7 +255,11 @@ getFieldValue = trim . drop 1 . dropWhile (/= '=')  isList :: String -> Bool-isList s = not (null s) && head s == '[' && last s == ']'+isList s = case s of+  '[':cs -> case reverse cs of+              ']':_ -> True+              _ -> False+  _ -> False  extractListItems :: String -> [String] extractListItems s = maybe [] splitByComma (extractInner '[' ']' s)

@@ -81,10 +81,10 @@ --   types at registration time. newtype WithMockContext = WithMockContext (TVar [IO ()]) -class Monad m => MonadWithMockContext m where+class MonadWithMockContext m where   askWithMockContext :: m WithMockContext -instance {-# OVERLAPPABLE #-} (Monad m, MonadReader WithMockContext m) => MonadWithMockContext m where+instance {-# OVERLAPPABLE #-} (MonadReader WithMockContext m) => MonadWithMockContext m where   askWithMockContext = ask  -- | Expectation specification

@@ -135,7 +135,7 @@       base <- vectorOf size (arbitrary :: Gen Int)       -- ensure at least one duplicate by forcing first element copy if all distinct       pure $ ensureDup base-    ensureDup ys = if length (nub ys) == length ys && not (null ys) then head ys : ys else ys+    ensureDup ys = if length (nub ys) == length ys && not (null ys) then (case ys of (h:_) -> h : ys; [] -> ys) else ys     -- Check that for each earlier unique value all its indices precede all indices of later unique values.     isClusterOrdered us seqVals = all pairOrdered pairs       where

@@ -22,6 +22,7 @@ import Test.MockCat.ErrorDiffSpec as ErrorDiff import Test.MockCat.THCompareSpec as THCompare import ReadmeVerifySpec as ReadmeVerify+import Test.MockCat.UnsafeCheck () import Test.QuickCheck (property) import qualified Property.ConcurrentCountProp as ConcurrencyProp import qualified Property.LazyEvalProp as LazyEvalProp

@@ -72,7 +72,6 @@   ( UserInputGetter (MockT IO)   , ExplicitlyReturnMonadicValuesPartialTest (MockT IO)   , Finder Int String (MockT IO)-  , Verify.ResolvableParamsOf (Int -> String) ~ Param Int   ) =>   PartialMockDeps ->   MockT IO () ->@@ -166,7 +165,6 @@ -- Group: Finder Behavior (Multi-param type class) specFinderBehavior ::   ( Finder Int String (MockT IO)-  , Verify.ResolvableParamsOf (Int -> String) ~ Param Int   ) =>   PartialMockDeps ->   Spec

@@ -12,7 +12,8 @@ import Language.Haskell.TH (pprint, Dec(..), Type(..), litE, stringL, listE, tupE) import Language.Haskell.TH.Syntax (nameBase) import Data.Char (isDigit, isLower)-import Data.List (foldl', sort, nub)+import Data.List (sort, nub)+import qualified Data.List as L import Data.Maybe (mapMaybe) import qualified Data.Map.Strict as Map import qualified Data.Text as T@@ -94,7 +95,7 @@   . T.replace (T.pack ") r ()") (T.pack " r ()")   where     applyReplacements reps txt =-      foldl'+      L.foldl'         (\acc (from, to) -> T.replace (T.pack from) (T.pack to) acc)         txt         reps

@@ -12,6 +12,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE PatternSynonyms #-}

@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-}-module Test.MockCat.UnsafeCheck where+module Test.MockCat.UnsafeCheck (module Test.MockCat.UnsafeCheck) where  import GHC.IO (unsafePerformIO) import Test.Inspection (inspect, doesNotUse)