diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,7 +6,24 @@
and this project adheres to the
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
-## Unreleased
+## 0.5.4.0
+### Added
+- Parallel execution support (verified counting under concurrency, stress tests).
+- Verification helpers: `applyTimesIs`, `neverApply`.
+### Changed
+- Refactored `MockT` from `StateT` to `ReaderT (IORef [Definition])` architecture.
+- Simplified Template Haskell generated constraints.
+
+### Fixed
+- Race causing lost/double count in concurrent stub applications (strict `atomicModifyIORef'`).
+
+### Removed
+- `unsafePerformIO` in TH-generated code.
+
+### Internal
+- Introduced `MonadMockDefs` abstraction.
+
## 0.5.3.0
-- Add: MockT now implements MonadUnliftIO
+### Added
+- `MonadUnliftIO` instance for `MockT` (initial groundwork for later parallel support).
diff --git a/README-ja.md b/README-ja.md
new file mode 100644
--- /dev/null
+++ b/README-ja.md
@@ -0,0 +1,711 @@
+
+
+
+更新履歴
+
+- **0.6.0**: 並列処理に対応
+- **0.5.3.0**: MockT が MonadUnliftIO のインスタンスになった
+- **0.5.0**: `IO a`型のスタブ関数が、適用される度に異なる値を返すことができるようになった
+- **0.4.0**: 型クラスの部分的なモックを作れるようになった
+- **0.3.0**: 型クラスのモックを作れるようになった
+- **0.2.0**: スタブ関数が、同じ引数に対して異なる値を返せるようになった
+- **0.1.0**: 1st release
+
+
+## 例
+スタブ関数
+```haskell
+-- create a stub function
+stubFn <- createStubFn $ "value" |> True
+-- assert
+stubFn "value" `shouldBe` True
+```
+適用の検証
+```haskell
+-- create a mock
+mock <- createMock $ "value" |> True
+-- stub function
+let stubFunction = stubFn mock
+-- assert
+stubFunction "value" `shouldBe` True
+-- verify
+mock `shouldApplyTo` "value"
+```
+型クラス
+```haskell
+result <- runMockT do
+ -- stub functions
+ _readFile $ "input.txt" |> pack "content"
+ _writeFile $ "output.txt" |> pack "content" |> ()
+ -- sut
+ program "input.txt" "output.txt"
+
+result `shouldBe` ()
+```
+## スタブ関数の概要
+スタブ関数は`createStubFn`関数で生成することができます。
+`createStubFn`の引数は、適用が期待される引数を `|>` で連結したもので、`|>` の最後の値が関数の返り値となります。
+```haskell
+createStubFn $ (10 :: Int) |> "return value"
+```
+これは型クラスのモックにおけるスタブ関数の場合も同様です。
+```haskell
+runMockT do
+ _readFile $ "input.txt" |> pack "content"
+```
+期待される引数は、条件として指定することもできます。
+```haskell
+-- Conditions other than exact match
+createStubFn $ any |> "return value"
+createStubFn $ expect (> 5) "> 5" |> "return value"
+createStubFn $ expect_ (> 5) |> "return value"
+createStubFn $ $(expectByExpr [|(> 5)|]) |> "return value"
+```
+また、引数に応じて返す値を変えることも可能です。
+（同じ引数に対して、別の値を返すことも可能できます。）
+```haskell
+-- Parameterized Stub
+createStubFn do
+ onCase $ "a" |> "return x"
+ onCase $ "b" |> "return y"
+createStubFn do
+ onCase $ "arg" |> "x"
+ onCase $ "arg" |> "y"
+```
+## 検証の概要
+スタブ関数の適用を検証するには、まず`createMock`関数でモックを作ります。
+スタブ関数はモックから`stubFn`関数で取り出して使います。
+検証はモックに対して行います。
+```haskell
+-- create a mock
+mock <- createMock $ "value" |> True
+-- stub function
+let stubFunction = stubFn mock
+-- assert
+stubFunction "value" `shouldBe` True
+-- verify
+mock `shouldApplyTo` "value"
+```
+スタブ関数と同様に検証の場合も条件を指定することができます。
+```haskell
+mock `shouldApplyTo` any @String
+mock `shouldApplyTo` expect_ (/= "not value")
+mock `shouldApplyTo` $(expectByExpr [|(/= "not value")|])
+```
+また適用された回数を検証することもできます。
+```haskell
+mock `shouldApplyTimes` (1 :: Int) `to` "value"
+mock `shouldApplyTimesGreaterThan` (0 :: Int) `to` "value"
+mock `shouldApplyTimesGreaterThanEqual` (1 :: Int) `to` "value"
+mock `shouldApplyTimesLessThan` (2 :: Int) `to` "value"
+mock `shouldApplyTimesLessThanEqual` (1 :: Int) `to` "value"
+mock `shouldApplyTimesToAnything` (1 :: Int)
+```
+型クラスのモックの場合は、`runMockT`を適用した際、用意したスタブ関数の適用が行われたかの検証が自動で行われます。
+```haskell
+result <- runMockT do
+ _readFile $ "input.txt" |> pack "Content"
+ _writeFile $ "output.text" |> pack "Content" |> ()
+ operationProgram "input.txt" "output.text"
+
+result `shouldBe` ()
+```
+## 型クラスのモック
+ここからはより詳しく説明していきます。
+### 例
+例えば次のようなモナド型クラス`FileOperation`と、`FileOperation`を使う`operationProgram`という関数が定義されているとします。
+```haskell
+class Monad m => FileOperation m where
+ readFile :: FilePath -> m Text
+ writeFile :: FilePath -> Text -> m ()
+
+operationProgram ::
+ FileOperation m =>
+ FilePath ->
+ FilePath ->
+ m ()
+operationProgram inputPath outputPath = do
+ content <- readFile inputPath
+ writeFile outputPath content
+```
+
+次のように`makeMock`関数を使うことで、型クラス`FileOperation`のモックを生成することができます。
+`makeMock [t|FileOperation|]`
+
+生成されるのものは次の2つです。
+1. 型クラス`FileOperation`の`MockT`インスタンス
+2. 型クラス`FileOperation`に定義されている関数を元としたスタブ関数
+ スタブ関数は元の関数の接頭辞に`_`が付与された関数として生成されます。
+ この場合`_readFile`と`_writeFile`が生成されます。
+
+モックは次のように使うことができます。
+```haskell
+spec :: Spec
+spec = do
+ it "Read, and output files" do
+ result <- runMockT do
+ _readFile ("input.txt" |> pack "content")
+ _writeFile ("output.txt" |> pack "content" |> ())
+ operationProgram "input.txt" "output.txt"
+
+ result `shouldBe` ()
+```
+スタブ関数には、関数の適用が期待される引数を `|>` で連結して渡します。
+`|>` の最後の値が関数の返り値となります。
+
+モックは`runMockT`で実行します。
+
+### 検証
+実行の後、スタブ関数が期待通りに適用されたか検証が行われます。
+例えば、上記の例のスタブ関数`_writeFile`の適用が期待される引数を`"content"`から`"edited content"`に書き換えてみます。
+```haskell
+result <- runMockT do
+ _readFile ("input.txt" |> pack "content")
+ _writeFile ("output.txt" |> pack "edited content" |> ())
+ operationProgram "input.txt" "output.txt"
+```
+テストを実行すると、テストは失敗し、次のエラーメッセージが表示されます。
+```console
+uncaught exception: ErrorCall
+function `_writeFile` was not applied to the expected arguments.
+ expected: "output.txt","edited content"
+ but got: "output.txt","content"
+```
+
+また次のようにテスト対象で使用している関数に対応するスタブ関数を使用しなかったとします。
+```haskell
+result <- runMockT do
+ _readFile ("input.txt" |> pack "content")
+ -- _writeFile ("output.txt" |> pack "content" |> ())
+ operationProgram "input.txt" "output.txt"
+```
+この場合もテストを実行すると、テストは失敗し、次のエラーメッセージが表示されます。
+```console
+no answer found stub function `_writeFile`.
+```
+
+### 適用回数を検証
+例えば、次のように特定の文字列を含んでいる場合は`writeFile`を適用させない場合のテストを書きたいとします。
+```haskell
+operationProgram inputPath outputPath = do
+ content <- readFile inputPath
+ unless (pack "ngWord" `isInfixOf` content) $
+ writeFile outputPath content
+```
+
+これは次のように`applyTimesIs`関数を使うことで実現できます。
+```haskell
+import Test.MockCat as M
+...
+it "Read, and output files (contain ng word)" do
+ result <- runMockT do
+ _readFile ("input.txt" |> pack "contains ngWord")
+ _writeFile ("output.txt" |> M.any |> ()) `applyTimesIs` 0
+ operationProgram "input.txt" "output.txt"
+
+ result `shouldBe` ()
+```
+`0`を指定することで適用されなかったことを検証できます。
+
+あるいは`neverApply`関数を使うことで同じことが実現できます。
+```haskell
+result <- runMockT do
+ _readFile ("input.txt" |> pack "contains ngWord")
+ neverApply $ _writeFile ("output.txt" |> M.any |> ())
+ operationProgram "input.txt" "output.txt"
+```
+
+`M.any`は任意の値にマッチするパラメーターです。
+この例では`M.any`を使って、あらゆる値に対して`writeFile`関数が適用されないことを検証しています。
+
+後述しますが、mockcatは`M.any`以外にも様々なパラメーターを用意しています。
+
+### 定数関数のモック
+mockcatは定数関数もモックにできます。
+`MonadReader`をモックにし、`ask`のスタブ関数を使ってみます。
+```haskell
+data Environment = Environment { inputPath :: String, outputPath :: String }
+
+operationProgram ::
+ MonadReader Environment m =>
+ FileOperation m =>
+ m ()
+operationProgram = do
+ (Environment inputPath outputPath) <- ask
+ content <- readFile inputPath
+ writeFile outputPath content
+
+makeMock [t|MonadReader Environment|]
+
+spec :: Spec
+spec = do
+ it "Read, and output files (with MonadReader)" do
+ r <- runMockT do
+ _ask (Environment "input.txt" "output.txt")
+ _readFile ("input.txt" |> pack "content")
+ _writeFile ("output.txt" |> pack "content" |> ())
+ operationProgram
+ r `shouldBe` ()
+```
+ここで、`ask`を使わないようにしてみます。
+```haskell
+operationProgram = do
+ content <- readFile "input.txt"
+ writeFile "output.txt" content
+```
+するとテスト実行に失敗し、スタブ関数が適用されなかったことが表示されます。
+```haskell
+It has never been applied function `_ask`
+```
+### `IO a`型の値を返すモック
+通常定数関数は同じ値を返しますが、`IO a`型の値を返すモックの場合のみ、適用する度に別の値を返すようなモックを作ることができます。
+例えば型クラス`Teletype`とテスト対象の関数`echo`が定義されているとします。
+`echo`は、`readTTY`が返す値によって異なる動作をします。
+```haskell
+class Monad m => Teletype m where
+ readTTY :: m String
+ writeTTY :: String -> m ()
+
+echo :: Teletype m => m ()
+echo = do
+ i <- readTTY
+ case i of
+ "" -> pure ()
+ _ -> writeTTY i >> echo
+```
+ `readTTY`が`""`以外を返した場合は、再帰的に呼び出されることを検証したいでしょう。
+ そのためには、一度のテストの中で`readTTY`が異なる値を返せる必要があります。
+ これを実現するためには、`implicitMonadicReturn`オプションを指定してモックを作ります。
+ `implicitMonadicReturn`を使うことで、スタブ関数が明示的にモナディックな値を返せるようになります。
+```haskell
+makeMockWithOptions [t|Teletype|] options { implicitMonadicReturn = False }
+```
+これによりテストでは、`onCase`を使って、1回目の適用では`""`以外の値を返し、2回目の適用では`""`を返すような動作をさせることが可能になります。
+```haskell
+result <- runMockT do
+ _readTTY $ do
+ onCase $ pure @IO "a"
+ onCase $ pure @IO ""
+
+ _writeTTY $ "a" |> pure @IO ()
+ echo
+result `shouldBe` ()
+```
+### 部分的なモック
+`makePartialMock`関数を使うと、型クラスに定義された関数の一部だけをモックにできます。
+
+例えば次のような型クラスと関数があったとします。
+`getUserInput`がテスト対象の関数です。
+```haskell
+data UserInput = UserInput String deriving (Show, Eq)
+
+class Monad m => UserInputGetter m where
+ getInput :: m String
+ toUserInput :: String -> m (Maybe UserInput)
+
+getUserInput :: UserInputGetter m => m (Maybe UserInput)
+getUserInput = do
+ i <- getInput
+ toUserInput i
+```
+この例では、一部本物の関数を使いたいので、次のように`IO`インスタンスを定義します。
+```haskell
+instance UserInputGetter IO where
+ getInput = getLine
+ toUserInput "" = pure Nothing
+ toUserInput a = (pure . Just . UserInput) a
+```
+テストは次のようになります。
+```haskell
+makePartialMock [t|UserInputGetter|]
+
+spec :: Spec
+spec = do
+ it "Get user input (has input)" do
+ a <- runMockT do
+ _getInput "value"
+ getUserInput
+ a `shouldBe` Just (UserInput "value")
+
+ it "Get user input (no input)" do
+ a <- runMockT do
+ _getInput ""
+ getUserInput
+ a `shouldBe` Nothing
+```
+
+### スタブ関数の名前を変える
+生成されるスタブ関数の接頭辞と接尾辞はオプションで変更することができます。
+例えば次のように指定すると、`stub_readFile_fn`と`stub_writeFile_fn`関数が生成されます。
+```haskell
+makeMockWithOptions [t|FileOperation|] options { prefix = "stub_", suffix = "_fn" }
+```
+オプションが指定されない場合はデフォルトで`_`になります。
+
+### makeMockが生成するコード
+使用する上で意識する必要はありませんが、`makeMock`関数は次のようなコードを生成します。
+```haskell
+-- MockTインスタンス
+instance (Monad m) => FileOperation (MockT m) where
+ readFile :: Monad m => FilePath -> MockT m Text
+ writeFile :: Monad m => FilePath -> Text -> MockT m ()
+
+_readFile :: (MockBuilder params (FilePath -> Text) (Param FilePath), Monad m) => params -> MockT m ()
+_writeFile :: (MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text), Monad m) => params -> MockT m ()
+```
+
+## 関数のモック
+mockcatはモナド型クラスのモックだけでなく、通常の関数のモックを作ることもできます。
+モナド型のモックとは異なり、元になる関数は不要です。
+
+### 使用例
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "使い方の例" do
+ -- モックの生成("value"を適用すると、純粋な値Trueを返す)
+ mock <- createMock $ "value" |> True
+
+ -- モックからスタブ関数を取り出す
+ let stubFunction = stubFn mock
+
+ -- 関数の適用結果を検証
+ stubFunction "value" `shouldBe` True
+
+ -- 期待される値("value")が適用されたかを検証
+ mock `shouldApplyTo` "value"
+
+```
+
+### スタブ関数
+スタブ関数を直接作るには `createStubFn` 関数を使います。
+検証が不要な場合は、こちらを使うとよいでしょう。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "スタブ関数を生成することができる" do
+ -- 生成
+ f <- createStubFn $ "param1" |> "param2" |> pure @IO ()
+
+ -- 適用
+ actual <- f "param1" "param2"
+
+ -- 検証
+ actual `shouldBe` ()
+```
+`createStubFn` 関数には、関数が適用されることを期待する引数を `|>` で連結して渡します。
+`|>` の最後の値が関数の返り値となります。
+
+スタブ関数が期待されていない引数に適用された場合はエラーとなります。
+```console
+uncaught exception: ErrorCall
+Expected arguments were not applied to the function.
+ expected: "value"
+ but got: "valuo"
+```
+### 名前付きスタブ関数
+スタブ関数には名前を付けることができます。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "named stub" do
+ f <- createNamedStubFun "named stub" $ "x" |> "y" |> True
+ f "x" "z" `shouldBe` True
+```
+期待した引数に適用されなかった場合に出力されるエラーメッセージには、この名前が含まれるようになります。
+```console
+uncaught exception: ErrorCall
+Expected arguments were not applied to the function `named stub`.
+ expected: "x","y"
+ but got: "x","z"
+```
+
+### 定数スタブ関数
+定数を返すようなスタブ関数を作るには`createConstantMock`もしくは`createNamedConstantMock`関数を使います。
+
+```haskell
+spec :: Spec
+spec = do
+ it "createConstantMock" do
+ m <- createConstantMock "foo"
+ stubFn m `shouldBe` "foo"
+ shouldApplyToAnything m
+
+ it "createNamedConstantMock" do
+ m <- createNamedConstantMock "const" "foo"
+ stubFn m `shouldBe` "foo"
+ shouldApplyToAnything m
+```
+
+### 柔軟なスタブ関数
+`createStubFn` 関数に具体的な値ではなく、条件式を与えることで、柔軟なスタブ関数を生成できます。
+これを使うと、任意の値や、特定のパターンに合致する文字列などに対して期待値を返すことができます。
+これはモナド型のモックを生成した際のスタブ関数も同様です。
+### any
+`any` は任意の値にマッチします。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+import Prelude hiding (any)
+
+spec :: Spec
+spec = do
+ it "any" do
+ f <- createStubFn $ any |> "return value"
+ f "something" `shouldBe` "return value"
+```
+Preludeに同名の関数が定義されているため、`import Prelude hiding (any)`としています。
+
+### 条件式
+`expect`関数を使うと任意の条件式を扱えます。
+`expect`関数は条件式とラベルをとります。
+ラベルは条件式にマッチしなかった場合のエラーメッセージに使われます。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "expect" do
+ f <- createStubFn $ expect (> 5) "> 5" |> "return value"
+ f 6 `shouldBe` "return value"
+```
+
+### ラベルなし条件式
+`expect_` は `expect` のラベルなし版です。
+エラーメッセージには [some condition] と表示されます。
+
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "expect_" do
+ f <- createStubFn $ expect_ (> 5) |> "return value"
+ f 6 `shouldBe` "return value"
+```
+
+### Template Haskellを使った条件式
+`expectByExp`を使うと、`Q Exp`型の値として条件式を扱えます。
+エラーメッセージには条件式を文字列化したものが使われます。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TemplateHaskell #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "expectByExpr" do
+ f <- createStubFn $ $(expectByExpr [|(> 5)|]) |> "return value"
+ f 6 `shouldBe` "return value"
+```
+
+### 適用される引数ごとに異なる値を返すスタブ関数
+`onCase`関数を使うと引数ごとに異なる値を返すスタブ関数を作れます。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "multi" do
+ f <- createStubFn do
+ onCase $ "a" |> "return x"
+ onCase $ "b" |> "return y"
+
+ f "a" `shouldBe` "return x"
+ f "b" `shouldBe` "return y"
+```
+
+### 同じ引数に適用されたとき異なる値を返すスタブ関数
+`onCase`関数を使うとき、引数が同じで返り値が異なるようにすると、同じ引数に適用しても異なる値を返すスタブ関数を作れます。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+import GHC.IO (evaluate)
+
+spec :: Spec
+spec = do
+ it "Return different values for the same argument" do
+ f <- createStubFn do
+ onCase $ "arg" |> "x"
+ onCase $ "arg" |> "y"
+
+ -- Do not allow optimization to remove duplicates.
+ v1 <- evaluate $ f "arg"
+ v2 <- evaluate $ f "arg"
+ v3 <- evaluate $ f "arg"
+ v1 `shouldBe` "x"
+ v2 `shouldBe` "y"
+ v3 `shouldBe` "y" -- After the second time, “y” is returned.
+```
+あるいは`cases`関数を使うこともできます。
+```haskell
+f <-
+ createStubFn $
+ cases
+ [ "a" |> "return x",
+ "b" |> "return y"
+ ]
+
+f "a" `shouldBe` "return x"
+f "b" `shouldBe` "return y"
+```
+
+## 検証
+### 期待される引数に適用されたか検証する
+期待される引数に適用されたかは `shouldApplyTo` 関数で検証することができます。
+検証を行う場合は、`createStubFn` 関数ではなく `createMock` 関数でモックを作る必要があります。
+この場合スタブ関数は `stubFn` 関数でモックから取り出して使います。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "stub & verify" do
+ -- create a mock
+ mock <- createMock $ "value" |> True
+ -- stub function
+ let stubFunction = stubFn mock
+ -- assert
+ stubFunction "value" `shouldBe` True
+ -- verify
+ mock `shouldApplyTo` "value"
+```
+### 注
+適用されたという記録は、スタブ関数の返り値が評価される時点で行われます。
+したがって、検証は返り値の評価後に行う必要があります。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "Verification does not work" do
+ mock <- createMock $ "expect arg" |> "return value"
+ -- 引数の適用は行うが返り値は評価しない
+ let _ = stubFn mock "expect arg"
+ mock `shouldApplyTo` "expect arg"
+```
+```console
+uncaught exception: ErrorCall
+Expected arguments were not applied to the function.
+ expected: "expect arg"
+ but got: Never been called.
+```
+
+### 期待される引数に適用された回数を検証する
+期待される引数が適用された回数は `shouldApplyTimes` 関数で検証することができます。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "shouldApplyTimes" do
+ m <- createMock $ "value" |> True
+ print $ stubFn m "value"
+ print $ stubFn m "value"
+ m `shouldApplyTimes` (2 :: Int) `to` "value"
+```
+
+### 何かしらに適用されたかを検証する
+関数が何かしらに適用されたかは、`shouldApplyToAnything`関数で検証することができます。
+
+### 何かしらに適用された回数を検証する
+関数が何かしらに適用されたかの回数は、`shouldApplyTimesToAnything`関数で検証することができます。
+
+### 期待される順序で適用されたかを検証する
+期待される順序で適用されたかは `shouldApplyInOrder` 関数で検証することができます。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "shouldApplyInOrder" do
+ m <- createMock $ any |> True |> ()
+ print $ stubFn m "a" True
+ print $ stubFn m "b" True
+ m
+ `shouldApplyInOrder` [ "a" |> True,
+ "b" |> True
+ ]
+```
+
+### 期待される順序で適用されたかを検証する(部分一致)
+`shouldApplyInOrder` 関数は適用の順序を厳密に検証しますが、
+`shouldApplyInPartialOrder` 関数は適用の順序が部分的に一致しているかを検証することができます。
+```haskell
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeApplications #-}
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = do
+ it "shouldApplyInPartialOrder" do
+ m <- createMock $ any |> True |> ()
+ print $ stubFn m "a" True
+ print $ stubFn m "b" True
+ print $ stubFn m "c" True
+ m
+ `shouldApplyInPartialOrder` [ "a" |> True,
+ "c" |> True
+ ]
+```
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -6,25 +6,120 @@
[](https://github.com/pujoheadsoft/mockcat/actions?query=workflow%3ATest+branch%3Amain)
[](https://hackage.haskell.org/package/mockcat)
-
## Overview
-mockcat is a mock library for Haskell.
+mockcat is a lightweight, declarative mocking & stubbing DSL for Haskell.
-It can easily generate stub functions and verify the application of stub functions.
+You describe expected applications using a left‑to‑right pipeline (`arg |> arg |> returnValue`) and then either:
+* run function mocks directly, or
+* generate typeclass mocks via Template Haskell (`makeMock`, `makePartialMock`) and run them inside `runMockT` with automatic verification.
[日本語版 README はこちら](https://github.com/pujoheadsoft/mockcat/blob/master/README-ja.md)
+### Features
+* Small surface: describe a case with `arg |> ... |> result` – no separate expectation language
+* Concurrency‑safe counting: parallel applications don’t lose or double count
+* Honest laziness: an unevaluated result doesn’t register as a call; nothing is forced behind your back
+* Flexible returns: change results per argument or per occurrence (including identical args later)
+* Partial mocking: generate only the methods you care about with `makePartialMock`
+* Monadic return variation: for `IO a` you can vary the monadic result across calls
+* Clear failures: messages show the raw arguments and matcher labels directly
+* Low ceremony constant stubs: `createConstantMock` / `createNamedConstantMock`
+* Template Haskell helpers: `makeMock` to cut boilerplate for typeclasses
+* No hidden global state: tests stay isolated
+
+Designed to be something you can pick up to stub one or two spots and then forget again – more a handy extension of regular Haskell testing than a new framework.
+
+### Quick Start
+
+Function mock:
+```haskell
+import Test.Hspec
+import Test.MockCat
+
+spec :: Spec
+spec = it "simple function mock" do
+ m <- createMock $ "input" |> 42
+ stubFn m "input" `shouldBe` 42
+ m `shouldApplyTo` "input"
+```
+
+Typeclass mock:
+```haskell
+{-# LANGUAGE TemplateHaskell #-}
+import Test.Hspec
+import Test.MockCat
+
+class Monad m => KV m where
+ getKV :: String -> m (Maybe String)
+ putKV :: String -> String -> m ()
+
+makeMock [t|KV|]
+
+program :: KV m => m (Maybe String)
+program = do
+ putKV "k" "v"
+ getKV "k"
+
+spec :: Spec
+spec = it "kv" do
+ r <- runMockT do
+ _putKV ("k" |> "v" |> ())
+ _getKV ("k" |> Just "v")
+ program
+ r `shouldBe` Just "v"
+```
+
+Non‑invocation (two styles):
+```haskell
+ _putKV ("x" |> "y" |> ()) `applyTimesIs` 0
+ neverApply $ _putKV ("x" |> "y" |> ())
+```
+
+### Core Concepts (Brief)
+* Pipeline DSL: `a |> b |> returnValue` describes one expected application.
+* Matchers: `any`, `expect p label`, `expect_ p`, `$(expectByExpr [| predicate |])`.
+* Argument‑dependent returns: `onCase` or `cases [...]` (including differing values for same arg on later occurrences).
+* Counting: `applyTimesIs`, `neverApply`, plus `shouldApplyTimes*` predicates on mocks.
+* Ordering: `shouldApplyInOrder`, `shouldApplyInPartialOrder`.
+* Concurrency: Call recorded only when result evaluated; counting atomic.
+* Partial mocks: `makePartialMock` for generating only some methods.
+* Monadic return variation (`IO a`): enable with `implicitMonadicReturn` option.
+
+### Concurrency & Laziness Semantics
+Within `runMockT`:
+1. Each evaluated application contributes 1 count (atomic IORef).
+2. Unforced results are not recorded.
+3. Order checks reflect evaluation order, not mere start time.
+4. Finish async work before verification.
+5. Fresh state per `runMockT` – no cross‑test leakage.
+
+### Architecture Notes (≥ 0.5.3.0)
+Refactor from `StateT` to `ReaderT (IORef [Definition])` to:
+* Provide lawful `MonadUnliftIO` instance for safe `withRunInIO` / `async`.
+* Remove lost/double count races via strict `atomicModifyIORef'`.
+* Eliminate `unsafePerformIO` & hidden global state.
+* Simplify TH output & reduce constraint noise.
+
+Migration: internal `(modify/get)` swapped to `addDefinition/getDefinitions` (via `MonadMockDefs`). Public DSL unchanged.
+
-Update History
+Update History
-- **0.5.3.0**: MockT now implements MonadUnliftIO
-- **0.5.0**: Stub functions of type `IO a` can now return different values each time they are applied
-- **0.4.0**: Can make partial mocks of type classes.
-- **0.3.0**: Can make mocks of type classes.
-- **0.2.0**: Stub functions can now return different values for the same argument.
-- **0.1.0**: 1st release
+* **0.5.3.0**: `MockT` now implements `MonadUnliftIO`; concurrency safety clarified; removal of `unsafePerformIO`.
+* **0.5.0**: `IO a` stubs can return different values on successive applications.
+* **0.4.0**: Partial mocks for typeclasses.
+* **0.3.0**: Typeclass mocks.
+* **0.2.0**: Argument‑dependent return values (including differing values for identical args).
+* **0.1.0**: Initial release.
+---
+Below is the full expanded reference (legacy detailed sections). Collapse if you only need the quick start.
+
+
+Full Reference (expanded)
+
+
## Examples
Stub Function
```haskell
@@ -145,7 +240,7 @@
`makeMock [t|FileOperation|]`
Then following two things will be generated:
-1. a `MockT` instance of typeclass `FileOperation
+1. a `MockT` instance of typeclass `FileOperation`
2. a stub function based on a function defined in the typeclass `FileOperation`
Stub functions are created as functions with `_` prefix added to the original function.
In this case, `_readFile` and `_writeFile` are generated.
@@ -194,8 +289,7 @@
Again, when you run the test, the test fails and you get the following error message.
```console
no answer found stub function `_writeFile`.
-````
-
+```
## Verify the number of times applied
For example, suppose you want to write a test for not applying `_writeFile` if it contains a specific string as follows.
```haskell
@@ -204,7 +298,6 @@
unless (pack "ngWord" `isInfixOf` content) $
writeFile outputPath content
```
-
This can be accomplished by using the `applyTimesIs` function as follows.
```haskell
import Test.MockCat as M
@@ -217,8 +310,7 @@
result `shouldBe` ()
```
-You can verify that it was not applied by specifying ``0``.
-
+You can verify that it was not applied by specifying `0`.
Or you can use the `neverApply` function to accomplish the same thing.
```haskell
result <- runMockT do
@@ -226,10 +318,8 @@
neverApply $ _writeFile ("output.txt" |> M.any |> ())
operationProgram "input.txt" "output.txt"
```
-
-``M.any`` is a parameter that matches any value.
+`M.any` is a parameter that matches any value.
This example uses `M.any` to verify that the `writeFile` function does not apply to any value.
-
As described below, mockcat provides a variety of parameters other than `M.any`.
### Mock constant functions
@@ -247,7 +337,7 @@
content <- readFile inputPath
writeFile outputPath content
-makeMock [t|MonadReader Environment|]]
+makeMock [t|MonadReader Environment|]
spec :: Spec
spec = do
@@ -259,7 +349,7 @@
operationProgram
r `shouldBe` ()
```
-Now let's try to avoid using ``ask``.
+Now let's try to avoid using `ask`.
```haskell
operationProgram = do
content <- readFile "input.txt"
@@ -303,10 +393,8 @@
echo
result `shouldBe` ()
```
-
### Partial mocking
The `makePartialMock` function can be used to mock only a part of a function defined in a typeclass.
-
For example, suppose you have the following typeclasses and functions.
`getUserInput` is the function to be tested.
```haskell
@@ -346,17 +434,15 @@
getUserInput
a `shouldBe` Nothing
```
-
### Rename stub functions
The prefix and suffix of the generated stub functions can optionally be changed.
For example, the following will generate the functions `stub_readFile_fn` and `stub_writeFile_fn`.
```haskell
makeMockWithOptions [t|FileOperation|] options { prefix = "stub_", suffix = "_fn" }
```
-If no options are specified, it defaults to ``_``.
-
+If no options are specified, it defaults to `_`.
### Code generated by makeMock
-Although you do not need to be aware of it, the ``makeMock`` function generates the following code.
+Although you do not need to be aware of it, the `makeMock` function generates the following code.
```haskell
-- MockT instance
instance (Monad m) => FileOperation (MockT m) where
@@ -366,11 +452,9 @@
_readFile :: (MockBuilder params (FilePath -> Text) (Param FilePath), Monad m) => params -> MockT m ()
_writeFile :: (MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text), Monad m) => params -> MockT m ()
```
-
## Mocking functions
In addition to mocking monad type classes, mockcat can also mock regular functions.
Unlike monad type mocks, the original function is not required.
-
### Example usage
```haskell
{-# LANGUAGE BlockArguments #-}
@@ -383,16 +467,12 @@
it "usage example" do
-- create a mock (applying "value" returns the pure value True)
mock <- createMock $ "value" |> True
-
-- extract a stub function from a mock
let stubFunction = stubFn mock
-
-- verify the result of applying the function
stubFunction "value" `shouldBe` True
-
-- verify that the expected value ("value") has been applied
mock `shouldApplyTo` "value"
-
```
## Stub functions
To create a stub function directly, use the `createStubFn` function.
@@ -408,24 +488,20 @@
it "can generate stub functions" do
-- generate
f <- createStubFn $ "param1" |> "param2" |> pure @IO ()
-
-- apply
actual <- f "param1" "param2"
-
-- Verification
actual `shouldBe` ()
```
The `createStubFn` function is passed a sequence of `|>` arguments that the function is expected to apply.
The last value of `|>` is the return value of the function.
-
If the stub function is applied to an argument it is not expected to be applied to, an error is returned.
```console
Uncaught exception: ErrorCall
Expected arguments were not applied to the function.
expected: "value"
but got: "valuo"
-````
-
+```
### Named Stub Functions
You can name stub functions.
```haskell
@@ -447,10 +523,8 @@
expected: "x","y"
but got: "x","z"
```
-
### Constant stub functions
To create a stub function that returns a constant, use the `createConstantMock` or `createNamedConstantMock` function.
-
```haskell
spec :: Spec
spec = do
@@ -458,18 +532,15 @@
m <- createConstantMock "foo"
stubFn m `shouldBe` "foo"
shouldApplyToAnything m
-
it "createNamedConstantMock" do
m <- createNamedConstantMock "const" "foo"
- stubFn m `shouldBe` "foo""
+ stubFn m `shouldBe` "foo"
shouldApplyToAnything m
```
-
### Flexible stub functions
Flexible stub functions can be generated by giving the `createStubFn` function a conditional expression rather than a concrete value.
This can be used to return expected values for arbitrary values or strings that match a specific pattern.
This is also true for the stub function when generating a mock of a monad type.
-
### any
any matches any value.
```haskell
@@ -486,7 +557,6 @@
f "something" `shouldBe` "return value"
```
Since a function with the same name is defined in Prelude, we use import Prelude hiding (any).
-
### Condition Expressions
Using the expect function, you can handle arbitrary condition expressions.
The expect function takes a condition expression and a label.
@@ -503,7 +573,6 @@
f <- createStubFn $ expect (> 5) "> 5" |> "return value"
f 6 `shouldBe` "return value"
```
-
### Condition Expressions without Labels
`expect_` is a label-free version of expect.
The error message will show [some condition].
@@ -519,7 +588,6 @@
f <- createStubFn $ expect_ (> 5) |> "return value"
f 6 `shouldBe` "return value"
```
-
### Condition Expressions using Template Haskell
Using expectByExp, you can handle condition expressions as values of type Q Exp.
The error message will include the string representation of the condition expression.
@@ -536,7 +604,6 @@
f <- createStubFn $ $(expectByExpr [|(> 5)|]) |> "return value"
f 6 `shouldBe` "return value"
```
-
### Stub functions that return different values for each argument applied
By applying the `createStubFn` function to a list of x |> y format, you can create a stub function that returns a different value for each argument you apply.
```haskell
@@ -563,11 +630,9 @@
[ "a" |> "return x",
"b" |> "return y"
]
-
f "a" `shouldBe` "return x"
f "b" `shouldBe` "return y"
```
-
### Stub functions that return different values when applied to the same argument
When the `createStubFn` function is applied to a list of x |> y format, with the same arguments but different return values, you can create stub functions that return different values when applied to the same arguments.
```haskell
@@ -583,8 +648,6 @@
f <- createStubFn $ do
onCase $ "arg" |> "x"
onCase $ "arg" |> "y"
-
- -- Do not allow optimization to remove duplicates.
v1 <- evaluate $ f "arg"
v2 <- evaluate $ f "arg"
v3 <- evaluate $ f "arg"
@@ -592,7 +655,6 @@
v2 `shouldBe` "y"
v3 `shouldBe` "y" -- After the second time, "y" is returned.
```
-
### Verify that expected arguments are applied
The `shouldApplyTo` function can be used to verify that a stub function has been applied to the expected arguments.
If you want to verify this, you need to create a mock with the `createMock` function instead of the `createStubFn` function.
@@ -606,13 +668,9 @@
spec :: Spec
spec = do
it "stub & verify" do
- -- create a mock
mock <- createMock $ "value" |> True
- -- stub function
let stubFunction = stubFn mock
- -- assert
stubFunction "value" `shouldBe` True
- -- verify
mock `shouldApplyTo` "value"
```
### Note
@@ -628,7 +686,6 @@
spec = do
it "Verification does not work" do
mock <- createMock $ "expect arg" |> "return value"
- -- Apply arguments to stub functions but do not evaluate values
let _ = stubFn mock "expect arg"
mock `shouldApplyTo` "expect arg"
```
@@ -638,7 +695,6 @@
expected: "expect arg"
but got: Never been called.
```
-
### Verify the number of times the stub function was applied to the expected argument
The number of times a stub function is applied to an expected argument can be verified with the `shouldApplyTimes` function.
```haskell
@@ -657,15 +713,13 @@
```
### Verify that a function has been applied to something
You can verify that a function has been applied to something with the `shouldApplyToAnything` function.
-
### Verify the number of times a function has been applied to something
The number of times a function has been applied to something can be verified with the `shouldApplyTimesToAnything` function.
-
### Verify that stub functions are applied in the expected order
The `shouldApplyInOrder` function can be used to verify that the order in which they were applied is the expected order.
```haskell
{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE Type Applications #-}
import Test.Hspec
import Test.MockCat
@@ -680,7 +734,6 @@
"b" |> True
]
```
-
### Verify that they were applied in the expected order (partial match)
While the `shouldApplyInOrder` function verifies the exact order of application,
The `shouldApplyInPartialOrder` function allows you to verify that the order of application is partially matched.
@@ -702,3 +755,6 @@
"c" |> True
]
```
+
+
+
diff --git a/mockcat.cabal b/mockcat.cabal
--- a/mockcat.cabal
+++ b/mockcat.cabal
@@ -5,21 +5,22 @@
-- see: https://github.com/sol/hpack
name: mockcat
-version: 0.5.3.0
+version: 0.5.4.0
synopsis: Mock library for test in Haskell.
-description: mockcat is a flexible and powerful mock library.
- .
- It provides the following main features.
- .
- - Mock generation of monadic typeclasses
- .
- - Generation of stub functions independent of typeclasses
+description: mockcat is a small mocking / stubbing DSL for Haskell tests.
.
- - Verification of stub functions
+ Features:
.
- Stub functions can return not only values of monadic types, but also pure types.
+ * Describe expectations with left-to-right pipelines: `arg |> ... |> result`
+ * Generate typeclass mocks via Template Haskell (`makeMock`, `makePartialMock`)
+ * Create standalone function stubs (`createStubFn`, constant mocks)
+ * Flexible return behaviour: vary by argument or occurrence (including identical args later)
+ * Optional per-call variation for `IO a` results
+ * Concurrency-safe counting and explicit lazy semantics (unevaluated results are not recorded)
+ * Simple verification helpers (apply count predicates, ordering checks)
+ * Partial adoption: mock only selected methods; no hidden global state
.
- For more please see the README on GitHub at
+ See README for full examples:
category: Testing
homepage: https://github.com/pujoheadsoft/mockcat#readme
bug-reports: https://github.com/pujoheadsoft/mockcat/issues
@@ -31,6 +32,7 @@
build-type: Simple
extra-source-files:
README.md
+ README-ja.md
CHANGELOG.md
source-repository head
@@ -51,7 +53,7 @@
Paths_mockcat
hs-source-dirs:
src
- ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -fprint-potential-instances
+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -fprint-potential-instances -Wredundant-constraints
build-depends:
base >=4.7 && <5
, mtl >=2.3.1 && <2.4
@@ -67,6 +69,7 @@
main-is: Spec.hs
other-modules:
Test.MockCat.AssociationListSpec
+ Test.MockCat.ConcurrencySpec
Test.MockCat.ConsSpec
Test.MockCat.Definition
Test.MockCat.ExampleSpec
@@ -80,7 +83,7 @@
Paths_mockcat
hs-source-dirs:
test
- ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -fprint-potential-instances -threaded -rtsopts -with-rtsopts=-N
+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -fprint-potential-instances -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
async >=2.2.4 && <2.3
, base >=4.7 && <5
diff --git a/src/Test/MockCat/Mock.hs b/src/Test/MockCat/Mock.hs
--- a/src/Test/MockCat/Mock.hs
+++ b/src/Test/MockCat/Mock.hs
@@ -45,7 +45,7 @@
import Control.Monad (guard, when, ap)
import Data.Function ((&))
-import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
+import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef')
import Data.List (elemIndex, intercalate)
import Data.Maybe
import Data.Text (pack, replace, unpack)
@@ -831,17 +831,21 @@
appendAppliedParams :: IORef (AppliedRecord params) -> params -> IO ()
appendAppliedParams ref inputParams = do
- modifyIORef' ref (\AppliedRecord {appliedParamsList, appliedParamsCounter} -> AppliedRecord {
- appliedParamsList = appliedParamsList ++ [inputParams],
- appliedParamsCounter = appliedParamsCounter
- })
+ atomicModifyIORef' ref (\AppliedRecord {appliedParamsList, appliedParamsCounter} ->
+ let newRecord = AppliedRecord {
+ appliedParamsList = appliedParamsList ++ [inputParams],
+ appliedParamsCounter = appliedParamsCounter
+ }
+ in (newRecord, ()))
-incrementAppliedParamCount ::Eq params => IORef (AppliedRecord params) -> params -> IO ()
+incrementAppliedParamCount :: Eq params => IORef (AppliedRecord params) -> params -> IO ()
incrementAppliedParamCount ref inputParams = do
- modifyIORef' ref (\AppliedRecord {appliedParamsList, appliedParamsCounter} -> AppliedRecord {
- appliedParamsList = appliedParamsList,
- appliedParamsCounter = incrementCount inputParams appliedParamsCounter
- })
+ atomicModifyIORef' ref (\AppliedRecord {appliedParamsList, appliedParamsCounter} ->
+ let newRecord = AppliedRecord {
+ appliedParamsList = appliedParamsList,
+ appliedParamsCounter = incrementCount inputParams appliedParamsCounter
+ }
+ in (newRecord, ()))
incrementCount :: Eq k => k -> AppliedParamsCounter k -> AppliedParamsCounter k
incrementCount key list =
diff --git a/src/Test/MockCat/MockT.hs b/src/Test/MockCat/MockT.hs
--- a/src/Test/MockCat/MockT.hs
+++ b/src/Test/MockCat/MockT.hs
@@ -1,27 +1,49 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
-module Test.MockCat.MockT (MockT(..), Definition(..), runMockT, applyTimesIs, neverApply) where
-import Control.Monad.State
- ( StateT(..), MonadIO(..), MonadTrans(..), modify, execStateT, runStateT )
+module Test.MockCat.MockT (MockT(..), Definition(..), runMockT, applyTimesIs, neverApply, MonadMockDefs(..)) where
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Reader (ReaderT(..), runReaderT)
import GHC.TypeLits (KnownSymbol)
import Data.Data (Proxy)
import Test.MockCat.Mock (Mock, shouldApplyTimesToAnything)
import Data.Foldable (for_)
import UnliftIO (MonadUnliftIO(..))
-import Data.Functor ((<&>))
+import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef')
-newtype MockT m a = MockT { st :: StateT [Definition] m a }
+{- | MockT is a thin wrapper over @ReaderT (IORef [Definition])@ providing
+ mock/stub registration and post-run verification.
+
+Concurrency safety (summary):
+ * Within a single 'runMockT' invocation, concurrent applications of stub
+ functions are recorded without lost or double counts. This is achieved via
+ atomic modifications ('atomicModifyIORef'').
+ * The /moment/ a call is recorded is when the stub's return value is evaluated;
+ if you only create an application but never force the result, it will not
+ appear in the verification log.
+ * Order-sensitive checks reflect evaluation order, not necessarily wall-clock
+ start order between threads.
+ * Perform verification (e.g. 'shouldApplyTimes', 'applyTimesIs') after all
+ parallel work has completed; running it mid-flight may observe fewer calls
+ simply because some results are still lazy.
+ * Each 'runMockT' call uses a fresh IORef store; mocks are not shared across
+ separate 'runMockT' boundaries.
+-}
+newtype MockT m a = MockT { unMockT :: ReaderT (IORef [Definition]) m a }
deriving (Functor, Applicative, Monad, MonadTrans, MonadIO)
+class Monad m => MonadMockDefs m where
+ addDefinition :: Definition -> m ()
+ getDefinitions :: m [Definition]
+
instance MonadUnliftIO m => MonadUnliftIO (MockT m) where
- withRunInIO inner = MockT $ StateT $ \s -> do
- a <- withRunInIO $ \runInIO ->
- inner (\(MockT m) -> runInIO (runStateT m s) <&> fst)
- pure (a, s)
+ withRunInIO inner = MockT $ ReaderT $ \ref ->
+ withRunInIO $ \run -> inner (\(MockT r) -> run (runReaderT r ref))
data Definition = forall f p sym. KnownSymbol sym => Definition {
symbol :: Proxy sym,
@@ -65,16 +87,26 @@
-}
runMockT :: MonadIO m => MockT m a -> m a
-runMockT (MockT s) = do
- r <- runStateT s []
- let
- !a = fst r
- defs = snd r
+runMockT (MockT r) = do
+ ref <- liftIO $ newIORef []
+ a <- runReaderT r ref
+ defs <- liftIO $ readIORef ref
for_ defs (\(Definition _ m v) -> liftIO $ v m)
pure a
-{- | Specify how many times a stub function should be applied.
+{- | Specify how many times a stub function (or group of stub definitions) must
+ be applied (to /any/ arguments). The function patches the verification
+ predicate for the provided stub definitions so that, after 'runMockT'
+ completes, the total number of evaluated applications is checked.
+ Concurrency & laziness notes:
+ * Counting is thread-safe: each evaluated application contributes exactly 1.
+ * An application is only counted once its return value is evaluated; ensure
+ your test forces (e.g. via @shouldBe@ or sequencing) all stub results
+ before relying on the count.
+ * Invoke 'applyTimesIs' inside the 'runMockT' block during setup; do not
+ call it after the block ends.
+
@
import Test.Hspec
import Test.MockCat
@@ -108,14 +140,28 @@
@
-}
-applyTimesIs :: Monad m => MockT m () -> Int -> MockT m ()
-applyTimesIs (MockT st) a = MockT do
- defs <- lift $ execStateT st []
- let newDefs = map (\(Definition s m _) -> Definition s m (`shouldApplyTimesToAnything` a)) defs
- modify (++ newDefs)
+applyTimesIs :: MonadIO m => MockT m () -> Int -> MockT m ()
+applyTimesIs (MockT inner) a = MockT $ ReaderT $ \ref -> do
+ tmp <- liftIO $ newIORef []
+ _ <- runReaderT inner tmp
+ defs <- liftIO $ readIORef tmp
+ let patched = map (\(Definition s m _) -> Definition s m (`shouldApplyTimesToAnything` a)) defs
+ liftIO $ atomicModifyIORef' ref (\xs -> (xs ++ patched, ()))
+ pure ()
-neverApply :: Monad m => MockT m () -> MockT m ()
-neverApply (MockT st) = MockT do
- defs <- lift $ execStateT st []
- let newDefs = map (\(Definition s m _) -> Definition s m (`shouldApplyTimesToAnything` 0)) defs
- modify (++ newDefs)
+neverApply :: MonadIO m => MockT m () -> MockT m ()
+neverApply (MockT inner) = MockT $ ReaderT $ \ref -> do
+ tmp <- liftIO $ newIORef []
+ _ <- runReaderT inner tmp
+ defs <- liftIO $ readIORef tmp
+ let patched = map (\(Definition s m _) -> Definition s m (`shouldApplyTimesToAnything` 0)) defs
+ liftIO $ atomicModifyIORef' ref (\xs -> (xs ++ patched, ()))
+ pure ()
+
+instance MonadIO m => MonadMockDefs (MockT m) where
+ addDefinition d = MockT $ ReaderT $ \ref -> liftIO $ atomicModifyIORef' ref (\xs -> (xs ++ [d], ()))
+ getDefinitions = MockT $ ReaderT $ \ref -> liftIO $ readIORef ref
+
+instance MonadIO m => MonadMockDefs (ReaderT (IORef [Definition]) m) where
+ addDefinition d = ReaderT $ \ref -> liftIO $ atomicModifyIORef' ref (\xs -> (xs ++ [d], ()))
+ getDefinitions = ReaderT $ \ref -> liftIO $ readIORef ref
diff --git a/src/Test/MockCat/TH.hs b/src/Test/MockCat/TH.hs
--- a/src/Test/MockCat/TH.hs
+++ b/src/Test/MockCat/TH.hs
@@ -22,14 +22,13 @@
where
import Control.Monad (guard, unless)
-import Control.Monad.State (get, modify)
+import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Class (lift)
import Data.Data (Proxy (..))
import Data.Function ((&))
import Data.List (elemIndex, find, nub)
import Data.Maybe (fromMaybe, isJust)
import Data.Text (pack, splitOn, unpack)
-import GHC.IO (unsafePerformIO)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Language.Haskell.TH
( Cxt,
@@ -351,18 +350,24 @@
createCxt :: [Pred] -> MockType -> Name -> Name -> [TyVarBndr a] -> [VarAppliedType] -> Q [Pred]
createCxt cxt mockType className monadVarName tyVars varAppliedTypes = do
- newCxt <- mapM (createPred monadVarName) cxt
+ newCxtRaw <- mapM (createPred monadVarName) cxt
- monadAppT <- appT (conT ''Monad) (varT monadVarName)
+ let isRedundantMonad (AppT (ConT m) (VarT v)) = m == ''Monad && v == monadVarName
+ isRedundantMonad _ = False
+ newCxt = filter (not . isRedundantMonad) newCxtRaw
- let hasMonad = P.any (\(ClassName2VarNames c _) -> c == ''Monad) $ toClassInfos newCxt
+ monadIOAppT <- appT (conT ''MonadIO) (varT monadVarName)
+ let classInfos = toClassInfos newCxt
+ hasMonadIO = P.any (\(ClassName2VarNames c _) -> c == ''MonadIO) classInfos
+ addedMonads = [monadIOAppT | not hasMonadIO]
+
pure $ case mockType of
- Total -> newCxt ++ ([monadAppT | not hasMonad])
+ Total -> newCxt ++ addedMonads
Partial -> do
let classAppT = constructClassAppT className $ toVarTs tyVars
varAppliedClassAppT = updateType classAppT varAppliedTypes
- newCxt ++ ([monadAppT | not hasMonad]) ++ [varAppliedClassAppT]
+ newCxt ++ addedMonads ++ [varAppliedClassAppT]
toVarTs :: [TyVarBndr a] -> [Type]
toVarTs tyVars = VarT <$> getTypeVarNames tyVars
@@ -417,7 +422,7 @@
else [| lift $(varE r) |]
[|
MockT $ do
- defs <- get
+ defs <- getDefinitions
let mock =
defs
& findParam (Proxy :: Proxy $(litT (strTyLit fnNameStr)))
@@ -433,7 +438,7 @@
else [| lift $(varE r) |]
[|
MockT $ do
- defs <- get
+ defs <- getDefinitions
case findParam (Proxy :: Proxy $(litT (strTyLit fnNameStr))) defs of
Just mock -> do
let $(bangP $ varP r) = $(generateStubFn args [|mock|])
@@ -482,7 +487,7 @@
sigD
mockFunName
[t|
- (MockBuilder $(varT params) ($(pure funType)) ($(pure verifyParams)), Monad $(varT monadVarName)) =>
+ (MockBuilder $(varT params) ($(pure funType)) ($(pure verifyParams)), MonadIO $(varT monadVarName)) =>
$(varT params) ->
MockT $(varT monadVarName) ()
|]
@@ -496,7 +501,7 @@
doCreateConstantMockFnDecs :: (Quote m) => String -> Name -> Type -> Name -> m [Dec]
doCreateConstantMockFnDecs funNameStr mockFunName ty monadVarName = do
- newFunSig <- sigD mockFunName [t|(Monad $(varT monadVarName)) => $(pure ty) -> MockT $(varT monadVarName) ()|]
+ newFunSig <- sigD mockFunName [t|(MonadIO $(varT monadVarName)) => $(pure ty) -> MockT $(varT monadVarName) ()|]
createMockFn <- [|createNamedConstantMock|]
mockBody <- createMockBody funNameStr createMockFn
newFun <- funD mockFunName [clause [varP $ mkName "p"] (normalB (pure mockBody)) []]
@@ -510,7 +515,7 @@
sigD
mockFunName
[t|
- (MockBuilder $(varT params) ($(pure funType)) (), Monad $(varT monadVarName)) =>
+ (MockBuilder $(varT params) ($(pure funType)) (), MonadIO $(varT monadVarName)) =>
$(varT params) ->
MockT $(varT monadVarName) ()
|]
@@ -525,14 +530,13 @@
createMockBody :: (Quote m) => String -> Exp -> m Exp
createMockBody funNameStr createMockFn =
[|
- MockT $
- modify
- ( ++
- [ Definition
- (Proxy :: Proxy $(litT (strTyLit funNameStr)))
- (unsafePerformIO $ $(pure createMockFn) $(litE (stringL funNameStr)) p)
- shouldApplyToAnything
- ]
+ MockT $ do
+ mockInstance <- liftIO $ $(pure createMockFn) $(litE (stringL funNameStr)) p
+ addDefinition
+ ( Definition
+ (Proxy :: Proxy $(litT (strTyLit funNameStr)))
+ mockInstance
+ shouldApplyToAnything
)
|]
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -8,6 +8,7 @@
import Test.MockCat.TypeClassTHSpec as TypeClassTH
import Test.MockCat.PartialMockSpec as PartialMock
import Test.MockCat.PartialMockTHSpec as PartialMockTH
+import Test.MockCat.ConcurrencySpec as Concurrency
main :: IO ()
main = do
@@ -21,3 +22,4 @@
TypeClassTH.spec
PartialMock.spec
PartialMockTH.spec
+ Concurrency.spec
diff --git a/test/Test/MockCat/ConcurrencySpec.hs b/test/Test/MockCat/ConcurrencySpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/MockCat/ConcurrencySpec.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+module Test.MockCat.ConcurrencySpec (spec) where
+
+import Test.Hspec
+import Test.MockCat
+import Prelude hiding (any)
+import Control.Concurrent.Async (async, wait)
+import Control.Concurrent (threadDelay)
+import Control.Monad (replicateM, replicateM_)
+import Control.Monad.IO.Unlift (withRunInIO, MonadUnliftIO)
+
+class Monad m => ConcurrencyAction m where
+ action :: Int -> m Int
+
+makeMock [t|ConcurrencyAction|]
+
+-- -------------------------
+-- test target functions
+parallelActionSum :: (ConcurrencyAction m, MonadUnliftIO m) => Int -> m Int
+parallelActionSum n = do
+ values <- withRunInIO \runInIO -> do
+ as <- replicateM n (async $ runInIO (action 49))
+ mapM wait as
+ pure (sum values)
+
+parallelCallActionWithDelay :: (ConcurrencyAction m, MonadUnliftIO m) => Int -> Int -> m ()
+parallelCallActionWithDelay threads callsPerThread =
+ withRunInIO \runInIO -> do
+ as <- replicateM threads (async $ do
+ replicateM_ callsPerThread $ do
+ _ <- runInIO (action 123)
+ threadDelay 100)
+ mapM_ wait as
+
+parallelCallActionN :: (ConcurrencyAction m, MonadUnliftIO m) => Int -> m ()
+parallelCallActionN n = withRunInIO \runInIO -> do
+ as <- replicateM n (async $ runInIO (action 7))
+ mapM_ wait as
+-- -------------------------
+
+spec :: Spec
+spec = do
+ describe "Concurrency / applyTimesIs" do
+ it "counts calls across parallel async threads" do
+ result <- runMockT do
+ _action (any |> (1 :: Int)) `applyTimesIs` 10
+
+ parallelActionSum 10
+ result `shouldBe` 10
+
+ it "stress concurrent applyTimesIs with nested unlifts" do
+ let threads = 50 :: Int
+ callsPerThread = 20 :: Int
+ total = threads * callsPerThread :: Int
+ _ <- (runMockT $ do
+ _action (any |> (1 :: Int)) `applyTimesIs` total
+ parallelCallActionWithDelay threads callsPerThread
+ ) :: IO ()
+ pure ()
+
+ it "fails verification when calls are fewer than declared" do
+ runMockT (do
+ _action (any |> (1 :: Int)) `applyTimesIs` 10
+ parallelCallActionN 9
+ pure ()
+ ) `shouldThrow` anyErrorCall
+
+ describe "Concurrency / neverApply" do
+ it "neverApply passes when stub not used in parallel context" do
+ r <- runMockT do
+ neverApply $ _action (any |> (99 :: Int))
+
+ pure (123 :: Int)
+ r `shouldBe` 123
diff --git a/test/Test/MockCat/PartialMockSpec.hs b/test/Test/MockCat/PartialMockSpec.hs
--- a/test/Test/MockCat/PartialMockSpec.hs
+++ b/test/Test/MockCat/PartialMockSpec.hs
@@ -23,14 +23,15 @@
import Data.List (find)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Unsafe.Coerce (unsafeCoerce)
-import GHC.IO (unsafePerformIO)
-import Control.Monad.State
+
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.Reader hiding (ask)
-instance (Monad m, FileOperation m) => FileOperation (MockT m) where
+instance (MonadIO m, FileOperation m) => FileOperation (MockT m) where
readFile path = MockT do
- defs <- get
+ defs <- getDefinitions
case findParam (Proxy :: Proxy "readFile") defs of
Just mock -> do
let !result = stubFn mock path
@@ -38,54 +39,50 @@
Nothing -> lift $ readFile path
writeFile path content = MockT do
- defs <- get
+ defs <- getDefinitions
case findParam (Proxy :: Proxy "writeFile") defs of
Just mock -> do
let !result = stubFn mock path content
pure result
Nothing -> lift $ writeFile path content
-_readFile :: (MockBuilder params (FilePath -> Text) (Param FilePath), Monad m) => params -> MockT m ()
+_readFile :: (MockBuilder params (FilePath -> Text) (Param FilePath), MonadIO m) => params -> MockT m ()
_readFile p = MockT $ do
- modify (++ [Definition
- (Proxy :: Proxy "readFile")
- (unsafePerformIO $ createNamedMock "readFile" p)
- shouldApplyToAnything])
+ mockInstance <- liftIO $ createNamedMock "readFile" p
+ addDefinition (Definition (Proxy :: Proxy "readFile") mockInstance shouldApplyToAnything)
-_writeFile :: (MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text), Monad m) => params -> MockT m ()
-_writeFile p = MockT $ modify (++ [Definition
- (Proxy :: Proxy "writeFile")
- (unsafePerformIO $ createNamedMock "writeFile" p)
- shouldApplyToAnything])
+_writeFile :: (MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text), MonadIO m) => params -> MockT m ()
+_writeFile p = MockT $ do
+ mockInstance <- liftIO $ createNamedMock "writeFile" p
+ addDefinition (Definition (Proxy :: Proxy "writeFile") mockInstance shouldApplyToAnything)
findParam :: KnownSymbol sym => Proxy sym -> [Definition] -> Maybe a
findParam pa definitions = do
let definition = find (\(Definition s _ _) -> symbolVal s == symbolVal pa) definitions
fmap (\(Definition _ mock _) -> unsafeCoerce mock) definition
-instance (Monad m, Finder a b m) => Finder a b (MockT m) where
- findIds :: (Monad m, Finder a b m) => MockT m [a]
+instance (MonadIO m, Finder a b m) => Finder a b (MockT m) where
+ findIds :: (Finder a b m) => MockT m [a]
findIds = MockT do
- defs <- get
+ defs <- getDefinitions
case findParam (Proxy :: Proxy "_findIds") defs of
Just mock -> do
let !result = stubFn mock
pure result
Nothing -> lift findIds
- findById :: (Monad m, Finder a b m) => a -> MockT m b
+ findById :: (Finder a b m) => a -> MockT m b
findById id = MockT do
- defs <- get
+ defs <- getDefinitions
case findParam (Proxy :: Proxy "_findById") defs of
Just mock -> do
let !result = stubFn mock id
pure result
Nothing -> lift $ findById id
-_findIds :: Monad m => r -> MockT m ()
-_findIds p = MockT do
- modify (++ [Definition
- (Proxy :: Proxy "_findIds")
- (unsafePerformIO $ createNamedConstantMock "_findIds" p) shouldApplyToAnything])
+_findIds :: MonadIO m => r -> MockT m ()
+_findIds p = MockT $ do
+ mockInstance <- liftIO $ createNamedConstantMock "_findIds" p
+ addDefinition (Definition (Proxy :: Proxy "_findIds") mockInstance shouldApplyToAnything)
spec :: Spec
spec = do
diff --git a/test/Test/MockCat/PartialMockTHSpec.hs b/test/Test/MockCat/PartialMockTHSpec.hs
--- a/test/Test/MockCat/PartialMockTHSpec.hs
+++ b/test/Test/MockCat/PartialMockTHSpec.hs
@@ -17,13 +17,14 @@
import Data.Text (pack)
import Test.Hspec (Spec, it, shouldBe, describe)
import Test.MockCat
+
import Test.MockCat.Definition
import Test.MockCat.Impl ()
import Prelude hiding (readFile, writeFile)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Reader (ReaderT(..))
-data UserInput = UserInput String deriving (Show, Eq)
+newtype UserInput = UserInput String deriving (Show, Eq)
class Monad m => UserInputGetter m where
getInput :: m String
diff --git a/test/Test/MockCat/TypeClassSpec.hs b/test/Test/MockCat/TypeClassSpec.hs
--- a/test/Test/MockCat/TypeClassSpec.hs
+++ b/test/Test/MockCat/TypeClassSpec.hs
@@ -20,10 +20,10 @@
import GHC.TypeLits (KnownSymbol, symbolVal)
import Unsafe.Coerce (unsafeCoerce)
import Data.Maybe (fromMaybe)
-import GHC.IO (unsafePerformIO)
import Control.Monad.Reader (MonadReader)
+import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader.Class (ask, MonadReader (local))
-import Control.Monad.State
+import Control.Monad.Trans.Class (lift)
class Monad m => FileOperation m where
readFile :: FilePath -> m Text
@@ -45,63 +45,57 @@
writeFile outputPath modifiedContent
post $ modifiedContent <> pack ("+" <> e)
-instance (Monad m) => FileOperation (MockT m) where
+instance MonadIO m => FileOperation (MockT m) where
readFile path = MockT do
- defs <- get
+ defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `readFile`.") $ findParam (Proxy :: Proxy "readFile") defs
!result = stubFn mock path
pure result
writeFile path content = MockT do
- defs <- get
+ defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `writeFile`.") $ findParam (Proxy :: Proxy "writeFile") defs
!result = stubFn mock path content
pure result
-instance Monad m => ApiOperation (MockT m) where
+instance MonadIO m => ApiOperation (MockT m) where
post content = MockT do
- defs <- get
+ defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `post`.") $ findParam (Proxy :: Proxy "post") defs
!result = stubFn mock content
pure result
-instance Monad m => MonadReader String (MockT m) where
+instance MonadIO m => MonadReader String (MockT m) where
ask = MockT do
- defs <- get
+ defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `ask`.") $ findParam (Proxy :: Proxy "ask") defs
!result = stubFn mock
pure result
local = undefined
-_ask :: Monad m => params -> MockT m ()
+_ask :: MonadIO m => params -> MockT m ()
_ask p = MockT $ do
- modify (++ [Definition
- (Proxy :: Proxy "ask")
- (unsafePerformIO $ createNamedConstantMock "ask" p)
- shouldApplyToAnything])
+ mockInstance <- liftIO $ createNamedConstantMock "ask" p
+ addDefinition (Definition (Proxy :: Proxy "ask") mockInstance shouldApplyToAnything)
-_readFile :: (MockBuilder params (FilePath -> Text) (Param FilePath), Monad m) => params -> MockT m ()
+_readFile :: (MockBuilder params (FilePath -> Text) (Param FilePath), MonadIO m) => params -> MockT m ()
_readFile p = MockT $ do
- modify (++ [Definition
- (Proxy :: Proxy "readFile")
- (unsafePerformIO $ createNamedMock "readFile" p)
- shouldApplyToAnything])
+ mockInstance <- liftIO $ createNamedMock "readFile" p
+ addDefinition (Definition (Proxy :: Proxy "readFile") mockInstance shouldApplyToAnything)
-_writeFile :: (MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text), Monad m) => params -> MockT m ()
-_writeFile p = MockT $ modify (++ [Definition
- (Proxy :: Proxy "writeFile")
- (unsafePerformIO $ createNamedMock "writeFile" p)
- shouldApplyToAnything])
+_writeFile :: (MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text), MonadIO m) => params -> MockT m ()
+_writeFile p = MockT $ do
+ mockInstance <- liftIO $ createNamedMock "writeFile" p
+ addDefinition (Definition (Proxy :: Proxy "writeFile") mockInstance shouldApplyToAnything)
-_post :: (MockBuilder params (Text -> ()) (Param Text), Monad m) => params -> MockT m ()
-_post p = MockT $ modify (++ [Definition
- (Proxy :: Proxy "post")
- (unsafePerformIO $ createNamedMock "post" p)
- shouldApplyToAnything])
+_post :: (MockBuilder params (Text -> ()) (Param Text), MonadIO m) => params -> MockT m ()
+_post p = MockT $ do
+ mockInstance <- liftIO $ createNamedMock "post" p
+ addDefinition (Definition (Proxy :: Proxy "post") mockInstance shouldApplyToAnything)
findParam :: KnownSymbol sym => Proxy sym -> [Definition] -> Maybe a
findParam pa definitions = do
@@ -118,33 +112,30 @@
liftIO $ print v
echo $ show v
-instance (Monad m) => TestClass (MockT m) where
+instance MonadIO m => TestClass (MockT m) where
getBy a = MockT do
- defs <- get
+ defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `_getBy`.") $ findParam (Proxy :: Proxy "_getBy") defs
!result = stubFn mock a
lift result
echo a = MockT do
- defs <- get
+ defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `_echo`.") $ findParam (Proxy :: Proxy "_echo") defs
!result = stubFn mock a
lift result
-_getBy :: (MockBuilder params (String -> m Int) (Param String), Monad m) => params -> MockT m ()
+_getBy :: (MockBuilder params (String -> m Int) (Param String), MonadIO m) => params -> MockT m ()
_getBy p = MockT $ do
- modify (++ [Definition
- (Proxy :: Proxy "_getBy")
- (unsafePerformIO $ createNamedMock "_getBy" p)
- shouldApplyToAnything])
+ mockInstance <- liftIO $ createNamedMock "_getBy" p
+ addDefinition (Definition (Proxy :: Proxy "_getBy") mockInstance shouldApplyToAnything)
-_echo :: (MockBuilder params (String -> m ()) (Param String), Monad m) => params -> MockT m ()
-_echo p = MockT $ modify (++ [Definition
- (Proxy :: Proxy "_echo")
- (unsafePerformIO $ createNamedMock "_echo" p)
- shouldApplyToAnything])
+_echo :: (MockBuilder params (String -> m ()) (Param String), MonadIO m) => params -> MockT m ()
+_echo p = MockT $ do
+ mockInstance <- liftIO $ createNamedMock "_echo" p
+ addDefinition (Definition (Proxy :: Proxy "_echo") mockInstance shouldApplyToAnything)
class Monad m => Teletype m where
@@ -158,33 +149,30 @@
"" -> pure ()
_ -> writeTTY i >> echo2
-instance (Monad m) => Teletype (MockT m) where
+instance MonadIO m => Teletype (MockT m) where
readTTY = MockT do
- defs <- get
+ defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `_readTTY`.") $ findParam (Proxy :: Proxy "_readTTY") defs
!result = stubFn mock
lift result
writeTTY a = MockT do
- defs <- get
+ defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `_writeTTY`.") $ findParam (Proxy :: Proxy "_writeTTY") defs
!result = stubFn mock a
lift result
-_readTTY :: (MockBuilder params (m String) (), Monad m) => params -> MockT m ()
+_readTTY :: (MockBuilder params (m String) (), MonadIO m) => params -> MockT m ()
_readTTY p = MockT $ do
- modify (++ [Definition
- (Proxy :: Proxy "_readTTY")
- (unsafePerformIO $ createNamedMock "_readTTY" p)
- shouldApplyToAnything])
+ mockInstance <- liftIO $ createNamedMock "_readTTY" p
+ addDefinition (Definition (Proxy :: Proxy "_readTTY") mockInstance shouldApplyToAnything)
-_writeTTY :: (MockBuilder params (String -> m ()) (Param String), Monad m) => params -> MockT m ()
-_writeTTY p = MockT $ modify (++ [Definition
- (Proxy :: Proxy "_writeTTY")
- (unsafePerformIO $ createNamedMock "_writeTTY" p)
- shouldApplyToAnything])
+_writeTTY :: (MockBuilder params (String -> m ()) (Param String), MonadIO m) => params -> MockT m ()
+_writeTTY p = MockT $ do
+ mockInstance <- liftIO $ createNamedMock "_writeTTY" p
+ addDefinition (Definition (Proxy :: Proxy "_writeTTY") mockInstance shouldApplyToAnything)
spec :: Spec
spec = do
diff --git a/test/Test/MockCat/TypeClassTHSpec.hs b/test/Test/MockCat/TypeClassTHSpec.hs
--- a/test/Test/MockCat/TypeClassTHSpec.hs
+++ b/test/Test/MockCat/TypeClassTHSpec.hs
@@ -78,23 +78,20 @@
class MonadVar2_2 a m => MonadVar2_2Sub a m where
fn2_2Sub :: String -> m ()
-class Monad m => MonadVar3_1 m a b where
+class MonadIO m => MonadVar3_1 m a b where
class MonadVar3_1 m a b => MonadVar3_1Sub m a b where
fn3_1Sub :: String -> m ()
-class Monad m => MonadVar3_2 a m b where
+class MonadIO m => MonadVar3_2 a m b where
class MonadVar3_2 a m b => MonadVar3_2Sub a m b where
fn3_2Sub :: String -> m ()
-class Monad m => MonadVar3_3 a b m where
+class MonadIO m => MonadVar3_3 a b m where
class MonadVar3_3 a b m => MonadVar3_3Sub a b m where
fn3_3Sub :: String -> m ()
--makeMock [t|MonadReader Bool|]
makeMock [t|MonadReader Environment|]
-makeMock [t|MonadState String|]
-makeMock [t|MonadStateSub|]
-makeMock [t|MonadStateSub2|]
makeMock [t|MonadVar2_1Sub|]
makeMock [t|MonadVar2_2Sub|]
makeMock [t|MonadVar3_1Sub|]
@@ -108,20 +105,8 @@
fnParam3_2 :: m a
fnParam3_3 :: m b
-makeMock [t|ParamThreeMonad String Bool|]
-monadStateSubExec :: MonadStateSub String m => String -> m String
-monadStateSubExec s = do
- r <- fn_state (pure "X")
- pure $ s <> r
-threeParamMonadExec :: ParamThreeMonad String Bool m => m String
-threeParamMonadExec = do
- v1 <- fnParam3_1 "foo" True
- v2 <- fnParam3_2
- v3 <- fnParam3_3
- pure $ v1 <> v2 <> show v3
-
class Monad m => MultiApplyTest m where
getValueBy :: String -> m String
@@ -196,19 +181,6 @@
result `shouldBe` ()
- it "MonadState subclass mock" do
- r <- runMockT do
- _fn_state $ Just "X" |> "Y"
- monadStateSubExec "foo"
- r `shouldBe` "fooY"
-
- it "3 param Moand mock" do
- r <- runMockT do
- _fnParam3_1 $ "foo" |> True |> "Result1"
- _fnParam3_2 "Result2"
- _fnParam3_3 False
- threeParamMonadExec
- r `shouldBe` "Result1Result2False"
it "Multi apply" do
result <- runMockT do