Hello, I am the developer of the mock library mockcat.
I’d like to introduce you to the recent release, which now allows you to create partial mocks, and stubs for nonrecurring IO actions.
Partial mock
Starting with version 0.4.0, only some functions of a typeclass can be stub functions.
For example, suppose you have a typeclass ApiClient
and a function fetchData
that uses that typeclass.
class Monad m => ApiClient m where
makeRequest :: String -> m ByteString
parseResponse :: ByteString -> m (Maybe Int)
fetchData :: ApiClient m => String -> m (Maybe Int)
fetchData url = do
response <- makeRequest url
parseResponse response
In this example, we want to use some real functions, so we implement an IO
instance.
instance ApiClient IO where
makeRequest url = do
request <- parseRequest url
response <- httpLBS request
pure $ getResponseBody response
parseResponse response =
case decode response of
Just (ApiResponse obj) -> pure (Just obj)
Nothing -> pure Nothing
newtype ApiResponse = ApiResponse { value :: Int }
deriving (Generic, Show)
instance FromJSON ApiResponse
The makeRequest
function performs HTTP communication to the outside world, so you want to replace it with a mock in your test.
On the other hand, parseResponse
has no external dependencies, so we want to test it with a real function.
In other words, you want to mock it partially.
In this case, use the makePartialMock
function.
makePartialMock [t|ApiClient|]
With this function, a function that does not setup a stub function becomes a real function.
Let’s look at an example of its use.
spec :: Spec
spec = do
it "Fetch data with mocked response" do
result <- runMockT do
_makeRequest $ "https://example.com" |> BS.pack "{\"value\": 42}"
fetchData "https://example.com"
result `shouldBe` Just 42
it "Handle invalid response" do
result <- runMockT do
_makeRequest $ "https://example.com" |> BS.pack "invalid response"
fetchData "https://example.com"
result `shouldBe` Nothing
There are two cases tested, but in both cases only the stub function of makeRequest
is provided.
So parseResponse
will use the real function.
Since the context for running the tests is IO
, the parseResponse
of the IO
instance is used.
In this way, you can test the desired function while using a stub function only for the parts that are hard to test.
The all code is here.
Stub that returns type IO a
.
Starting with version 0.5.0, it is possible to create stub functions that return a different value each time they are applied, as long as the stub function returns type IO a
.
A function that returns type IO a
is a function with the following signature
returnIO :: IO a
returnIO = ...
Here is a concrete example.
Given the following typeclass Teletype
and function echo
.
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
The function echo
is a branching function that depends on the result of readTTY
.
The function echo
branches depending on the result of readTTY
.
If an empty string is returned, ()
is returned, otherwise writeTTY
is applied and recursion occurs.
Therefore, at a minimum, you will want to write tests for two patterns: if an empty string is returned and if it is not.
You can see that you can write a test for the case where an empty string is returned without any problem, but the test for the case where a non-empty string is returned is not so easy to write.
If a non-empty value is returned, the test recurses, but if a non-empty value is not returned at some point, the test will loop infinitely.
In other words, it must return a different value each time it is applied.
And we need to be able to do it with a function that has no arguments.
Let us show that it can be done.
First, generate a mock with the following options.
implicitMonadicReturn = False
is an option to allow explicit monadic values to be returned.
makeMockWithOptions [t|Teletype|] options { implicitMonadicReturn = False }
The test will look like this
In the second case of test , a stub function of _readTTY
is provided that returns “a”
the first time and empty characters the second and subsequent times.
spec :: Spec
spec = do
it “The process ends when an empty string is returned.” do
result <- runMockT do
_readTTY $ pure @IO “”
echo
result `shouldBe` ()
it “If a non-empty character is returned, it is recursed.
result <- runMockT do
_readTTY $ do
onCase $ pure @IO “a”
onCase $ pure @IO “”
_writeTTY $ “a” |> pure @IO ()
echo
result `shouldBe` ()
The all code is here.
[Supplemental]
By default, if you return a normal value like _readTTY “”
, mockcat automatically wraps it in pure
.
In the case of this example, we want to make it clear that it is IO
.
Extra (Polysemy
version of Teletype
)
You can also test Polysemy
version of Teletype
with mockcat.
spec :: Spec
spec = do
it “Teletype” do
readTTYStubFn <- createStubFn do
onCase $ pure @IO “output”
onCase $ pure @IO “”
writeTTYMock <- createMock $ “output” |> pure @IO ()
let runEcho = interpret $ \case
ReadTTY -> embed readTTYStubFn
WriteTTY text -> embed $ stubFn writeTTYMock text
result <- (runM . runEcho) echo
result `shouldBe` ()
writeTTYMock `shouldApplyTo` “output”
The all code is here.