mockcat (empty) → 0.1.0.0

raw patch · 16 files changed

+2416/−0 lines, 16 filesdep +basedep +hspecdep +mockcatsetup-changed

Dependencies added: base, hspec, mockcat, template-haskell, text

Files

• CHANGELOG.md +11/−0
• LICENSE +21/−0
• README.md +261/−0
• Setup.hs +2/−0
• mockcat.cabal +78/−0
• src/Test/MockCat.hs +14/−0
• src/Test/MockCat/Cons.hs +13/−0
• src/Test/MockCat/Mock.hs +723/−0
• src/Test/MockCat/Param.hs +118/−0
• src/Test/MockCat/ParamDivider.hs +63/−0
• src/Test/MockCat/TH.hs +47/−0
• test/Spec.hs +13/−0
• test/Test/MockCat/ConsSpec.hs +22/−0
• test/Test/MockCat/ExampleSpec.hs +88/−0
• test/Test/MockCat/MockSpec.hs +875/−0
• test/Test/MockCat/ParamSpec.hs +67/−0

@@ -0,0 +1,11 @@+# Changelog for `mockcat`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2024 funnycat++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,261 @@+# 🐈Mocking library for Haskell🐈‍++[![Test](https://github.com/pujoheadsoft/mockcat/workflows/Test/badge.svg)](https://github.com/pujoheadsoft/mockcat/actions?query=workflow%3ATest+branch%3Amain)++[日本語版 README はこちら](https://github.com/pujoheadsoft/mockcat/blob/master/README-ja.md)++mockcat is a simple mocking library that supports testing in Haskell.++It mainly provides two features:+- Creating stub functions+- Verifying if the expected arguments were applied++Stub functions can return not only monadic values but also pure values.++```haskell+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TypeApplications #-}+import Test.Hspec+import Test.MockCat++spec :: Spec+spec = do+  it "Example of usage" do+    -- Create a Mock (applying “value” returns the pure value True)+    mock <- createMock $ "value" |> True++    -- Extract the stub function from the mock+    let stubFunction = stubFn mock++    -- Verify the results of applying an argument+    stubFunction "value" `shouldBe` True++    -- Verify if the expected value ("value") was applied+    mock `shouldApplyTo` "value"+```++# Stub Functions+## Simple Stub Functions+To create stub functions, use the createStubFn function.+```haskell+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TypeApplications #-}+import Test.Hspec+import Test.MockCat++spec :: Spec+spec = do+  it "can create a stub function" do+    -- Create+    f <- createStubFn $ "param1" |> "param2" |> pure @IO ()++    -- Apply+    actual <- f "param1" "param2"++    -- Verify+    actual `shouldBe` ()+```+To createStubFn, you pass the expected arguments concatenated with |>.+The final value after |> is the return value of the function.++If unexpected arguments are applied to the stub function, an error occurs.+```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+{-# 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+```+If the expected arguments are not applied, the error message will include this name.+```console+uncaught exception: ErrorCall+Expected arguments were not applied to the function `named stub`.+  expected: "x","y"+  but got: "x","z"+```+## Flexible Stub Functions+You can create a flexible stub function by giving the `createStubFn` function a conditional expression instead of a specific value.  +This allows you to return expected values for arbitrary values, strings matching specific patterns, etc.++### any+any matches any value.+```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"+```+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.  +The label is used in the error message if the condition is not met.+```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"+```++### Condition Expressions without Labels+`expect_` is a label-free version of expect.  +The error message will show [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"+```++### 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.+```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"+```++## Stub Functions that Return Different Values for Each Applied Argument+By applying a list in the form of x |> y to the `createStubFn` function,   +you can create stub functions that return different values for each applied argument.+```haskell+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TypeApplications #-}+import Test.Hspec+import Test.MockCat+import Prelude hiding (and)++spec :: Spec+spec = do+  it "multi" do+    f <-+      createStubFn+        [ "a" |> "return x",+          "b" |> "return y"+        ]+    f "a" `shouldBe` "return x"+    f "b" `shouldBe` "return y"+```++# Verification+## Verify if the Expected Arguments were Applied+You can verify if the expected arguments were applied using the `shouldApplyTo` function.+To perform the verification, create a mock using the `createMock` function instead of the `createStubFn` function.+In this case, use the `stubFn` function to extract the stub function from the mock.+```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"+```+## Verify the Number of Times the Expected Arguments were Applied+You can verify the number of times the expected arguments were applied using the `shouldApplyTimes` function.+```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"+```+## Verify if the Arguments were Applied in the Expected Order+You can verify if the arguments were applied in the expected order using the `shouldApplyInOrder` function.+```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+                           ]+```++## Verify if the Arguments were Applied in the Expected Partial Order+The `shouldApplyInOrder` function strictly verifies the order of application,  +but the `shouldApplyInPartialOrder` function can verify if the order of application matches partially.+```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+                                  ]+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,78 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:           mockcat+version:        0.1.0.0+synopsis:       Simple mock function library for test in Haskell.+description:    mockcat is simple mock library for test in Haskell.+                .+                mockcat provides so-called stubbing and verification functions.+                .+                Stub functions can return values of Pure Types as well as value of Monadic Types.+                .+                Example:+                .+                @+                f \<- createStubFn $ "expected arg" |\> "return value"+                print $ f "expected arg" -- "return value" +                @+                .+                For more please see the README on GitHub at <https://github.com/pujoheadsoft/mockcat#readme>+category:       Testing+homepage:       https://github.com/pujoheadsoft/mockcat#readme+bug-reports:    https://github.com/pujoheadsoft/mockcat/issues+author:         funnycat <pujoheadsoft@gmail.com>+maintainer:     funnycat <pujoheadsoft@gmail.com>+copyright:      2024 funnycat+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/pujoheadsoft/mockcat++library+  exposed-modules:+      Test.MockCat+      Test.MockCat.Cons+      Test.MockCat.Mock+      Test.MockCat.Param+      Test.MockCat.ParamDivider+      Test.MockCat.TH+  other-modules:+      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+  build-depends:+      base >=4.7 && <5+    , template-haskell >=2.18 && <2.23+    , text >=2.0 && <2.2+  default-language: Haskell2010++test-suite mockcat-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.MockCat.ConsSpec+      Test.MockCat.ExampleSpec+      Test.MockCat.MockSpec+      Test.MockCat.ParamSpec+      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+  build-depends:+      base >=4.7 && <5+    , hspec+    , mockcat+    , template-haskell >=2.18 && <2.23+    , text >=2.0 && <2.2+  default-language: Haskell2010

@@ -0,0 +1,14 @@+-- |+-- a+-- b+module Test.MockCat+  ( +    module Test.MockCat.Mock,+    module Test.MockCat.Cons,+    module Test.MockCat.Param+  )+where++import Test.MockCat.Mock+import Test.MockCat.Cons+import Test.MockCat.Param

@@ -0,0 +1,13 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+module Test.MockCat.Cons ((:>)(..)) where++data a :> b = a :> b++instance (Show a, Show b) => Show (a :> b) where+  show (a :> b) = show a <> "," <> show b++instance (Eq a, Eq b) => Eq (a :> b) where+  (a :> b) == (a2 :> b2) = (a == a2) && (b == b2)++infixr 8 :>

