mockcat is a simple yet flexible mock library.
mockcat provides capabilities for generating stub functions and verifying them.
Let me explain that.
In this post, we will provide usage examples for the following four.
(Only basic functions are used in the description. Please refer to the documentation for various usages.):
- A very simple example
- Testing functions using type classes
- Testing functions using type classes in combination with HMock
- Testing functions using Extensible Effects (Polysemy)
1. A Very Simple Example
Let’s create a stub function of type String -> String
.
import Test.MockCat (createStubFn, (|>))
main :: IO ()
main = do
f <- createStubFn $ "input" |> "output"
print $ f "input" -- "output"
Next, let’s create a stub function of type String -> Reader String String
.
import Test.MockCat (createStubFn, (|>))
import Control.Monad.Reader (Reader, ask, runReader)
import Data.Function ((&))
main :: IO ()
main = do
f <- createStubFn $ "input" |> do
e <- ask
pure @(Reader String) $ "env is: " <> e
f "input"
& flip runReader "option value"
& print -- "env is: option value"
2. Testing Functions Using Type Classes
Let’s see an example of testing a function using type classes.
Suppose we have a function program using the following type class.
class (Monad m) => FileOperation m where
readFile :: FilePath -> m Text
writeFile :: FilePath -> Text -> m ()
program ::
(FileOperation m) =>
FilePath ->
FilePath ->
(Text -> Text) ->
m ()
program inputPath outputPath modifyText = do
content <- readFile inputPath
let modifiedContent = modifyText content
writeFile outputPath modifiedContent
When writing tests for this function, we want to confirm the following:
- readFile is called with inputPath.
- The result of readFile is passed to modifyText.
- writeFile is called with outputPath and the result of modifyText.
Here is a test using the ReaderT monad (a bit verbose perhaps):
data Functions = Functions
{ _readFile :: FilePath -> Text,
_writeFile :: FilePath -> Text -> ()
}
instance Monad m => FileOperation (ReaderT Functions m) where
readFile path = ask >>= \f -> pure $ f._readFile path
writeFile path content = ask >>= \f -> pure $ f._writeFile path content
spec :: Spec
spec = do
it "Read, edit, and output files" do
readFileStub <- createStubFn $ "input.txt" |> pack "content"
writeFileMock <- createMock $ "output.text" |> pack "modifiedContent" |> ()
modifyContentStub <- createStubFn $ pack "content" |> pack "modifiedContent"
let functions = Functions {
_readFile = readFileStub,
_writeFile = stubFn writeFileMock }
result <- runReaderT
(program "input.txt" "output.text" modifyContentStub)
functions
result `shouldBe` ()
writeFileMock `shouldApplyTo` ("output.text" |> pack "modifiedContent")
Next, I’ll show how it can be simplified using a library like HMock.
makeMockable [t|FileOperation|]
spec :: Spec
spec = do
it "Read, edit, and output files" do
modifyContentStub <- createStubFn $ pack "content" |> pack "modifiedContent"
result <- runMockT $ do
expect $ ReadFile "input.txt" |-> pack "content"
expect $ WriteFile "output.text" (pack "modifiedContent") |-> ()
program "input.txt" "output.text" modifyContentStub
result `shouldBe` ()
4. Testing Functions Using Extensible Effects (Polysemy)
Finally, let’s write a test using Extensible Effects (Polysemy).
Here is the program function rewritten using Polysemy.
data FileOperation m a where
ReadFile :: FilePath -> FileOperation m Text
WriteFile :: FilePath -> Text -> FileOperation m ()
makeSem ''FileOperation
program ::
Member FileOperation r =>
FilePath ->
FilePath ->
(Text -> Text) ->
Sem r ()
program inputPath outputPath modifyText = do
content <- readFile inputPath
let modifiedContent = modifyText content
writeFile outputPath modifiedContent
And here is the corresponding test. We use handlers to utilize stub functions.
spec :: Spec
spec = do
it "Read, edit, and output files" do
readFileStub <- createStubFn $ "input.txt" |> pack "content"
writeFileMock <- createMock $ "output.text" |> pack "modifiedContent" |> ()
modifyContentStub <- createStubFn $ pack "content" |> pack "modifiedContent"
let runFileOperation :: Sem (FileOperation : r) a -> Sem r a
runFileOperation = interpret $ \case
ReadFile path -> pure $ readFileStub path
WriteFile path text -> pure $ stubFn writeFileMock path text
result <-
program "input.txt" "output.text" modifyContentStub
& runFileOperation
& runM
result `shouldBe` ()
writeFileMock `shouldApplyTo` ("output.text" |> pack "modifiedContent")
That’s it for the explanation. If you find it interesting, please try it out and give us your feedback.
By the way, you can find the code used in this explanation here: