mockcat-0.5.0.0: Mock library for test in Haskell.
Safe HaskellSafe-Inferred
LanguageHaskell2010

Test.MockCat.TH

Synopsis

Documentation

expectByExpr :: Q Exp -> Q Exp Source #

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.

makeMock :: Q Type -> Q [Dec] Source #

Create a mock of a typeclasses that returns a monad.

Given a monad type class, generate the following.

  • MockT instance of the given typeclass
  • A stub function corresponding to a function of the original class type. The name of stub function is the name of the original function with a “_” appended.

The prefix can be changed. In that case, use makeMockWithOptions.

 class (Monad m) => FileOperation m where
   writeFile :: FilePath -> Text -> m ()
   readFile :: FilePath -> m Text

 makeMock [t|FileOperation|]

 spec :: Spec
 spec = do
   it "test runMockT" do
     result <- runMockT do
       _readFile $ "input.txt" |> pack "content"
       _writeFile $ "output.text" |> pack "content" |> ()
       somethingProgram

     result shouldBe ()
 

makeMockWithOptions :: Q Type -> MockOptions -> Q [Dec] Source #

Create a mock of the typeclasses that returns a monad according to the MockOptions.

Given a monad type class, generate the following.

  • MockT instance of the given typeclass
  • A stub function corresponding to a function of the original class type. The name of stub function is the name of the original function with a “_” appended.
 class (Monad m) => FileOperation m where
   writeFile :: FilePath -> Text -> m ()
   readFile :: FilePath -> m Text

 makeMockWithOptions [t|FileOperation|] options { prefix = "stub_" }

 it "test runMockT" do
   result <- runMockT do
     stub_readFile $ "input.txt" |> pack "content"
     stub_writeFile $ "output.text" |> pack "content" |> ()
     somethingProgram

   result shouldBe ()
 

data MockOptions Source #

Options for generating mocks.

  • prefix: Stub function prefix
  • suffix: stub function suffix

options :: MockOptions Source #

Default Options.

Stub function names are prefixed with “_”.

makePartialMock :: Q Type -> Q [Dec] Source #

Create a partial mock of a typeclasses that returns a monad.

Given a monad type class, generate the following.

  • MockT instance of the given typeclass
  • A stub function corresponding to a function of the original class type. The name of stub function is the name of the original function with a “_” appended.

For functions that are not stubbed in the test, the real function is used as appropriate for the context.

The prefix can be changed. In that case, use makePartialMockWithOptions.

 class Monad m => Finder a b m | a -> b, b -> a where
   findIds :: m [a]
   findById :: a -> m b

 instance Finder Int String IO where
   findIds = pure [1, 2, 3]
   findById id = pure $ "{id: " <> show id <> "}"

 findValue :: Finder a b m => m [b]
 findValue = do
   ids <- findIds
   mapM findById ids

 makePartialMock [t|Finder|]

 spec :: Spec
 spec = do
   it "Use all real functions." do
     values <- runMockT findValue
     values shouldBe ["{id: 1}", "{id: 2}", "{id: 3}"]

   it "Only findIds should be stubbed." do
     values <- runMockT do
       _findIds [1 :: Int, 2]
       findValue
     values shouldBe ["{id: 1}", "{id: 2}"]