Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Test.MockCat.TH
Synopsis
- showExp :: Q Exp -> Q String
- expectByExpr :: Q Exp -> Q Exp
- makeMock :: Q Type -> Q [Dec]
- makeMockWithOptions :: Q Type -> MockOptions -> Q [Dec]
- data MockOptions = MockOptions {}
- options :: MockOptions
- makePartialMock :: Q Type -> Q [Dec]
- makePartialMockWithOptions :: Q Type -> MockOptions -> Q [Dec]
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
Constructors
MockOptions | |
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 valuesshouldBe
["{id: 1}", "{id: 2}", "{id: 3}"] it "Only findIds should be stubbed." do values <- runMockT do _findIds [1 :: Int, 2] findValue valuesshouldBe
["{id: 1}", "{id: 2}"]
makePartialMockWithOptions :: Q Type -> MockOptions -> Q [Dec] Source #
makePartialMock
with options