mockcat 0.4.0.0 → 0.5.0.0

raw patch · 9 files changed

+644/−188 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +185/−50
• mockcat.cabal +1/−1
• src/Test/MockCat/Mock.hs +119/−23
• src/Test/MockCat/TH.hs +42/−12
• test/Test/MockCat/ExampleSpec.hs +52/−10
• test/Test/MockCat/MockSpec.hs +73/−75
• test/Test/MockCat/PartialMockTHSpec.hs +25/−5
• test/Test/MockCat/TypeClassSpec.hs +107/−9
• test/Test/MockCat/TypeClassTHSpec.hs +40/−3

@@ -1,37 +1,129 @@-# 🐈Mocking library for Haskell🐈‍+<div align="center">+    <img src="logo.png" width="830px" align="center" style="object-fit: cover"/>+</div> +[![Latest release](http://img.shields.io/github/release/pujoheadsoft/mockcat.svg)](https://github.com/pujoheadsoft/mockcat/releases) [![Test](https://github.com/pujoheadsoft/mockcat/workflows/Test/badge.svg)](https://github.com/pujoheadsoft/mockcat/actions?query=workflow%3ATest+branch%3Amain)+[![](https://img.shields.io/hackage/v/mockcat)](https://hackage.haskell.org/package/mockcat) -[日本語版 README はこちら](https://github.com/pujoheadsoft/mockcat/blob/master/README-ja.md) -# Overview-mockcat is a simple and flexible mocking library.+## Overview+mockcat is a mock library for Haskell.   -There are two main things you can do with mocks:-1. Create stub functions-2. Verify whether the stub functions were applied as expected+It can easily generate stub functions and verify the application of stub functions. -You can create two types of mocks:-1. Mocks for monad type classes-2. Mocks for functions+[日本語版 README はこちら](https://github.com/pujoheadsoft/mockcat/blob/master/README-ja.md) -**1** The monad type classes refer to classes like the following:+<details>+<summary>Update History</summary>++- **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+</details>++## Examples+Stub Function ```haskell-class Monad m => FileOperation m where-  readFile :: FilePath -> m Text-  writeFile :: FilePath -> Text -> m ()+-- create a stub function+stubFn <- createStubFn $ "value" |> True+-- assert+stubFn "value" `shouldBe` True ```+Verification+```haskell+-- create a mock+mock <- createMock $ "value" |> True+-- stub function+let stubFunction = stubFn mock+-- assert+stubFunction "value" `shouldBe` True+-- verify+mock `shouldApplyTo` "value"+```+Mock of Type Class+```haskell+result <- runMockT do+  -- stub functions+  _readFile $ "input.txt" |> pack "content"+  _writeFile $ "output.txt" |> pack "content" |> ()+  -- sut+  program "input.txt" "output.txt" -**2** The functions refer to regular functions like the following:  -(You can mock functions wrapped in a monad like IO (), as well as constant functions)+result `shouldBe` ()+```+## Stub Function Overview+Stub functions can be created with the `createStubFn` function.  +The arguments of `createStubFn` are the arguments expected to be applied, concatenated by `|>`, where the last value of `|>` is the return value of the function. ```haskell-calc :: Int -> Int-echo :: String -> IO ()-constantValue :: String+createStubFn $ (10 :: Int) |> "return value" ```+The same is true for stub functions in typeclass mocks.+```haskell+runMockT do+  _readFile $ "input.txt" |> pack "content"+```+Expected arguments can also be specified as conditions.+```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"+```+It is also possible to change the value returned depending on the argument.  +(It is also possible to return different values for the same argument.)+```haskell+-- Parameterized Stub+createStubFn do+  onCase $ "a" |> "return x"+  onCase $ "b" |> "return y"+createStubFn do+  onCase $ "arg" |> "x"+  onCase $ "arg" |> "y"+```+## Verification Overview+To verify the application of a stub function, first create a mock with the `createMock` function.  +Stub functions are retrieved from the mock with the `stubFn` function and used.  +Verification is performed on the mock.+```haskell+-- create a mock+mock <- createMock $ "value" |> True+-- stub function+let stubFunction = stubFn mock+-- assert+stubFunction "value" `shouldBe` True+-- verify+mock `shouldApplyTo` "value"+```+As with stub functions, conditions can be specified in the case of verification.+```haskell+mock `shouldApplyTo` any @String+mock `shouldApplyTo` expect_ (/= "not value")+mock `shouldApplyTo` $(expectByExpr [|(/= "not value")|])+```+You can also verify the number of times it has been applied.+```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)+```+In the case of typeclass mocks, when `runMockT` is applied, verification that the prepared stub functions have been applied is performed automatically.+```haskell+result <- runMockT do+  _readFile $ "input.txt" |> pack "Content"+  _writeFile $ "output.text" |> pack "Content" |> ()+  operationProgram "input.txt" "output.text" -# Mock of monad type class-## Example usage+result `shouldBe` ()+```+## Mock of monad type class+### Example usage For example, suppose the following monad type class `FileOperation` and a function `operationProgram` that uses `FileOperation` are defined. ```haskell class Monad m => FileOperation m where@@ -74,7 +166,7 @@  Mocks are run with `runMockT`. -## Verification+### Verification After execution, the stub function is verified to see if it is applied as expected.   For example, the expected argument of the stub function `_writeFile` in the above example is changed from `"content"` to `"edited content"`. ```haskell@@ -139,7 +231,7 @@  As described below, mockcat provides a variety of parameters other than `M.any`. -## Mock constant functions+### Mock constant functions mockcat can also mock constant functions.   Let's mock `MonadReader` and use the `ask` stub function. ```haskell@@ -176,8 +268,42 @@ ```haskell It has never been applied function `_ask` ```+### Mock that returns a value of type `IO a`.+Normally constant functions return the same value, but only for mocks that return a value of type `IO a`, you can create a mock that returns a different value each time it is applied.  +For example, suppose a typeclass `Teletype` and a function `echo` to be tested are defined.  +The `echo` will behave differently depending on the value returned by `readTTY`.+```haskell+class Monad m => Teletype m where+  readTTY :: m String+  writeTTY :: String -> m () -## Partial mocking+echo :: Teletype m => m ()+echo = do+  i <- readTTY+  case i of+    "" -> pure ()+    _  -> writeTTY i >> echo+```+You will want to verify that if `readTTY` returns anything other than `""`, it is called recursively.  +To do this, we need to be able to have `readTTY` return different values in a single test.  +To achieve this, create a mock with the `implicitMonadicReturn` option.+Using `implicitMonadicReturn` allows stub functions to explicitly return monadic values.+```haskell+makeMockWithOptions [t|Teletype|] options { implicitMonadicReturn = False }+```+This allows the test to use `onCase` to have a behavior where the first application returns a value other than `""` and the second application returns `""`.+```haskell+result <- runMockT do+  _readTTY $ do+    onCase $ pure @IO "a"+    onCase $ pure @IO ""++  _writeTTY $ "a" |> pure @IO ()+  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.  @@ -220,7 +346,7 @@     a `shouldBe` Nothing ``` -## Rename stub functions+### 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@@ -228,7 +354,7 @@ ``` If no options are specified, it defaults to ``_``. -## Code generated by makeMock+### Code generated by makeMock Although you do not need to be aware of it, the ``makeMock`` function generates the following code. ```haskell -- MockT instance@@ -240,12 +366,12 @@ _writeFile :: (MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text), Monad m) => params -> MockT m () ``` -# Mocking functions+## 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+### Example usage+```haskell {-# LANGUAGE BlockArguments #-} {-# LANGUAGE TypeApplications #-} import Test.Hspec@@ -267,7 +393,6 @@     mock `shouldApplyTo` "value"  ```- ## Stub functions To create a stub function directly, use the `createStubFn` function.   If you don't need verification, you can use this one.@@ -300,7 +425,7 @@   but got: "valuo" ```` -## Named Stub Functions+### Named Stub Functions You can name stub functions. ```haskell {-# LANGUAGE BlockArguments #-}@@ -322,7 +447,7 @@   but got: "x","z" ``` -## Constant stub functions+### Constant stub functions To create a stub function that returns a constant, use the `createConstantMock` or `createNamedConstantMock` function.    ```haskell@@ -339,7 +464,7 @@     shouldApplyToAnything m ``` -## Flexible stub functions+### 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.@@ -411,7 +536,7 @@     f 6 `shouldBe` "return value" ``` -## Stub functions that return different values for each argument applied+### 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 {-# LANGUAGE BlockArguments #-}@@ -423,16 +548,26 @@ spec :: Spec spec = do   it "multi" do-    f <--      createStubFn-        [ "a" |> "return x",-          "b" |> "return y"-        ]+    f <- createStubFn do+      onCase $ "a" |> "return x"+      onCase $ "b" |> "return y"     f "a" `shouldBe` "return x"     f "b" `shouldBe` "return y" ```+Alternatively, you can use the `cases` function.+```haskell+f <-+  createStubFn $+    cases+      [ "a" |> "return x",+        "b" |> "return y"+      ] -## Stub functions that return different values when applied to the same argument+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 {-# LANGUAGE BlockArguments #-}@@ -444,10 +579,10 @@ spec :: Spec spec = do   it "Return different values for the same argument" do-    f <- createStubFn [-        "arg" |> "x",-        "arg" |> "y"-      ]+    f <- createStubFn $ do+      onCase $ "arg" |> "x"+      onCase $ "arg" |> "y"+     -- Do not allow optimization to remove duplicates.     v1 <- evaluate $ f "arg"     v2 <- evaluate $ f "arg"@@ -457,7 +592,7 @@     v3 `shouldBe` "y" -- After the second time, "y" is returned. ``` -## Verify that expected arguments are applied+### 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.   In this case, stub functions are taken from the mock with the `stubFn` function.@@ -503,7 +638,7 @@   but got: Never been called. ``` -## Verify the number of times the stub function was applied to the expected argument+### 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 {-# LANGUAGE BlockArguments #-}@@ -519,13 +654,13 @@     print $ stubFn m "value"     m `shouldApplyTimes` (2 :: Int) `to` "value" ```-## Verify that a function has been applied to something+### 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+### 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+### 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 #-}@@ -545,7 +680,7 @@                            ] ``` -## Verify that they were applied in the expected order (partial match)+### 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. ```haskell

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           mockcat-version:        0.4.0.0+version:        0.5.0.0 synopsis:       Mock library for test in Haskell. description:    mockcat is a mock library for testing Haskell.                 .

@@ -4,8 +4,8 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}- {-# HLINT ignore "Use null" #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-}  {- | This module provides bellow functions. @@ -36,12 +36,14 @@     shouldApplyTimesLessThan,     shouldApplyToAnything,     shouldApplyTimesToAnything,-    to+    to,+    onCase,+    cases,+    casesIO   ) where -import Control.Monad (guard, when)-import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad (guard, when, ap) import Data.Function ((&)) import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Data.List (elemIndex, intercalate)@@ -54,6 +56,8 @@ import Test.MockCat.AssociationList (AssociationList, lookup, update, insert, empty, member) import Prelude hiding (lookup) import GHC.Stack (HasCallStack)+import Control.Monad.Trans+import Control.Monad.State  data Mock fun params = Mock (Maybe MockName) fun (Verifier params) @@ -280,98 +284,129 @@       pure v)  instance+  MockBuilder (IO r) (IO r) ()+  where+  build name a = do+    s <- liftIO $ newIORef appliedRecord+    makeMock name s (do+      liftIO $ appendAppliedParams s ()+      a)++instance   (Show a, Eq a, Show b, Eq b, Show c, Eq c, Show d, Eq d, Show e, Eq e, Show f, Eq f, Show g, Eq g, Show h, Eq h, Show i, Eq i) =>   MockBuilder-    [Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h :> Param i :> Param r]+    (Cases (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h :> Param i :> Param r) ())     (a -> b -> c -> d -> e -> f -> g -> h -> i -> r)     (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h :> Param i)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 b2 c2 d2 e2 f2 g2 h2 i2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2 :> p b2 :> p c2 :> p d2 :> p e2 :> p f2 :> p g2 :> p h2 :> p i2) s)  instance   (Show a, Eq a, Show b, Eq b, Show c, Eq c, Show d, Eq d, Show e, Eq e, Show f, Eq f, Show g, Eq g, Show h, Eq h) =>   MockBuilder-    [Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h :> Param r]+    (Cases (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h :> Param r) ())     (a -> b -> c -> d -> e -> f -> g -> h -> r)     (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 b2 c2 d2 e2 f2 g2 h2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2 :> p b2 :> p c2 :> p d2 :> p e2 :> p f2 :> p g2 :> p h2) s)  instance   (Show a, Eq a, Show b, Eq b, Show c, Eq c, Show d, Eq d, Show e, Eq e, Show f, Eq f, Show g, Eq g) =>   MockBuilder-    [Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param r]+    (Cases (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param r) ())     (a -> b -> c -> d -> e -> f -> g -> r)     (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 b2 c2 d2 e2 f2 g2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2 :> p b2 :> p c2 :> p d2 :> p e2 :> p f2 :> p g2) s)  instance   (Show a, Eq a, Show b, Eq b, Show c, Eq c, Show d, Eq d, Show e, Eq e, Show f, Eq f) =>   MockBuilder-    [Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param r]+    (Cases (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param r) ())     (a -> b -> c -> d -> e -> f -> r)     (Param a :> Param b :> Param c :> Param d :> Param e :> Param f)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 b2 c2 d2 e2 f2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2 :> p b2 :> p c2 :> p d2 :> p e2 :> p f2) s)  instance   (Show a, Eq a, Show b, Eq b, Show c, Eq c, Show d, Eq d, Show e, Eq e) =>   MockBuilder-    [Param a :> Param b :> Param c :> Param d :> Param e :> Param r]+    (Cases (Param a :> Param b :> Param c :> Param d :> Param e :> Param r) ())     (a -> b -> c -> d -> e -> r)     (Param a :> Param b :> Param c :> Param d :> Param e)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 b2 c2 d2 e2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2 :> p b2 :> p c2 :> p d2 :> p e2) s)  instance   (Show a, Eq a, Show b, Eq b, Show c, Eq c, Show d, Eq d) =>   MockBuilder-    [Param a :> Param b :> Param c :> Param d :> Param r]+    (Cases (Param a :> Param b :> Param c :> Param d :> Param r) ())     (a -> b -> c -> d -> r)     (Param a :> Param b :> Param c :> Param d)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 b2 c2 d2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2 :> p b2 :> p c2 :> p d2) s)  instance   (Show a, Eq a, Show b, Eq b, Show c, Eq c) =>   MockBuilder-    [Param a :> Param b :> Param c :> Param r]+    (Cases (Param a :> Param b :> Param c :> Param r) ())     (a -> b -> c -> r)     (Param a :> Param b :> Param c)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 b2 c2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2 :> p b2 :> p c2) s)  instance   (Show a, Eq a, Show b, Eq b) =>-  MockBuilder [Param a :> Param b :> Param r] (a -> b -> r) (Param a :> Param b)+  MockBuilder (Cases (Param a :> Param b :> Param r) ()) (a -> b -> r) (Param a :> Param b)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 b2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2 :> p b2) s)  instance   (Show a, Eq a) =>-  MockBuilder [Param a :> Param r] (a -> r) (Param a)+  MockBuilder (Cases (Param a :> Param r) ()) (a -> r) (Param a)   where-  build name params = do+  build name cases = do+    let params = runCase cases     s <- liftIO $ newIORef appliedRecord     makeMock name s (\a2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2) s) +instance+  MockBuilder (Cases (IO a) ()) (IO a) ()+  where+  build name cases = do+    let params = runCase cases+    s <- liftIO $ newIORef appliedRecord+    makeMock name s (do+      count <- readAppliedCount s ()+      let index = min count (length params - 1)+          r = safeIndex params index+      appendAppliedParams s ()+      incrementAppliedParamCount s ()+      fromJust r) -- ------  p :: a -> Param a@@ -829,7 +864,7 @@ shouldApplyTimesToAnything (Mock name _ (Verifier ref)) count = do   appliedParamsList <- readAppliedParamsList ref   let appliedCount = length appliedParamsList-  when (count /= appliedCount) $ +  when (count /= appliedCount) $         errorWithoutStackTrace $         intercalate           "\n"@@ -837,3 +872,64 @@             "  expected: " <> show count,             "   but got: " <> show appliedCount           ]++newtype Cases a b = Cases (State [a] b)++instance Functor (Cases a) where+  fmap f (Cases s) = Cases (fmap f s)++instance Applicative (Cases a) where+  pure x = Cases $ pure x+  (<*>) = ap++instance Monad (Cases a) where+  (Cases m) >>= f = Cases $ do+    result <- m+    let (Cases newState) = f result+    newState++runCase :: Cases a b -> [a]+runCase (Cases s) = execState s []++{- | Make a case for stub functions.  +This can be used to create stub functions that return different values depending on their arguments.++  @+  it "test" do+    f <-+      createStubFn $ do+        onCase $ "a" |> "return x"+        onCase $ "b" |> "return y"++    f "a" `shouldBe` "return x"+    f "b" `shouldBe` "return y"+  @+-}+onCase :: a -> Cases a ()+onCase a = Cases $ do+  st <- get+  put (st ++ [a])++{- | Make a list of patterns of arguments and returned values.  +This can be used to create stub functions that return different values depending on their arguments.++  @+  it "test" do+    f <-+      createStubFn $ cases [+        "a" |> "return x",+        "b" |> "return y"+      ]++    f "a" `shouldBe` "return x"+    f "b" `shouldBe` "return y"+  @+-}+cases :: [a] -> Cases a ()+cases a = Cases $ put a++{- | IO version of @'cases'@.  +@casesIO ["a", ""]@ has the same meaning as @cases [ pure \@IO "a", pure \@IO ""]@.+-}+casesIO :: [a] -> Cases (IO a) ()+casesIO = Cases . (put . map pure)

@@ -116,13 +116,13 @@ -- --  - prefix: Stub function prefix --  - suffix: stub function suffix-data MockOptions = MockOptions {prefix :: String, suffix :: String}+data MockOptions = MockOptions {prefix :: String, suffix :: String, implicitMonadicReturn :: Bool}  -- | Default Options. -- --  Stub function names are prefixed with “_”. options :: MockOptions-options = MockOptions {prefix = "_", suffix = ""}+options = MockOptions {prefix = "_", suffix = "", implicitMonadicReturn = True}  -- | Create a mock of the typeclasses that returns a monad according to the `MockOptions`. --@@ -398,15 +398,18 @@       fnNameStr = createFnName fnName options        fnBody = case mockType of-        Total -> generateInstanceMockFnBody fnNameStr args r-        Partial -> generateInstanceRealFnBody fnName fnNameStr args r+        Total -> generateInstanceMockFnBody fnNameStr args r options+        Partial -> generateInstanceRealFnBody fnName fnNameStr args r options        fnClause = clause params (normalB fnBody) []   funD fnName [fnClause] createInstanceFnDec _ _ dec = fail $ "unsuported dec: " <> pprint dec -generateInstanceMockFnBody :: String -> [Q Exp] -> Name -> Q Exp-generateInstanceMockFnBody fnNameStr args r =+generateInstanceMockFnBody :: String -> [Q Exp] -> Name -> MockOptions -> Q Exp+generateInstanceMockFnBody fnNameStr args r options = do+  returnExp <- if options.implicitMonadicReturn+    then [| pure $(varE r) |]+    else [| lift $(varE r) |]   [|     MockT $ do       defs <- get@@ -415,18 +418,21 @@               & findParam (Proxy :: Proxy $(litT (strTyLit fnNameStr)))               & fromMaybe (error $ "no answer found stub function `" ++ fnNameStr ++ "`.")           $(bangP $ varP r) = $(generateStubFn args [|mock|])-      pure $(varE r)+      $(pure returnExp)     |] -generateInstanceRealFnBody :: Name -> String -> [Q Exp] -> Name -> Q Exp-generateInstanceRealFnBody fnName fnNameStr args r =+generateInstanceRealFnBody :: Name -> String -> [Q Exp] -> Name -> MockOptions -> Q Exp+generateInstanceRealFnBody fnName fnNameStr args r options = do+  returnExp <- if options.implicitMonadicReturn+    then [| pure $(varE r) |]+    else [| lift $(varE r) |]   [|     MockT $ do       defs <- get       case findParam (Proxy :: Proxy $(litT (strTyLit fnNameStr))) defs of         Just mock -> do           let $(bangP $ varP r) = $(generateStubFn args [|mock|])-          pure $(varE r)+          $(pure returnExp)         Nothing -> lift $ $(foldl appE (varE fnName) args)     |] @@ -446,12 +452,17 @@       mockFunName = mkName funNameStr       params = mkName "p"       updatedType = updateType ty varAppliedTypes-      funType = createMockBuilderFnType monadVarName updatedType+      funType = if options.implicitMonadicReturn +        then createMockBuilderFnType monadVarName updatedType+        else updatedType    if isFunctionType ty then     doCreateMockFnDec funNameStr mockFunName params funType monadVarName updatedType   else-    doCreateConstantMockFnDec funNameStr mockFunName funType monadVarName+    if options.implicitMonadicReturn then+      doCreateConstantMockFnDec funNameStr mockFunName funType monadVarName+    else+      doCreateMockFnDec2 funNameStr mockFunName params funType monadVarName updatedType  createMockFnDec _ _ _ dec = fail $ "unsupport dec: " <> pprint dec @@ -480,6 +491,25 @@   createMockFn <- [|createNamedConstantMock|]   mockBody <- createMockBody funNameStr createMockFn   newFun <- funD mockFunName [clause [varP $ mkName "p"] (normalB (pure mockBody)) []]+  pure $ newFunSig : [newFun]++doCreateMockFnDec2 :: (Quote m) => String -> Name -> Name -> Type -> Name -> Type -> m [Dec]+doCreateMockFnDec2 funNameStr mockFunName params funType monadVarName updatedType = do+  newFunSig <- do+    let verifyParams = createMockBuilderVerifyParams updatedType+    sigD+      mockFunName+      [t|+        (MockBuilder $(varT params) ($(pure funType)) (), Monad $(varT monadVarName)) =>+        $(varT params) ->+        MockT $(varT monadVarName) ()+        |]++  createMockFn <- [|createNamedMock|]++  mockBody <- createMockBody funNameStr createMockFn+  newFun <- funD mockFunName [clause [varP $ mkName "p"] (normalB (pure mockBody)) []]+   pure $ newFunSig : [newFun]  createMockBody :: (Quote m) => String -> Exp -> m Exp

@@ -29,16 +29,59 @@   content <- readFile inputPath   writeFile outputPath content +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++makeMockWithOptions [t|Teletype|] options { implicitMonadicReturn = False }+ spec :: Spec spec = do-  it "" do+  it "echo1" do     result <- runMockT do+      _readTTY $ pure @IO ""+      echo+    result `shouldBe` ()++  it "echo2" do+    result <- runMockT do+      _readTTY $ do+        onCase $ pure @IO "a"+        onCase $ pure @IO ""++      _writeTTY $ "a" |> pure @IO ()+      echo+    result `shouldBe` ()++  it "echo3" do+    result <- runMockT do+      _readTTY $ casesIO ["a", ""]+      _readTTY $ cases [ pure @IO "a", pure @IO "" ]+      _writeTTY $ "a" |> pure @IO ()+      echo+    result `shouldBe` ()++  it "read & write" do+    result <- runMockT do       _readFile $ "input.txt" |> pack "Content"       _writeFile $ "output.text" |> pack "Content" |> ()       operationProgram "input.txt" "output.text"      result `shouldBe` () +  it "stub" do+    -- create a stub function+    stubFn <- createStubFn $ "value" |> True+    -- assert+    stubFn "value" `shouldBe` True+   it "stub & verify" do     -- create a mock     mock <- createMock $ "value" |> True@@ -108,19 +151,18 @@     f 6 `shouldBe` "return value"    it "multi" do-    f <--      createStubFn-        [ "a" |> "return x",-          "b" |> "return y"-        ]+    f <- createStubFn do+      onCase $ "a" |> "return x"+      onCase $ "b" |> "return y"+     f "a" `shouldBe` "return x"     f "b" `shouldBe` "return y"    it "Return different values for the same argument" do-    f <- createStubFn [-        "arg" |> "x",-        "arg" |> "y"-      ]+    f <- createStubFn $ do+      onCase $ "arg" |> "x"+      onCase $ "arg" |> "y"+     -- Do not allow optimization to remove duplicates.     v1 <- evaluate $ f "arg"     v2 <- evaluate $ f "arg"

@@ -15,26 +15,6 @@ import Data.Function ((&)) import Test.Hspec import Test.MockCat-  ( any,-    expectByExpr,-    stubFn,-    shouldApplyInOrder,-    shouldApplyInPartialOrder,-    shouldApplyTimes,-    shouldApplyTimesGreaterThan,-    shouldApplyTimesGreaterThanEqual,-    shouldApplyTimesLessThan,-    shouldApplyTimesLessThanEqual,-    shouldApplyTo,-    shouldApplyToAnything,-    createMock,-    createStubFn,-    createNamedMock,-    to,-    (|>), -    createConstantMock,-    createNamedConstantMock-  ) import Prelude hiding (any)  spec :: Spec@@ -203,10 +183,10 @@       Fixture         { name = "arity = 1",           create =-            createMock-              [ "1" |> True,-                "2" |> False-              ],+            createMock $ do+              onCase $ "1" |> True+              onCase $ "2" |> False+              ,           expected =             [ True,               False@@ -227,10 +207,10 @@       Fixture         { name = "arity = 2",           create =-            createMock-              [ "1" |> "2" |> True,-                "2" |> "3" |> False-              ],+            createMock $ do+              onCase $ "1" |> "2" |> True+              onCase $ "2" |> "3" |> False+              ,           expected =             [ True,               False@@ -254,10 +234,10 @@       Fixture         { name = "arity = 3",           create =-            createMock-              [ "1" |> "2" |> "3" |> True,-                "2" |> "3" |> "4" |> False-              ],+            createMock $ do+              onCase $ "1" |> "2" |> "3" |> True+              onCase $ "2" |> "3" |> "4" |> False+              ,           expected =             [ True,               False@@ -281,10 +261,10 @@       Fixture         { name = "arity = 4",           create =-            createMock-              [ "1" |> "2" |> "3" |> "4" |> True,-                "2" |> "3" |> "4" |> "5" |> False-              ],+            createMock $ do+              onCase $ "1" |> "2" |> "3" |> "4" |> True+              onCase $ "2" |> "3" |> "4" |> "5" |> False+              ,           expected =             [ True,               False@@ -308,10 +288,10 @@       Fixture         { name = "arity = 5",           create =-            createMock-              [ "1" |> "2" |> "3" |> "4" |> "5" |> True,-                "2" |> "3" |> "4" |> "5" |> "6" |> False-              ],+            createMock $ do+              onCase $ "1" |> "2" |> "3" |> "4" |> "5" |> True+              onCase $ "2" |> "3" |> "4" |> "5" |> "6" |> False+              ,           expected =             [ True,               False@@ -335,10 +315,10 @@       Fixture         { name = "arity = 6",           create =-            createMock-              [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> True,-                "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> False-              ],+            createMock $ do+              onCase $ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> True+              onCase $ "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> False+              ,           expected =             [ True,               False@@ -362,10 +342,10 @@       Fixture         { name = "arity = 7",           create =-            createMock-              [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> True,-                "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> False-              ],+            createMock $ do+              onCase $ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> True+              onCase $ "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> False+              ,           expected =             [ True,               False@@ -389,10 +369,10 @@       Fixture         { name = "arity = 8",           create =-            createMock-              [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> True,-                "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> False-              ],+            createMock $ do+              onCase $ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> True+              onCase $ "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> False+              ,           expected =             [ True,               False@@ -416,10 +396,10 @@       Fixture         { name = "arity = 9",           create =-            createMock-              [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> True,-                "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> "10" |> False-              ],+            createMock $ do+              onCase $ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> True+              onCase $ "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> "10" |> False+              ,           expected =             [ True,               False@@ -637,10 +617,10 @@          it "multi mock" do           m <--            createMock-              [ "aaa" |> (100 :: Int) |> pure @IO True,-                "bbb" |> (200 :: Int) |> pure @IO False-              ]+            createMock $ do+              onCase $ "aaa" |> (100 :: Int) |> pure @IO True+              onCase $ "bbb" |> (200 :: Int) |> pure @IO False+           stubFn m "aaa" 200             `shouldThrow` errorCall               "function was not applied to the expected arguments.\n\@@ -743,9 +723,9 @@           m <-             createNamedMock               "mock function"-              [ "aaa" |> True |> pure @IO True,-                "bbb" |> False |> pure @IO False-              ]+              do +                onCase $ "aaa" |> True |> pure @IO True+                onCase $ "bbb" |> False |> pure @IO False           let e =                 "function `mock function` was not applied to the expected arguments.\n\                 \  expected one of the following:\n\@@ -833,12 +813,12 @@    describe "repeatable" do     it "arity = 1" do-      f <- createStubFn [-          "a" |> True,-          "b" |> False,-          "a" |> False,-          "b" |> True-        ]+      f <- createStubFn $ do+        onCase $ "a" |> True+        onCase $ "b" |> False+        onCase $ "a" |> False+        onCase $ "b" |> True+               v1 <- evaluate $ f "a"       v2 <- evaluate $ f "a"       v3 <- evaluate $ f "b"@@ -849,12 +829,12 @@       v4 `shouldBe` True      it "arity = 2" do-      f <- createStubFn [-          "a" |> "b" |> (0 :: Int),-          "a" |> "c" |> (1 :: Int),-          "a" |> "b" |> (2 :: Int),-          "a" |> "c" |> (3 :: Int)-        ]+      f <- createStubFn $ do+        onCase $ "a" |> "b" |> (0 :: Int)+        onCase $ "a" |> "c" |> (1 :: Int)+        onCase $ "a" |> "b" |> (2 :: Int)+        onCase $ "a" |> "c" |> (3 :: Int)+       v1 <- evaluate $ f "a" "b"       v2 <- evaluate $ f "a" "b"       v3 <- evaluate $ f "a" "c"@@ -884,6 +864,24 @@     it "createNamedConstantMock (error message)" do       m <- createNamedConstantMock "constant" "foo"       shouldApplyToAnything m `shouldThrow` errorCall "It has never been applied function `constant`"++    it "verify constant IO mock" do+      m <- createMock $ pure @IO "foo"+      stubFn m `shouldReturn` "foo"+      stubFn m `shouldReturn` "foo"+      stubFn m `shouldReturn` "foo"+      m `shouldApplyTimesToAnything` 3++    it "verify constant multi IO mock" do+      m <- createMock $ do+        onCase $ pure @IO "foo"+        onCase $ pure @IO "bar"+        onCase $ pure @IO "baz"++      stubFn m `shouldReturn` "foo"+      stubFn m `shouldReturn` "bar"+      stubFn m `shouldReturn` "baz"+      m `shouldApplyTimesToAnything` 3  data Fixture mock r = Fixture   { name :: String,

@@ -39,9 +39,23 @@   toUserInput "" = pure Nothing   toUserInput a = (pure . Just . UserInput) a +class Monad m => ExplicitlyReturnMonadicValuesPartialTest m where+  echo :: String -> m ()+  getBy :: String -> m Int++instance ExplicitlyReturnMonadicValuesPartialTest IO where+  echo _ = pure () +  getBy s = pure $ length s+  +echoProgram :: ExplicitlyReturnMonadicValuesPartialTest m => String -> m ()+echoProgram s = do+  v <- getBy s+  echo $ show v+ makePartialMock [t|UserInputGetter|] makePartialMock [t|Finder|] makePartialMock [t|FileOperation|]+makePartialMockWithOptions [t|ExplicitlyReturnMonadicValuesPartialTest|] options { implicitMonadicReturn = False }  spec :: Spec spec = do@@ -94,10 +108,16 @@        it "partial findById" do         values <- runMockT  do-          _findById [-            (1 :: Int) |> "id1",-            (2 :: Int) |> "id2",-            (3 :: Int) |> "id3"-            ]+          _findById $ do+            onCase $ (1 :: Int) |> "id1"+            onCase $ (2 :: Int) |> "id2"+            onCase $ (3 :: Int) |> "id3"           findValue         values `shouldBe` ["id1", "id2", "id3"]++    it "Return monadic value test" do+      result <- runMockT do+        _echo $ "3" |> pure @IO ()+        echoProgram "abc"++      result `shouldBe` ()

@@ -7,6 +7,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# LANGUAGE TypeApplications #-}  module Test.MockCat.TypeClassSpec (spec) where @@ -107,15 +108,112 @@   let definition = find (\(Definition s _ _) -> symbolVal s == symbolVal pa) definitions   fmap (\(Definition _ mock _) -> unsafeCoerce mock) definition +class Monad m => TestClass m where+  echo :: String -> m ()+  getBy :: String -> m Int++echoProgram :: MonadIO m => TestClass m => String -> m ()+echoProgram s = do+  v <- getBy s+  liftIO $ print v+  echo $ show v++instance (Monad m) => TestClass (MockT m) where+  getBy a = MockT do+    defs <- get+    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+    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 p = MockT $ do+  modify (++ [Definition+    (Proxy :: Proxy "_getBy")+    (unsafePerformIO $ createNamedMock "_getBy" p)+    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])+++class Monad m => Teletype m where+  readTTY :: m String+  writeTTY :: String -> m ()++echo2 :: Teletype m => m ()+echo2 = do+  i <- readTTY+  case i of+    "" -> pure ()+    _  -> writeTTY i >> echo2++instance (Monad m) => Teletype (MockT m) where+  readTTY = MockT do+    defs <- get+    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+    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 p = MockT $ do+  modify (++ [Definition+    (Proxy :: Proxy "_readTTY")+    (unsafePerformIO $ createNamedMock "_readTTY" p)+    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])+ spec :: Spec-spec = it "Read, edit, and output files" do-  modifyContentStub <- createStubFn $ pack "content" |> pack "modifiedContent"+spec = do+  it "echo" do+    result <- runMockT do+      _readTTY $ casesIO [+        "a",+        ""+        ]+      _writeTTY $ "a" |> pure @IO ()+      echo2+    result `shouldBe` () -  result <- runMockT do-    _ask "environment"-    _readFile ("input.txt" |> pack "content")-    _writeFile $ "output.text" |> pack "modifiedContent" |> ()-    _post $ pack "modifiedContent+environment" |> ()-    program "input.txt" "output.text" modifyContentStub+  it "Read, edit, and output files" do+    modifyContentStub <- createStubFn $ pack "content" |> pack "modifiedContent" -  result `shouldBe` ()+    result <- runMockT do+      _ask "environment"+      _readFile ("input.txt" |> pack "content")+      _writeFile $ "output.text" |> pack "modifiedContent" |> ()+      _post $ pack "modifiedContent+environment" |> ()+      program "input.txt" "output.text" modifyContentStub++    result `shouldBe` ()++  it "return monadic value test" do+    result <- runMockT do+      _getBy $ "s" |> pure @IO (10 :: Int)+      _echo $ "10" |> pure @IO ()+      echoProgram "s"++    result `shouldBe` ()

@@ -10,13 +10,14 @@ {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# LANGUAGE TypeApplications #-}  module Test.MockCat.TypeClassTHSpec (spec) where  import Prelude hiding (readFile, writeFile, any) import Data.Text (Text, pack, isInfixOf) import Test.Hspec-import Test.MockCat (makeMock, makeMockWithOptions, createStubFn, options, MockOptions(..), runMockT, (|>), any, applyTimesIs, neverApply)+import Test.MockCat import Control.Monad.State import Control.Monad.Reader (MonadReader, ask) import Control.Monad (unless)@@ -119,12 +120,31 @@   v3 <- fnParam3_3   pure $ v1 <> v2 <> show v3 +class Monad m => MultiApplyTest m where+  getValueBy :: String -> m String++getValues :: MultiApplyTest m => [String] -> m [String]+getValues = mapM getValueBy++makeMock [t|MultiApplyTest|]++class Monad m => ExplicitlyReturnMonadicValuesTest m where+  echo :: String -> m ()+  getBy :: String -> m Int+  +echoProgram :: ExplicitlyReturnMonadicValuesTest m => String -> m ()+echoProgram s = do+  v <- getBy s+  echo $ show v++makeMockWithOptions [t|ExplicitlyReturnMonadicValuesTest|] options { implicitMonadicReturn = False }+ spec :: Spec spec = do   it "Read, and output files" do     result <- runMockT do-      _readFile ("input.txt" |> pack "content")-      _writeFile ("output.txt" |> pack "content" |> ())+      _readFile $ "input.txt" |> pack "content"+      _writeFile $ "output.txt" |> pack "content" |> ()       operationProgram "input.txt" "output.txt"      result `shouldBe` ()@@ -178,3 +198,20 @@       _fnParam3_3 False       threeParamMonadExec     r `shouldBe` "Result1Result2False"+  +  it "Multi apply" do+    result <- runMockT do+      _getValueBy $ do+        onCase $ "a" |> "ax"+        onCase $ "b" |> "bx"+        onCase $ "c" |> "cx"+      getValues ["a", "b", "c"]+    result `shouldBe` ["ax", "bx", "cx"]++  it "Return monadic value test" do+    result <- runMockT do+      _getBy $ "s" |> pure @IO (10 :: Int)+      _echo $ "10" |> pure @IO ()+      echoProgram "s"++    result `shouldBe` ()