@@ -0,0 +1,723 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++{-# HLINT ignore "Use null" #-}++{- | This module provides bellow functions.++  - Create mocks that can be stubbed and verified.++  - Create stub function.++  - Verify applied mock function.+-}+module Test.MockCat.Mock+  ( createMock,+    createNamedMock,+    createStubFn,+    createNamedStubFun,+    stubFn,       +    shouldApplyTo,+    shouldApplyTimes,+    shouldApplyInOrder,+    shouldApplyInPartialOrder,+    shouldApplyTimesGreaterThanEqual,+    shouldApplyTimesLessThanEqual,+    shouldApplyTimesGreaterThan,+    shouldApplyTimesLessThan,+    to,+    module Test.MockCat.Cons,+    module Test.MockCat.Param+  )+where++import Control.Monad (guard)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Function ((&))+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.List (elemIndex, find, intercalate)+import Data.Maybe+import Data.Text (pack, replace, unpack)+import GHC.IO (unsafePerformIO)+import Test.MockCat.Cons+import Test.MockCat.Param+import Test.MockCat.ParamDivider++data Mock fun params = Mock (Maybe MockName) fun (Verifier params)++type MockName = String++newtype Verifier params = Verifier (IORef (AppliedParamsList params))++{- | Create a mock.+From this mock, you can generate stub functions and verify the functions.++  @+  import Test.Hspec+  import Test.MockCat+  ...+  it "stub & verify" do+    -- create a mock+    m \<- createMock $ "value" |\> True+    -- stub function+    let f = stubFn m+    -- assert+    f "value" \`shouldBe\` True+    -- verify+    m \`shouldApplyTo\` "value"+  @++  If you do not need verification and only need stub functions, you can use @'mockFun'@.++-}+createMock ::+  MockBuilder params fun verifyParams =>+  MonadIO m =>+  params ->+  m (Mock fun verifyParams)+createMock params = liftIO $ build Nothing params++{- | Create a named mock. If the test fails, this name is used. This may be useful if you have multiple mocks.++  @+  import Test.Hspec+  import Test.MockCat+  ...+  it "named mock" do+    m \<- createNamedMock "mock" $ "value" |\> True+    stubFn m "value" \`shouldBe\` True+  @+-}+createNamedMock ::+  MockBuilder params fun verifyParams =>+  MonadIO m =>+  MockName ->+  params ->+  m (Mock fun verifyParams)+createNamedMock name params = liftIO $ build (Just name) params++-- | Extract the stub function from the mock.+stubFn :: Mock fun v -> fun+stubFn (Mock _ f _) = f++{- | Create a stub function.+  @+  import Test.Hspec+  import Test.MockCat+  ...+  it "stub function" do+    f \<- createStubFn $ "value" |\> True+    f "value" \`shouldBe\` True+  @+-}+createStubFn ::+  MockBuilder params fun verifyParams =>+  MonadIO m =>+  params ->+  m fun+createStubFn params = stubFn <$> createMock params++-- | Create a named stub function.+createNamedStubFun ::+  MockBuilder params fun verifyParams =>+  MonadIO m =>+  String ->+  params ->+  m fun+createNamedStubFun name params = stubFn <$> createNamedMock name params++-- | Class for creating a mock corresponding to the parameter.+class MockBuilder params fun verifyParams | params -> fun, params -> verifyParams where+  -- build a mock+  build :: MonadIO m => Maybe MockName -> params -> m (Mock fun verifyParams)++-- instances+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)+    (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+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock+      name+      s+      ( \a2 b2 c2 d2 e2 f2 g2 h2 i2 ->+          unsafePerformIO $ extractReturnValueWithValidate 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)+    (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+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock+      name+      s+      ( \a2 b2 c2 d2 e2 f2 g2 h2 ->+          unsafePerformIO $ extractReturnValueWithValidate 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)+    (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+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock+      name+      s+      ( \a2 b2 c2 d2 e2 f2 g2 ->+          unsafePerformIO $ extractReturnValueWithValidate 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)+    (a -> b -> c -> d -> e -> f -> r)+    (Param a :> Param b :> Param c :> Param d :> Param e :> Param f)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock name s (\a2 b2 c2 d2 e2 f2 -> unsafePerformIO $ extractReturnValueWithValidate 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)+    (a -> b -> c -> d -> e -> r)+    (Param a :> Param b :> Param c :> Param d :> Param e)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock name s (\a2 b2 c2 d2 e2 -> unsafePerformIO $ extractReturnValueWithValidate 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)+    (a -> b -> c -> d -> r)+    (Param a :> Param b :> Param c :> Param d)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock name s (\a2 b2 c2 d2 -> unsafePerformIO $ extractReturnValueWithValidate 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) (a -> b -> c -> r) (Param a :> Param b :> Param c)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock name s (\a2 b2 c2 -> unsafePerformIO $ extractReturnValueWithValidate 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)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock name s (\a2 b2 -> unsafePerformIO $ extractReturnValueWithValidate name params (p a2 :> p b2) s)++instance+  (Show a, Eq a) =>+  MockBuilder (Param a :> Param r) (a -> r) (Param a)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock name s (\a2 -> unsafePerformIO $ extractReturnValueWithValidate name params (p a2) 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, 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]+    (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+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    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]+    (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+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    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]+    (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+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    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]+    (a -> b -> c -> d -> e -> f -> r)+    (Param a :> Param b :> Param c :> Param d :> Param e :> Param f)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    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]+    (a -> b -> c -> d -> e -> r)+    (Param a :> Param b :> Param c :> Param d :> Param e)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    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]+    (a -> b -> c -> d -> r)+    (Param a :> Param b :> Param c :> Param d)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    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]+    (a -> b -> c -> r)+    (Param a :> Param b :> Param c)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    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)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    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)+  where+  build name params = do+    s <- liftIO $ newIORef ([] :: AppliedParamsList params)+    makeMock name s (\a2 -> unsafePerformIO $ findReturnValueWithStore name params (p a2) s)++-- ------++p :: a -> Param a+p = param++makeMock :: MonadIO m => Maybe MockName -> IORef (AppliedParamsList params) -> fun -> m (Mock fun params)+makeMock name l fn = pure $ Mock name fn (Verifier l)++type AppliedParamsList params = [params]++extractReturnValueWithValidate ::+  ParamDivider params args (Param r) =>+  Eq args =>+  Show args =>+  Maybe MockName ->+  params ->+  args ->+  IORef (AppliedParamsList args) ->+  IO r+extractReturnValueWithValidate name params inputParams s = do+  validateWithStoreParams name s (args params) inputParams+  pure $ returnValue params++findReturnValueWithStore ::+  Eq args =>+  Show args =>+  ParamDivider params args (Param r) =>+  Maybe MockName ->+  AppliedParamsList params ->+  args ->+  IORef (AppliedParamsList args) ->+  IO r+findReturnValueWithStore name paramsList inputParams ref = do+  modifyIORef' ref (++ [inputParams])+  let expectedArgs = args <$> paramsList+      r = findReturnValue paramsList inputParams+  maybe+    (errorWithoutStackTrace $ messageForMultiMock name expectedArgs inputParams)+    pure+    r++findReturnValue ::+  Eq args =>+  ParamDivider params args (Param r) =>+  AppliedParamsList params ->+  args ->+  Maybe r+findReturnValue paramsList inputParams = do+  find (\params -> args params == inputParams) paramsList+    >>= \params -> pure $ returnValue params++validateWithStoreParams :: (Eq a, Show a) => Maybe MockName -> IORef (AppliedParamsList a) -> a -> a -> IO ()+validateWithStoreParams name ref expected actual = do+  validateParams name expected actual+  modifyIORef' ref (++ [actual])++validateParams :: (Eq a, Show a) => Maybe MockName -> a -> a -> IO ()+validateParams name expected actual =+  if expected == actual+    then pure ()+    else errorWithoutStackTrace $ message name expected actual++message :: Show a => Maybe MockName -> a -> a -> String+message name expected actual =+  intercalate+    "\n"+    [ "Expected arguments were not applied to the function" <> mockNameLabel name <> ".",+      "  expected: " <> show expected,+      "   but got: " <> show actual+    ]++messageForMultiMock :: Show a => Maybe MockName -> [a] -> a -> String+messageForMultiMock name expecteds actual =+  intercalate+    "\n"+    [ "Expected arguments were not applied to the function" <> mockNameLabel name <> ".",+      "  expected one of the following:",+      intercalate "\n" $ ("    " <>) . show <$> expecteds,+      "  but got:",+      ("    " <>) . show $ actual+    ]++mockNameLabel :: Maybe MockName -> String+mockNameLabel = maybe mempty (" " <>) . enclose "`"++enclose :: String -> Maybe String -> Maybe String+enclose e = fmap (\v -> e <> v <> e)++-- verify+data VerifyMatchType a = MatchAny a | MatchAll a++-- | Class for verifying mock function.+class Verify params input where+  -- | Verifies that the function has been applied to the expected arguments.+  shouldApplyTo :: Mock fun params -> input -> IO ()++instance (Eq a, Show a) => Verify (Param a) a where+  shouldApplyTo v a = verify v (MatchAny (param a))++instance (Eq a, Show a) => Verify a a where+  shouldApplyTo v a = verify v (MatchAny a)++verify :: (Eq params, Show params) => Mock fun params -> VerifyMatchType params -> IO ()+verify (Mock name _ (Verifier ref)) matchType = do+  calledParamsList <- readIORef ref+  let result = doVerify name calledParamsList matchType+  result & maybe (pure ()) (\(VerifyFailed msg) -> errorWithoutStackTrace msg)++newtype VerifyFailed = VerifyFailed Message++type Message = String++doVerify :: (Eq a, Show a) => Maybe MockName -> AppliedParamsList a -> VerifyMatchType a -> Maybe VerifyFailed+doVerify name list (MatchAny a) = do+  guard $ notElem a list+  pure $ verifyFailedMesssage name list a+doVerify name list (MatchAll a) = do+  guard $ Prelude.any (a /=) list+  pure $ verifyFailedMesssage name list a++verifyFailedMesssage :: Show a => Maybe MockName -> AppliedParamsList a -> a -> VerifyFailed+verifyFailedMesssage name calledParams expected =+  VerifyFailed $+    intercalate+      "\n"+      [ "Expected arguments were not applied to the function" <> mockNameLabel name <> ".",+        "  expected: " <> show expected,+        "   but got: " <> formatCalledParamsList calledParams+      ]++formatCalledParamsList :: Show a => AppliedParamsList a -> String+formatCalledParamsList calledParams+  | length calledParams == 0 = "Never been called."+  | length calledParams == 1 = init . drop 1 . show $ calledParams+  | otherwise = show calledParams++_replace :: Show a => String -> a -> String+_replace r s = unpack $ replace (pack r) (pack "") (pack (show s))++class VerifyCount countType params a where+  -- | Verify the number of times a function has been applied to an argument.+  --+  -- @+  -- import Test.Hspec+  -- import Test.MockCat+  -- ...+  -- it "verify to applied times." do+  --   m \<- createMock $ "value" |\> True+  --   print $ stubFn m "value"+  --   print $ stubFn m "value"+  --   m \`shouldApplyTimes\` (2 :: Int) \`to\` "value" +  -- @+  --+  shouldApplyTimes :: Eq params => Mock fun params -> countType -> a -> IO ()++instance VerifyCount CountVerifyMethod (Param a) a where+  shouldApplyTimes v count a = verifyCount v (param a) count++instance VerifyCount Int (Param a) a where+  shouldApplyTimes v count a = verifyCount v (param a) (Equal count)++instance {-# OVERLAPPABLE #-} VerifyCount CountVerifyMethod a a where+  shouldApplyTimes v count a = verifyCount v a count++instance {-# OVERLAPPABLE #-} VerifyCount Int a a where+  shouldApplyTimes v count a = verifyCount v a (Equal count)++data CountVerifyMethod+  = Equal Int+  | LessThanEqual Int+  | GreaterThanEqual Int+  | LessThan Int+  | GreaterThan Int++instance Show CountVerifyMethod where+  show (Equal e) = show e+  show (LessThanEqual e) = "<= " <> show e+  show (LessThan e) = "< " <> show e+  show (GreaterThanEqual e) = ">= " <> show e+  show (GreaterThan e) = "> " <> show e++compareCount :: CountVerifyMethod -> Int -> Bool+compareCount (Equal e) a = a == e+compareCount (LessThanEqual e) a = a <= e+compareCount (LessThan e) a = a < e+compareCount (GreaterThanEqual e) a = a >= e+compareCount (GreaterThan e) a = a > e++verifyCount :: Eq params => Mock fun params -> params -> CountVerifyMethod -> IO ()+verifyCount (Mock name _ (Verifier ref)) v method = do+  calledParamsList <- readIORef ref+  let callCount = length (filter (v ==) calledParamsList)+  if compareCount method callCount+    then pure ()+    else+      errorWithoutStackTrace $+        intercalate+          "\n"+          [ "The expected argument was not applied the expected number of times to the function" <> mockNameLabel name <> ".",+            "  expected: " <> show method,+            "   but got: " <> show callCount+          ]++to :: (a -> IO ()) -> a -> IO ()+to f = f++class VerifyOrder params input where+  -- | Verify functions are applied in the expected order.+  --+  -- @+  -- import Test.Hspec+  -- import Test.MockCat+  -- import Prelude hiding (any)+  -- ...+  -- it "verify order of apply" do+  --   m \<- createMock $ any |\> True |\> ()+  --   print $ stubFn m "a" True+  --   print $ stubFn m "b" True+  --   m \`shouldApplyInOrder\` ["a" |\> True, "b" |\> True]+  -- @+  shouldApplyInOrder :: Mock fun params -> [input] -> IO ()++  -- | Verify that functions are applied in the expected order.+  --+  -- Unlike @'shouldApplyInOrder'@, not all applications need to match exactly.+  --+  -- As long as the order matches, the verification succeeds.+  shouldApplyInPartialOrder :: Mock fun params -> [input] -> IO ()++instance (Eq a, Show a) => VerifyOrder (Param a) a where+  shouldApplyInOrder v a = verifyOrder ExactlySequence v $ param <$> a+  shouldApplyInPartialOrder v a = verifyOrder PartiallySequence v $ param <$> a++instance {-# OVERLAPPABLE #-} (Eq a, Show a) => VerifyOrder a a where+  shouldApplyInOrder = verifyOrder ExactlySequence+  shouldApplyInPartialOrder = verifyOrder PartiallySequence++data VerifyOrderMethod+  = ExactlySequence+  | PartiallySequence++verifyOrder ::+  Eq params =>+  Show params =>+  VerifyOrderMethod ->+  Mock fun params ->+  [params] ->+  IO ()+verifyOrder method (Mock name _ (Verifier ref)) matchers = do+  calledParamsList <- readIORef ref+  let result = doVerifyOrder method name calledParamsList matchers+  result & maybe (pure ()) (\(VerifyFailed msg) -> errorWithoutStackTrace msg)++doVerifyOrder :: +  Eq a =>+  Show a => +  VerifyOrderMethod -> +  Maybe MockName -> +  AppliedParamsList a -> +  [a] -> +  Maybe VerifyFailed+doVerifyOrder ExactlySequence name calledValues expectedValues+  | length calledValues /= length expectedValues = do+      pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues+  | otherwise = do+      let unexpectedOrders = collectUnExpectedOrder calledValues expectedValues+      guard $ length unexpectedOrders > 0+      pure $ verifyFailedSequence name unexpectedOrders+doVerifyOrder PartiallySequence name calledValues expectedValues+  | length calledValues < length expectedValues = do+      pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues+  | otherwise = do+      guard $ isOrderNotMatched calledValues expectedValues+      pure $ verifyFailedPartiallySequence name calledValues expectedValues++verifyFailedPartiallySequence :: Show a => Maybe MockName -> AppliedParamsList a -> [a] -> VerifyFailed+verifyFailedPartiallySequence name calledValues expectedValues =+  VerifyFailed $+    intercalate+      "\n"+      [ "Expected arguments were not applied to the function" <> mockNameLabel name <> " in the expected order.",+        "  expected order:",+        intercalate "\n" $ ("    " <>) . show <$> expectedValues,+        "  but got:",+        intercalate "\n" $ ("    " <>) . show <$> calledValues+      ]++isOrderNotMatched :: Eq a => AppliedParamsList a -> [a] -> Bool+isOrderNotMatched calledValues expectedValues =+  isNothing $+    foldl+      ( \candidates e -> do+          candidates >>= \c -> do+            index <- elemIndex e c+            Just $ drop (index + 1) c+      )+      (Just calledValues)+      expectedValues++verifyFailedOrderParamCountMismatch :: Maybe MockName -> AppliedParamsList a -> [a] -> VerifyFailed+verifyFailedOrderParamCountMismatch name calledValues expectedValues =+  VerifyFailed $+    intercalate+      "\n"+      [ "Expected arguments were not applied to the function" <> mockNameLabel name <> " in the expected order (count mismatch).",+        "  expected: " <> show (length expectedValues),+        "   but got: " <> show (length calledValues)+      ]++verifyFailedSequence :: Show a => Maybe MockName -> [VerifyOrderResult a] -> VerifyFailed+verifyFailedSequence name fails =+  VerifyFailed $+    intercalate+      "\n"+      ( ("Expected arguments were not applied to the function" <> mockNameLabel name <> " in the expected order.") : (verifyOrderFailedMesssage <$> fails)+      )++verifyOrderFailedMesssage :: Show a => VerifyOrderResult a -> String+verifyOrderFailedMesssage VerifyOrderResult {index, calledValue, expectedValue} =+  let callCount = showHumanReadable (index + 1)+   in intercalate+        "\n"+        [ "  expected " <> callCount <> " applied: " <> show expectedValue,+          "   but got " <> callCount <> " applied: " <> show calledValue+        ]+  where+    showHumanReadable :: Int -> String+    showHumanReadable 1 = "1st"+    showHumanReadable 2 = "2nd"+    showHumanReadable 3 = "3rd"+    showHumanReadable n = show n <> "th"++data VerifyOrderResult a = VerifyOrderResult+  { index :: Int,+    calledValue :: a,+    expectedValue :: a+  }++collectUnExpectedOrder :: Eq a => AppliedParamsList a -> [a] -> [VerifyOrderResult a]+collectUnExpectedOrder calledValues expectedValues =+  catMaybes $+    mapWithIndex+      ( \i expectedValue -> do+          let calledValue = calledValues !! i+          guard $ expectedValue /= calledValue+          pure VerifyOrderResult {index = i, calledValue, expectedValue}+      )+      expectedValues++mapWithIndex :: (Int -> a -> b) -> [a] -> [b]+mapWithIndex f xs = [f i x | (i, x) <- zip [0 ..] xs]++shouldApplyTimesGreaterThanEqual ::+  VerifyCount CountVerifyMethod params a =>+  Eq params =>+  Mock fun params ->+  Int ->+  a ->+  IO ()+shouldApplyTimesGreaterThanEqual m i = shouldApplyTimes m (GreaterThanEqual i)++shouldApplyTimesLessThanEqual ::+  VerifyCount CountVerifyMethod params a =>+  Eq params =>+  Mock fun params ->+  Int ->+  a ->+  IO ()+shouldApplyTimesLessThanEqual m i = shouldApplyTimes m (LessThanEqual i)++shouldApplyTimesGreaterThan ::+  VerifyCount CountVerifyMethod params a =>+  Eq params =>+  Mock fun params ->+  Int ->+  a ->+  IO ()+shouldApplyTimesGreaterThan m i = shouldApplyTimes m (GreaterThan i)++shouldApplyTimesLessThan ::+  VerifyCount CountVerifyMethod params a =>+  Eq params =>+  Mock fun params ->+  Int ->+  a ->+  IO ()+shouldApplyTimesLessThan m i = shouldApplyTimes m (LessThan i)

@@ -0,0 +1,118 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- | This module is a parameter of the mock function.+--+-- This parameter can be used when creating and verifying the mock.+module Test.MockCat.Param+  ( Param,+    value,+    param,+    (|>),+    expect,+    expect_,+    expectByExpr,+    any+  )+where++import Language.Haskell.TH+import Test.MockCat.Cons ((:>) (..))+import Test.MockCat.TH+import Unsafe.Coerce (unsafeCoerce)+import Prelude hiding (any)++data Param v+  = ExpectValue v+  | ExpectCondition (v -> Bool) String++instance (Eq a) => Eq (Param a) where+  (ExpectValue a) == (ExpectValue b) = a == b+  (ExpectValue a) == (ExpectCondition m2 _) = m2 a+  (ExpectCondition m1 _) == (ExpectValue b) = m1 b+  (ExpectCondition _ l1) == (ExpectCondition _ l2) = l1 == l2++type family ShowResult a where+  ShowResult String = String+  ShowResult a = String++class ShowParam a where+  showParam :: a -> ShowResult a++instance {-# OVERLAPPING #-} ShowParam (Param String) where+  showParam (ExpectCondition _ l) = l+  showParam (ExpectValue a) = a++instance {-# INCOHERENT #-} (Show a) => ShowParam (Param a) where+  showParam (ExpectCondition _ l) = l+  showParam (ExpectValue a) = show a++instance (ShowParam (Param a)) => Show (Param a) where+  show = showParam++value :: Param v -> v+value (ExpectValue a) = a+value _ = error "not implement"++param :: v -> Param v+param = ExpectValue++class ConsGen a b r | a b -> r where+  (|>) :: a -> b -> r++instance {-# OVERLAPPING #-} (Param a ~ a', (Param b :> c) ~ bc) => ConsGen a (Param b :> c) (a' :> bc) where+  (|>) a = (:>) (param a)+instance {-# OVERLAPPING #-} ((Param b :> c) ~ bc) => ConsGen (Param a) (Param b :> c) (Param a :> bc) where+  (|>) = (:>)+instance ConsGen (Param a) (Param b) (Param a :> Param b) where+  (|>) = (:>)+instance {-# OVERLAPPABLE #-} ((Param b) ~ b') => ConsGen (Param a) b (Param a :> b') where+  (|>) a b = (:>) a (param b)+instance {-# OVERLAPPABLE #-} ((Param a) ~ a') => ConsGen a (Param b) (a' :> Param b) where+  (|>) a = (:>) (param a)+instance {-# OVERLAPPABLE #-} (Param a ~ a', Param b ~ b') => ConsGen a b (a' :> b') where+  (|>) a b = (:>) (param a) (param b)++infixr 8 |>++-- | Make a parameter to which any value is expected to apply.+any :: Param a+any = unsafeCoerce (ExpectCondition (const True) "any")++{- | Create a conditional parameter.++   When applying a mock function, if the argument does not satisfy this condition, an error occurs.++   In this case, the specified label is included in the error message.+-}+expect :: (a -> Bool) -> String -> Param a+expect = ExpectCondition++{- | Create a conditional parameter.++  In applied a mock function, if the argument does not satisfy this condition, an error occurs.++  Unlike @'expect'@, it does not require a label, but the error message is displayed as [some condition].+-}+expect_ :: (a -> Bool) -> Param a+expect_ f = ExpectCondition f "[some condition]"++{- | Create a conditional parameter based on @Q Exp@. ++  In applying a mock function, if the argument does not satisfy this condition, an error is raised.++  The conditional expression is displayed in the error message.+-}+expectByExpr :: Q Exp -> Q Exp+expectByExpr qf = do+  str <- showExp qf+  [|ExpectCondition $qf str|]

@@ -0,0 +1,63 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}++module Test.MockCat.ParamDivider (ParamDivider, args, return, returnValue) where++import Test.MockCat.Cons+import Test.MockCat.Param+import Prelude hiding (return)++class ParamDivider params args return | params -> args, params -> return where+  args :: params -> args+  return :: params -> return++instance ParamDivider +  (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h :> Param i :> Param r)+  (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h :> Param i) (Param r) where+  args (a :> b :> c :> d :> e :> f :> g :> h :> i :> _) = a :> b :> c :> d :> e :> f :> g :> h :> i+  return (_ :> _ :> _ :> _ :> _ :> _ :> _ :> _ :> _ :> r) = r++instance ParamDivider +  (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h :> Param r)+  (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param h) (Param r) where+  args (a :> b :> c :> d :> e :> f :> g :> h :> _) = a :> b :> c :> d :> e :> f :> g :> h+  return (_ :> _ :> _ :> _ :> _ :> _ :> _ :> _ :> r) = r++instance ParamDivider +  (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g :> Param r)+  (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param g) (Param r) where+  args (a :> b :> c :> d :> e :> f :> g :> _) = a :> b :> c :> d :> e :> f :> g+  return (_ :> _ :> _ :> _ :> _ :> _ :> _ :> r) = r++instance ParamDivider +  (Param a :> Param b :> Param c :> Param d :> Param e :> Param f :> Param r)+  (Param a :> Param b :> Param c :> Param d :> Param e :> Param f) (Param r) where+  args (a :> b :> c :> d :> e :> f :> _) = a :> b :> c :> d :> e :> f+  return (_ :> _ :> _ :> _ :> _ :> _ :> r) = r++instance ParamDivider +  (Param a :> Param b :> Param c :> Param d :> Param e :> Param r)+  (Param a :> Param b :> Param c :> Param d :> Param e) (Param r) where+  args (a :> b :> c :> d :> e :> _) = a :> b :> c :> d :> e+  return (_ :> _ :> _ :> _ :> _ :> r) = r++instance ParamDivider (Param a :> Param b :> Param c :> Param d :> Param r) (Param a :> Param b :> Param c :> Param d) (Param r) where+  args (a :> b :> c :> d :> _) = a :> b :> c :> d+  return (_ :> _ :> _ :> _ :> r) = r++instance ParamDivider (Param a :> Param b :> Param c :> Param r) (Param a :> Param b :> Param c) (Param r) where+  args (a :> b :> c :> _) = a :> b :> c+  return (_ :> _ :> _ :> r) = r++instance ParamDivider (Param a :> Param b :> Param r) (Param a :> Param b) (Param r) where+  args (a :> b :> _) = a :> b+  return (_ :> _ :> r) = r++instance ParamDivider (Param a :> Param r) (Param a) (Param r) where+  args (a :> _) = a+  return (_ :> r) = r++returnValue :: ParamDivider params args (Param r) => params -> r+returnValue = value . return

@@ -0,0 +1,47 @@+{-# LANGUAGE BlockArguments #-}++module Test.MockCat.TH (showExp) where++import Language.Haskell.TH (Exp (..), Lit (..), Pat (..), Q, pprint)+import Language.Haskell.TH.PprLib (Doc, hcat, parens, text)+import Language.Haskell.TH.Syntax (nameBase)++showExp :: Q Exp -> Q String+showExp qexp = show . pprintExp <$> qexp++pprintExp :: Exp -> Doc+pprintExp (VarE name) = text (nameBase name)+pprintExp (ConE name) = text (nameBase name)+pprintExp (LitE lit) = pprintLit lit+pprintExp (AppE e1 e2) = parens $ hcat [pprintExp e1, text " ", pprintExp e2]+pprintExp (InfixE e1 e2 e3) = pprintInfixE e1 e2 e3+pprintExp (LamE pats body) = parens $ hcat [text "\\", pprintPats pats, text " -> ", pprintExp body]+pprintExp (TupE exps) = parens $ hcat (map (maybe (text "") pprintExp) exps)+pprintExp (ListE exps) = parens $ hcat (map pprintExp exps)+pprintExp (SigE e _) = pprintExp e+pprintExp x = text (pprint x)++pprintInfixE :: Maybe Exp -> Exp -> Maybe Exp -> Doc+pprintInfixE e1 e2 e3 =+  parens $+    hcat+      [ maybe (text "") pprintExp e1,+        maybe (text "") (const (text " ")) e1,+        pprintExp e2,+        text " ",+        maybe (text "") pprintExp e3+      ]++pprintPats :: [Pat] -> Doc+pprintPats = hcat . map pprintPat++pprintPat :: Pat -> Doc+pprintPat (VarP name) = text (nameBase name)+pprintPat p = text (pprint p)++pprintLit :: Lit -> Doc+pprintLit (IntegerL n) = text (show n)+pprintLit (RationalL r) = text (show r)+pprintLit (StringL s) = text (show s)+pprintLit (CharL c) = text (show c)+pprintLit l = text (pprint l)

@@ -0,0 +1,13 @@+import Test.Hspec (hspec)+import Test.MockCat.MockSpec as Mock+import Test.MockCat.ConsSpec as Cons+import Test.MockCat.ParamSpec as Param+import Test.MockCat.ExampleSpec as Example++main :: IO ()+main = do+  hspec $ do+    Cons.spec+    Param.spec+    Mock.spec+    Example.spec

@@ -0,0 +1,22 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+module Test.MockCat.ConsSpec (spec) where++import Test.Hspec+import Test.MockCat.Cons++spec :: Spec+spec = do+  describe "Cons" do+    describe "Show" do+      it "2 arity" do+        show ((10 :: Int) :> True) `shouldBe` "10,True"+      it "3 arity" do+        show ("1" :> (False :> [3, 4])) `shouldBe` "\"1\",False,[3,4]"++    describe "Eq" do+      it "2 arity" do+        (1 :: Int) :> "2" `shouldBe` (1 :: Int) :> "2"+      it "3 arity" do+        "1" :> (False :> [3, 4]) `shouldBe` "1" :> (False :> [3, 4])+

@@ -0,0 +1,88 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++module Test.MockCat.ExampleSpec (spec) where++import Test.Hspec+import Test.MockCat+import Prelude hiding (and, any, not, or)++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"++  it "how to use" do+    f <- createStubFn $ "param1" |> "param2" |> pure @IO ()+    actual <- f "param1" "param2"+    actual `shouldBe` ()++  it "named stub" do+    f <- createNamedStubFun "named stub" $ "x" |> "y" |> True+    f "x" "y" `shouldBe` True++  it "named mock" do+    m <- createNamedMock "mock" $ "value" |> "a" |> True+    stubFn m "value" "a" `shouldBe` True++  it "stub function" do+    f <- createStubFn $ "value" |> True+    f "value" `shouldBe` True++  it "shouldApplyTimes" do+    m <- createMock $ "value" |> True+    print $ stubFn m "value"+    print $ stubFn m "value"+    m `shouldApplyTimes` (2 :: Int) `to` "value"++  it "shouldApplyInOrder" do+    m <- createMock $ any |> True |> ()+    print $ stubFn m "a" True+    print $ stubFn m "b" True+    m+      `shouldApplyInOrder` [ "a" |> True,+                             "b" |> True+                           ]++  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+                                  ]++  it "any" do+    f <- createStubFn $ any |> "return value"+    f "something" `shouldBe` "return value"++  it "expect" do+    f <- createStubFn $ expect (> 5) "> 5" |> "return value"+    f 6 `shouldBe` "return value"++  it "expect_" do+    f <- createStubFn $ expect_ (> 5) |> "return value"+    f 6 `shouldBe` "return value"++  it "expectByExpr" do+    f <- createStubFn $ $(expectByExpr [|(> 5)|]) |> "return value"+    f 6 `shouldBe` "return value"++  it "multi" do+    f <-+      createStubFn+        [ "a" |> "return x",+          "b" |> "return y"+        ]+    f "a" `shouldBe` "return x"+    f "b" `shouldBe` "return y"

@@ -0,0 +1,875 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-}+{-# LANGUAGE TypeOperators #-}++module Test.MockCat.MockSpec (spec) where++import qualified Control.Exception as E+import Data.Function ((&))+import Test.Hspec+import Test.MockCat.Mock+  ( any,+    expectByExpr,+    stubFn,+    shouldApplyInOrder,+    shouldApplyInPartialOrder,+    shouldApplyTimes,+    shouldApplyTimesGreaterThan,+    shouldApplyTimesGreaterThanEqual,+    shouldApplyTimesLessThan,+    shouldApplyTimesLessThanEqual,+    shouldApplyTo,+    createMock,+    createStubFn,+    createNamedMock,+    to,+    (|>)+  )+import Prelude hiding (any)++spec :: Spec+spec = do+  describe "Test of Mock" do+    describe "combination test" do+      it "arity = 1" do+        f <- createStubFn $ True |> False+        f True `shouldBe` False++      it "arity = 2" do+        f <- createStubFn $ True |> False |> True +        f True False `shouldBe` True++      it "arity = 3" do+        f <- createStubFn $ True |> "False" |> True |> "False"+        f True "False" True `shouldBe` "False"++      it "arity = 4" do+        f <- createStubFn $ True |> "False" |> True |> "False" |> True+        f True "False" True "False" `shouldBe` True++      it "Param |> a" do+        f <- createStubFn $ any |> False+        f True `shouldBe` False++      it "Param |> (a |> b)" do+        f <- createStubFn $ any |> False |> True+        f True False `shouldBe` True++      it "a     |> (Param |> b)" do+        f <- createStubFn $ True |> any |> True+        f True False `shouldBe` True++      it "Param |> (Param |> a)" do+        f <- createStubFn $ any |> any |> True+        f True False `shouldBe` True++      it "a     |> (Param |> (Param |> a))" do+        f <- createStubFn $ "any" |> any |> any |> True+        f "any" "any" "any" `shouldBe` True++      it "param |> (Param |> (Param |> a))" do+        f <- createStubFn $ any |> any |> any |> True+        f "any" "any" "any" `shouldBe` True++    mockTest+      Fixture+        { name = "arity = 1",+          create = createMock $ "a" |> False,+          apply = (`stubFn` "a"),+          applyFailed = Just (`stubFn` "x"),+          expected = False,+          verifyApply = (`shouldApplyTo` "a"),+          verifyApplyFailed = (`shouldApplyTo` "2"),+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` "a"+        }++    mockTest+      Fixture+        { name = "arity = 2",+          create = createMock $ "a" |> "b" |> True,+          apply = \m -> stubFn m "a" "b",+          applyFailed = Just (\m -> stubFn m "a" "x"),+          expected = True,+          verifyApply = \m -> shouldApplyTo m $ "a" |> "b",+          verifyApplyFailed = \m -> shouldApplyTo m $ "2" |> "b",+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` ("a" |> "b")+        }++    mockTest+      Fixture+        { name = "arity = 3",+          create = createMock $ "a" |> "b" |> "c" |> False,+          apply = \m -> stubFn m "a" "b" "c",+          applyFailed = Just (\m -> stubFn m "a" "b" "x"),+          expected = False,+          verifyApply = \m -> shouldApplyTo m $ "a" |> "b" |> "c",+          verifyApplyFailed = \m -> shouldApplyTo m $ "a" |> "b" |> "d",+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` ("a" |> "b" |> "c")+        }++    mockTest+      Fixture+        { name = "arity = 4",+          create = createMock $ "a" |> "b" |> "c" |> "d" |> True,+          apply = \m -> stubFn m "a" "b" "c" "d",+          applyFailed = Just (\m -> stubFn m "a" "b" "c" "x"),+          expected = True,+          verifyApply = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d",+          verifyApplyFailed = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "x",+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` ("a" |> "b" |> "c" |> "d")+        }++    mockTest+      Fixture+        { name = "arity = 5",+          create = createMock $ "a" |> "b" |> "c" |> "d" |> "e" |> False,+          apply = \m -> stubFn m "a" "b" "c" "d" "e",+          applyFailed = Just (\m -> stubFn m "a" "b" "c" "d" "x"),+          expected = False,+          verifyApply = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e",+          verifyApplyFailed = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "x",+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` ("a" |> "b" |> "c" |> "d" |> "e")+        }++    mockTest+      Fixture+        { name = "arity = 6",+          create = createMock $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> True,+          apply = \m -> stubFn m "a" "b" "c" "d" "e" "f",+          applyFailed = Just (\m -> stubFn m "a" "b" "c" "d" "e" "x"),+          expected = True,+          verifyApply = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e" |> "f",+          verifyApplyFailed = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e" |> "x",+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` ("a" |> "b" |> "c" |> "d" |> "e" |> "f")+        }++    mockTest+      Fixture+        { name = "arity = 7",+          create = createMock $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> False,+          apply = \m -> stubFn m "a" "b" "c" "d" "e" "f" "g",+          applyFailed = Just (\m -> stubFn m "a" "b" "c" "d" "e" "f" "x"),+          expected = False,+          verifyApply = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g",+          verifyApplyFailed = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "y",+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` ("a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g")+        }++    mockTest+      Fixture+        { name = "arity = 8",+          create = createMock $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> "h" |> False,+          apply = \m -> stubFn m "a" "b" "c" "d" "e" "f" "g" "h",+          applyFailed = Just (\m -> stubFn m "a" "b" "c" "d" "e" "f" "g" "x"),+          expected = False,+          verifyApply = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> "h",+          verifyApplyFailed = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> "x",+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` ("a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> "h")+        }++    mockTest+      Fixture+        { name = "arity = 9",+          create = createMock $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> "h" |> "i" |> False,+          apply = \m -> stubFn m "a" "b" "c" "d" "e" "f" "g" "h" "i",+          applyFailed = Just (\m -> stubFn m "a" "b" "c" "d" "e" "f" "g" "h" "x"),+          expected = False,+          verifyApply = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> "h" |> "i",+          verifyApplyFailed = \m -> shouldApplyTo m $ "a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> "h" |> "x",+          verifyApplyCount = \m c -> m `shouldApplyTimes` c `to` ("a" |> "b" |> "c" |> "d" |> "e" |> "f" |> "g" |> "h" |> "i")+        }++  describe "Test of Multi Mock" do+    mockTest+      Fixture+        { name = "arity = 1",+          create =+            createMock+              [ "1" |> True,+                "2" |> False+              ],+          expected =+            [ True,+              False+            ],+          apply = \m -> [stubFn m "1", stubFn m "2"],+          applyFailed = Just \m -> [stubFn m "3"],+          verifyApply = \m -> do+            m `shouldApplyTo` "1"+            m `shouldApplyTo` "2",+          verifyApplyFailed = (`shouldApplyTo` "3"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` "1"+            m `shouldApplyTimes` c `to` "2"+        }++    mockTest+      Fixture+        { name = "arity = 2",+          create =+            createMock+              [ "1" |> "2" |> True,+                "2" |> "3" |> False+              ],+          expected =+            [ True,+              False+            ],+          apply = \m ->+            [ stubFn m "1" "2",+              stubFn m "2" "3"+            ],+          applyFailed = Just \m -> [stubFn m "1" "x"],+          verifyApply = \m -> do+            m `shouldApplyTo` ("1" |> "2")+            m `shouldApplyTo` ("2" |> "3"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` ("1" |> "2")+            m `shouldApplyTimes` c `to` ("2" |> "3"),+          verifyApplyFailed = \m -> m `shouldApplyTo` ("1" |> "x")+        }++    mockTest+      Fixture+        { name = "arity = 3",+          create =+            createMock+              [ "1" |> "2" |> "3" |> True,+                "2" |> "3" |> "4" |> False+              ],+          expected =+            [ True,+              False+            ],+          apply = \m ->+            [ stubFn m "1" "2" "3",+              stubFn m "2" "3" "4"+            ],+          applyFailed = Just \m -> [stubFn m "1" "2" "x"],+          verifyApply = \m -> do+            m `shouldApplyTo` ("1" |> "2" |> "3")+            m `shouldApplyTo` ("2" |> "3" |> "4"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` ("1" |> "2" |> "3")+            m `shouldApplyTimes` c `to` ("2" |> "3" |> "4"),+          verifyApplyFailed = \m -> m `shouldApplyTo` ("1" |> "2" |> "x")+        }++    mockTest+      Fixture+        { name = "arity = 4",+          create =+            createMock+              [ "1" |> "2" |> "3" |> "4" |> True,+                "2" |> "3" |> "4" |> "5" |> False+              ],+          expected =+            [ True,+              False+            ],+          apply = \m ->+            [ stubFn m "1" "2" "3" "4",+              stubFn m "2" "3" "4" "5"+            ],+          applyFailed = Just \m -> [stubFn m "1" "2" "3" "x"],+          verifyApply = \m -> do+            m `shouldApplyTo` ("1" |> "2" |> "3" |> "4")+            m `shouldApplyTo` ("2" |> "3" |> "4" |> "5"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` ("1" |> "2" |> "3" |> "4")+            m `shouldApplyTimes` c `to` ("2" |> "3" |> "4" |> "5"),+          verifyApplyFailed = \m -> m `shouldApplyTo` ("1" |> "2" |> "3" |> "x")+        }++    mockTest+      Fixture+        { name = "arity = 5",+          create =+            createMock+              [ "1" |> "2" |> "3" |> "4" |> "5" |> True,+                "2" |> "3" |> "4" |> "5" |> "6" |> False+              ],+          expected =+            [ True,+              False+            ],+          apply = \m ->+            [ stubFn m "1" "2" "3" "4" "5",+              stubFn m "2" "3" "4" "5" "6"+            ],+          applyFailed = Just \m -> [stubFn m "1" "2" "3" "4" "x"],+          verifyApply = \m -> do+            m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5")+            m `shouldApplyTo` ("2" |> "3" |> "4" |> "5" |> "6"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` ("1" |> "2" |> "3" |> "4" |> "5")+            m `shouldApplyTimes` c `to` ("2" |> "3" |> "4" |> "5" |> "6"),+          verifyApplyFailed = \m -> m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "x")+        }++    mockTest+      Fixture+        { name = "arity = 6",+          create =+            createMock+              [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> True,+                "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> False+              ],+          expected =+            [ True,+              False+            ],+          apply = \m ->+            [ stubFn m "1" "2" "3" "4" "5" "6",+              stubFn m "2" "3" "4" "5" "6" "7"+            ],+          applyFailed = Just \m -> [stubFn m "1" "2" "3" "4" "5" "x"],+          verifyApply = \m -> do+            m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5" |> "6")+            m `shouldApplyTo` ("2" |> "3" |> "4" |> "5" |> "6" |> "7"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` ("1" |> "2" |> "3" |> "4" |> "5" |> "6")+            m `shouldApplyTimes` c `to` ("2" |> "3" |> "4" |> "5" |> "6" |> "7"),+          verifyApplyFailed = \m -> m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5" |> "x")+        }++    mockTest+      Fixture+        { name = "arity = 7",+          create =+            createMock+              [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> True,+                "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> False+              ],+          expected =+            [ True,+              False+            ],+          apply = \m ->+            [ stubFn m "1" "2" "3" "4" "5" "6" "7",+              stubFn m "2" "3" "4" "5" "6" "7" "8"+            ],+          applyFailed = Just \m -> [stubFn m "1" "2" "3" "4" "5" "6" "x"],+          verifyApply = \m -> do+            m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7")+            m `shouldApplyTo` ("2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7")+            m `shouldApplyTimes` c `to` ("2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8"),+          verifyApplyFailed = \m -> m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "x")+        }++    mockTest+      Fixture+        { name = "arity = 8",+          create =+            createMock+              [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> True,+                "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> False+              ],+          expected =+            [ True,+              False+            ],+          apply = \m ->+            [ stubFn m "1" "2" "3" "4" "5" "6" "7" "8",+              stubFn m "2" "3" "4" "5" "6" "7" "8" "9"+            ],+          applyFailed = Just \m -> [stubFn m "1" "2" "3" "4" "5" "6" "7" "x"],+          verifyApply = \m -> do+            m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8")+            m `shouldApplyTo` ("2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8")+            m `shouldApplyTimes` c `to` ("2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9"),+          verifyApplyFailed = \m -> m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "x")+        }++    mockTest+      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+              ],+          expected =+            [ True,+              False+            ],+          apply = \m ->+            [ stubFn m "1" "2" "3" "4" "5" "6" "7" "8" "9",+              stubFn m "2" "3" "4" "5" "6" "7" "8" "9" "10"+            ],+          applyFailed = Just \m -> [stubFn m "1" "2" "3" "4" "5" "6" "7" "8" "x"],+          verifyApply = \m -> do+            m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9")+            m `shouldApplyTo` ("2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> "10"),+          verifyApplyCount = \m c -> do+            m `shouldApplyTimes` c `to` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9")+            m `shouldApplyTimes` c `to` ("2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> "10"),+          verifyApplyFailed = \m -> m `shouldApplyTo` ("1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "x")+        }++  describe "Order Verification" do+    describe "exactly sequential order." do+      mockOrderTest+        VerifyOrderFixture+          { name = "arity = 1",+            create = createMock $ any |> (),+            apply = \m -> do+              evaluate $ stubFn m "a"+              evaluate $ stubFn m "b"+              evaluate $ stubFn m "c",+            verifyApply = \m ->+              m+                `shouldApplyInOrder` [ "a",+                                         "b",+                                         "c"+                                       ],+            verifyApplyFailed = \m ->+              m+                `shouldApplyInOrder` [ "a",+                                         "b",+                                         "b"+                                       ]+          }++      mockOrderTest+        VerifyOrderFixture+          { name = "arity = 9",+            create = createMock $ any |> any |> any |> any |> any |> any |> any |> any |> (),+            apply = \m -> do+              evaluate $ stubFn m "1" "2" "3" "4" "5" "6" "7" "8"+              evaluate $ stubFn m "2" "3" "4" "5" "6" "7" "8" "9"+              evaluate $ stubFn m "3" "4" "5" "6" "7" "8" "9" "0",+            verifyApply = \m ->+              m+                `shouldApplyInOrder` [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8",+                                         "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9",+                                         "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> "0"+                                       ],+            verifyApplyFailed = \m ->+              m+                `shouldApplyInOrder` [ "1" |> "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "x",+                                         "2" |> "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "y",+                                         "3" |> "4" |> "5" |> "6" |> "7" |> "8" |> "9" |> "z"+                                       ]+          }++      mockOrderTest+        VerifyOrderFixture+          { name = "number of function calls doesn't match the number of params.",+            create = createMock $ any |> (),+            apply = \m -> do+              evaluate $ stubFn m "a"+              pure (),+            verifyApply = \m ->+              m+                `shouldApplyInOrder` [ "a"+                                       ],+            verifyApplyFailed = \m ->+              m+                `shouldApplyInOrder` [ "a",+                                         "b"+                                       ]+          }++    describe "partially sequential order." do+      mockOrderTest+        VerifyOrderFixture+          { name = "arity = 1",+            create = createMock $ any |> (),+            apply = \m -> do+              evaluate $ stubFn m "a"+              evaluate $ stubFn m "b"+              evaluate $ stubFn m "c"+              pure (),+            verifyApply = \m ->+              m+                `shouldApplyInPartialOrder` [ "a",+                                                "c"+                                              ],+            verifyApplyFailed = \m ->+              m+                `shouldApplyInPartialOrder` [ "b",+                                                "a"+                                              ]+          }++      mockOrderTest+        VerifyOrderFixture+          { name = "arity = 9",+            create = createMock $ any |> any |> any |> any |> any |> any |> any |> any |> any |> (),+            apply = \m -> do+              evaluate $ stubFn m "a" "" "" "" "" "" "" "" ""+              evaluate $ stubFn m "b" "" "" "" "" "" "" "" ""+              evaluate $ stubFn m "c" "" "" "" "" "" "" "" ""+              pure (),+            verifyApply = \m ->+              m+                `shouldApplyInPartialOrder` [ "a" |> "" |> "" |> "" |> "" |> "" |> "" |> "" |> "",+                                                "c" |> "" |> "" |> "" |> "" |> "" |> "" |> "" |> ""+                                              ],+            verifyApplyFailed = \m ->+              m+                `shouldApplyInPartialOrder` [ "b" |> "" |> "" |> "" |> "" |> "" |> "" |> "" |> "",+                                                "a" |> "" |> "" |> "" |> "" |> "" |> "" |> "" |> ""+                                              ]+          }++      mockOrderTest+        VerifyOrderFixture+          { name = "Uncalled value specified.",+            create = createMock $ any |> (),+            apply = \m -> do+              evaluate $ stubFn m "a"+              evaluate $ stubFn m "b"+              evaluate $ stubFn m "c"+              pure (),+            verifyApply = \m ->+              m+                `shouldApplyInPartialOrder` [ "b",+                                                "c"+                                              ],+            verifyApplyFailed = \m ->+              m+                `shouldApplyInPartialOrder` [ "a",+                                                "d"+                                              ]+          }++      mockOrderTest+        VerifyOrderFixture+          { name = "number of function calls doesn't match the number of params",+            create = createMock $ any |> (),+            apply = \m -> do+              evaluate $ stubFn m "a"+              pure (),+            verifyApply = \m ->+              m+                `shouldApplyInPartialOrder` [ "a"+                                              ],+            verifyApplyFailed = \m ->+              m+                `shouldApplyInPartialOrder` [ "a",+                                                "b"+                                              ]+          }++  describe "The number of times applied can also be verified by specifying conditions." do+    it "greater than equal" do+      m <- createMock $ "a" |> True+      evaluate $ stubFn m "a"+      evaluate $ stubFn m "a"+      evaluate $ stubFn m "a"+      m `shouldApplyTimesGreaterThanEqual` 3 `to` "a"++    it "less than equal" do+      m <- createMock $ "a" |> False+      evaluate $ stubFn m "a"+      evaluate $ stubFn m "a"+      evaluate $ stubFn m "a"+      m `shouldApplyTimesLessThanEqual` 3 `to` "a"++    it "greater than" do+      m <- createMock $ "a" |> True+      evaluate $ stubFn m "a"+      evaluate $ stubFn m "a"+      evaluate $ stubFn m "a"+      m `shouldApplyTimesGreaterThan` 2 `to` "a"++    it "less than" do+      m <- createMock $ "a" |> False+      evaluate $ stubFn m "a"+      evaluate $ stubFn m "a"+      evaluate $ stubFn m "a"+      m `shouldApplyTimesLessThan` 4 `to` "a"++  describe "Monad" do+    it "Return IO Monad." do+      m <- createMock $ "Article Id" |> pure @IO "Article Title"++      result <- stubFn m "Article Id"++      result `shouldBe` "Article Title"++      m `shouldApplyTo` "Article Id"++  describe "Appropriate message when a test fails." do+    describe "anonymous mock" do+      describe "apply" do+        it "simple mock" do+          m <- createMock $ "a" |> pure @IO True+          stubFn m "b"+            `shouldThrow` errorCall+              "Expected arguments were not applied to the function.\n\+              \  expected: \"a\"\n\+              \   but got: \"b\""++        it "multi mock" do+          m <-+            createMock+              [ "aaa" |> (100 :: Int) |> pure @IO True,+                "bbb" |> (200 :: Int) |> pure @IO False+              ]+          stubFn m "aaa" 200+            `shouldThrow` errorCall+              "Expected arguments were not applied to the function.\n\+              \  expected one of the following:\n\+              \    \"aaa\",100\n\+              \    \"bbb\",200\n\+              \  but got:\n\+              \    \"aaa\",200"++      describe "verify" do+        it "simple mock verify" do+          m <- createMock $ any |> pure @IO True+          evaluate $ stubFn m "A"+          m `shouldApplyTo` "X"+            `shouldThrow` errorCall+              "Expected arguments were not applied to the function.\n\+              \  expected: \"X\"\n\+              \   but got: \"A\""++        it "count" do+          m <- createMock $ any |> pure @IO True+          evaluate $ stubFn m "A"+          let e =+                "The expected argument was not applied the expected number of times to the function.\n\+                \  expected: 2\n\+                \   but got: 1"+          m `shouldApplyTimes` (2 :: Int) `to` "A" `shouldThrow` errorCall e++        it "verify sequence" do+          m <- createMock $ any |> pure @IO False+          evaluate $ stubFn m "B"+          evaluate $ stubFn m "C"+          evaluate $ stubFn m "A"+          let e =+                "Expected arguments were not applied to the function in the expected order.\n\+                \  expected 1st applied: \"A\"\n\+                \   but got 1st applied: \"B\"\n\+                \  expected 2nd applied: \"B\"\n\+                \   but got 2nd applied: \"C\"\n\+                \  expected 3rd applied: \"C\"\n\+                \   but got 3rd applied: \"A\""+          m `shouldApplyInOrder` ["A", "B", "C"] `shouldThrow` errorCall e++        it "verify sequence (count mismatch)" do+          m <- createMock $ any |> True+          evaluate $ stubFn m "B"+          evaluate $ stubFn m "C"+          let e =+                "Expected arguments were not applied to the function in the expected order (count mismatch).\n\+                \  expected: 3\n\+                \   but got: 2"+          m `shouldApplyInOrder` ["A", "B", "C"] `shouldThrow` errorCall e++        it "verify partially sequence" do+          m <- createMock $ any |> True+          evaluate $ stubFn m "B"+          evaluate $ stubFn m "A"+          let e =+                "Expected arguments were not applied to the function in the expected order.\n\+                \  expected order:\n\+                \    \"A\"\n\+                \    \"C\"\n\+                \  but got:\n\+                \    \"B\"\n\+                \    \"A\""+          m `shouldApplyInPartialOrder` ["A", "C"] `shouldThrow` errorCall e++        it "verify partially sequence (count mismatch)" do+          m <- createMock $ any |> False+          evaluate $ stubFn m "B"+          let e =+                "Expected arguments were not applied to the function in the expected order (count mismatch).\n\+                \  expected: 2\n\+                \   but got: 1"+          m `shouldApplyInPartialOrder` ["A", "C"] `shouldThrow` errorCall e++    describe "named mock" do+      describe "aply" do+        it "simple mock" do+          m <- createNamedMock "mock function" $ "a" |> pure @IO ()+          let e =+                "Expected arguments were not applied to the function `mock function`.\n\+                \  expected: \"a\"\n\+                \   but got: \"b\""+          stubFn m "b" `shouldThrow` errorCall e++        it "multi mock" do+          m <-+            createNamedMock+              "mock function"+              [ "aaa" |> True |> pure @IO True,+                "bbb" |> False |> pure @IO False+              ]+          let e =+                "Expected arguments were not applied to the function `mock function`.\n\+                \  expected one of the following:\n\+                \    \"aaa\",True\n\+                \    \"bbb\",False\n\+                \  but got:\n\+                \    \"aaa\",False"+          stubFn m "aaa" False `shouldThrow` errorCall e++      describe "verify" do+        it "simple mock verify" do+          m <- createNamedMock "mock function" $ any |> pure @IO ()+          evaluate $ stubFn m "A"+          let e =+                "Expected arguments were not applied to the function `mock function`.\n\+                \  expected: \"X\"\n\+                \   but got: \"A\""+          m `shouldApplyTo` "X" `shouldThrow` errorCall e++        it "count" do+          m <- createNamedMock "mock function" $ any |> pure @IO ()+          evaluate $ stubFn m "A"+          let e =+                "The expected argument was not applied the expected number of times to the function `mock function`.\n\+                \  expected: 2\n\+                \   but got: 1"+          m `shouldApplyTimes` (2 :: Int) `to` "A" `shouldThrow` errorCall e++        it "verify sequence" do+          m <- createNamedMock "mock function" $ any |> pure @IO ()+          evaluate $ stubFn m "B"+          evaluate $ stubFn m "C"+          evaluate $ stubFn m "A"+          let e =+                "Expected arguments were not applied to the function `mock function` in the expected order.\n\+                \  expected 1st applied: \"A\"\n\+                \   but got 1st applied: \"B\"\n\+                \  expected 2nd applied: \"B\"\n\+                \   but got 2nd applied: \"C\"\n\+                \  expected 3rd applied: \"C\"\n\+                \   but got 3rd applied: \"A\""+          m `shouldApplyInOrder` ["A", "B", "C"] `shouldThrow` errorCall e++        it "verify sequence (count mismatch)" do+          m <- createNamedMock "createStubFnc" $ any |> pure @IO ()+          evaluate $ stubFn m "B"+          evaluate $ stubFn m "C"+          let e =+                "Expected arguments were not applied to the function `createStubFnc` in the expected order (count mismatch).\n\+                \  expected: 3\n\+                \   but got: 2"+          m `shouldApplyInOrder` ["A", "B", "C"] `shouldThrow` errorCall e++        it "verify partially sequence" do+          m <- createNamedMock "mock function" $ any |> pure @IO ()+          evaluate $ stubFn m "B"+          evaluate $ stubFn m "A"+          let e =+                "Expected arguments were not applied to the function `mock function` in the expected order.\n\+                \  expected order:\n\+                \    \"A\"\n\+                \    \"C\"\n\+                \  but got:\n\+                \    \"B\"\n\+                \    \"A\""+          m `shouldApplyInPartialOrder` ["A", "C"] `shouldThrow` errorCall e++        it "verify partially sequence (count mismatch)" do+          m <- createNamedMock "createStubFnc" $ any |> pure @IO ()+          evaluate $ stubFn m "B"+          let e =+                "Expected arguments were not applied to the function `createStubFnc` in the expected order (count mismatch).\n\+                \  expected: 2\n\+                \   but got: 1"+          m `shouldApplyInPartialOrder` ["A", "C"] `shouldThrow` errorCall e++  describe "use expectation" do+    it "expectByExpr" do+      f <- createStubFn $ $(expectByExpr [|\x -> x == "y" || x == "z"|]) |> True+      f "y" `shouldBe` True++data Fixture mock r = Fixture+  { name :: String,+    create :: IO mock,+    apply :: mock -> r,+    applyFailed :: Maybe (mock -> r),+    expected :: r,+    verifyApply :: mock -> IO (),+    verifyApplyFailed :: mock -> IO (),+    verifyApplyCount :: mock -> Int -> IO ()+  }++data VerifyOrderFixture mock r = VerifyOrderFixture+  { name :: String,+    create :: IO mock,+    apply :: mock -> IO r,+    verifyApply :: mock -> IO (),+    verifyApplyFailed :: mock -> IO ()+  }++class Eval a where+  evaluate :: a -> IO a++instance Eval [a] where+  evaluate v = do+    mapM_ (\x -> E.evaluate (x `seq` ())) v+    pure v++instance {-# OVERLAPPABLE #-} Eval a where+  evaluate = E.evaluate++-- mock test template+mockTest :: (Eq r, Show r, Eval r) => Fixture mock r -> SpecWith (Arg Expectation)+mockTest f = describe f.name do+  it "Expected argument is applied, the expected value is returned." do+    m <- f.create+    f.apply m `shouldBe` f.expected++  it "Unexpected argument is applied, an exception is thrown." do+    f.applyFailed & maybe mempty \func -> do+      m <- f.create+      evaluate (func m) `shouldThrow` anyErrorCall++  it "Expected arguments are applied, the verification succeeds." do+    m <- f.create+    evaluate $ f.apply m+    f.verifyApply m++  it "Unexpected arguments are applied, the verification fails." do+    m <- f.create+    evaluate $ f.apply m+    f.verifyApplyFailed m `shouldThrow` anyErrorCall++  it "The number of times a function has been applied can be verification (0 times)." do+    m <- f.create+    f.verifyApplyCount m 0++  it "The number of times a function has been applied can be verification (3 times)." do+    m <- f.create+    evaluate $ f.apply m+    evaluate $ f.apply m+    evaluate $ f.apply m+    f.verifyApplyCount m 3++  it "Fails to verification the number of times it has been applied, an exception is thrown." do+    m <- f.create+    evaluate $ f.apply m+    f.verifyApplyCount m 3 `shouldThrow` anyErrorCall++mockOrderTest :: VerifyOrderFixture mock r -> SpecWith (Arg Expectation)+mockOrderTest f = describe f.name do+  it "If the functions are applied in the expected order, the verification succeeds." do+    m <- f.create+    f.apply m+    f.verifyApply m++  it "If the functions are not applied in the expected order, verification fails." do+    m <- f.create+    f.apply m+    f.verifyApplyFailed m `shouldThrow` anyErrorCall

@@ -0,0 +1,67 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+module Test.MockCat.ParamSpec (spec) where++import Prelude hiding (and, or)+import Test.Hspec+import Test.MockCat.Cons+import Test.MockCat.Param as P++spec :: Spec+spec = do+  describe "Param" do+    describe "|>" do+      it "a |> b" do+        True |> False `shouldBe` param True :> param False+      it "Param a |> b" do+        param True |> False `shouldBe` param True :> param False+      it "a |> Param b" do+        True |> param False `shouldBe` param True :> param False+      it "Param a |> Param b" do+        param True |> param False `shouldBe` param True :> param False+      it "a |> b |> c" do+        True |> False |> True `shouldBe` param True :> (param False :> param True)+      it "Param a |> b |> c" do+        param True |> False |> True `shouldBe` param True :> (param False :> param True)++    describe "Show" do+      it "String" do+        show (param "X") `shouldBe` "X"+      it "Integer" do+        show (param 100) `shouldBe` "100"+      it "Bool" do+        show (param False) `shouldBe` "False"++    describe "Eq" do+      it "param (eq)" do+        param 10 == param 10 `shouldBe` True+      it "param (not eq)" do+        param 10 == param 11 `shouldBe` False++    describe "Returns True if the expected value condition is met." do+      it "any" do+        (P.any :: Param Int) == param 10 `shouldBe` True++    describe "show expectation" do+      it "any" do+        show (P.any :: Param Int) `shouldBe` "any"++      it "expect" do+        show (expect (> 4) "> 4") `shouldBe` "> 4"++      it "expect_" do+        show (expect_ (> 4)) `shouldBe` "[some condition]"+    +    describe "show expectation by Exp" do+      it "(> 3)" do+        show $(expectByExpr [|(> 3)|]) `shouldBe` "(> 3)"++      it "lambda" do+        show $(expectByExpr [|\x -> x == 3 || x == 5|]) `shouldBe` "(\\x -> ((x == 3) || (x == 5)))"+      +      it "use data" do+        show $(expectByExpr [|\x -> x == Foo "foo"|]) `shouldBe` "(\\x -> (x == (Foo \"foo\")))"++data TestData = Foo String | Bar deriving (Eq, Show)