What is the best way to test (using cabal test) my Haskell code that depends on ccall DLL code?
Let’s say I have this code:
{-# LANGUAGE ForeignFunctionInterface #-}
module MyDllFunctions where
foreign import ccall "mydll.h myFunctions"
myDLLFunction :: Int -> IO (Int)
myFunction :: Int -> IO (Int)
myFunction a = do
b <- myDLLFunction a
return b
How can I test the myFunction without calling myDLLFunction directly?
What I’ve considered so far:
Passing the function as a parameter - This would work, but it would make calling myFunction difficult later (myFunction f x)
Creating a fake DLL to enable testing, and using “#ifndef” to change the DLL based on the compilation target in cabal. This what I would do in C - I’m hoping for a more “Haskelly” solution
If you first have a test that tests that the myDLLFunction works as expected, then write a test for the myFunction as it is right now would show it does what it should do, right? Without the need of testing the myFunction code without the myDLLFunction bit?
If you want to run myFunction with myDLLFunction swapped out for another implementation, you will have to use an effect system. The downsides would be that you need to wrap your code into an effect monad and that that approach incurs some small overhead, but currently this is the Haskell solution.
Thank you @Vlix - I agree with your statement. My actual code in Haskell is more complex than the provided example (complex enough that testing is a really good idea).
If you do not care about performance (as in you don’t care if the total effect overhead is 1ms or 200ms), any popular effect system should be good enough. Certain libraries boast extremely low overhead on calls, see for example effectful, but I don’t know how well those benchmarks map onto the real world.
Both effectful and cleff are both plenty fast for stuff like 60fps games per the effectful benchmarks imo (the difference between them is something like at most a dozen micros per 1k dispatches - with it being like 30 micros overall overhead at worst?)
They also both have nice APIs, so you can’t go wrong. I personally prefer cleff.
In general, making tests for the functions used in the main function you want to test is a good way to inductively “prove” that the function works as expected. (i.e. “Everything used in the function works, so the function also must work”)
If it makes it difficult to test (I don’t know your scenario), I’d just go the argument route. Make a function myFunction' that takes a (in this case) Int -> IO Int, and just define myFunction = myFunction' myDLLFunction. You can then in your test suite add this specific module as an other-module: so you can just import this module and use myFunction' in your tests (you might have to add the source code directory where this module is to the hs-source-dirs: as well, since it will probably not be in the folder your test suite source code is in)
Using cleff I was able to update my trivial example:
{-# LANGUAGE GADTs, KindSignatures, TypeOperators, FlexibleContexts, DataKinds, TemplateHaskell #-}
module Main where
import Cleff
-- Define Effect
data CallDll :: Effect where
DllFunction :: Int -> CallDll m (Int)
makeEffect ''CallDll
runDllFunction :: IOE :> es => Eff (CallDll : es) a -> Eff es a
runDllFunction = interpretIO (\x -> case x of
DllFunction y -> myDllFunction y
)
myDllFunction :: Int -> IO Int
myDllFunction x = return (x+1)
runMockFunction :: Eff (CallDll : es) Int -> Eff es Int
runMockFunction = interpret (\x -> case x of
DllFunction y -> myMockFunction y
)
myMockFunction :: Int -> Eff m Int
myMockFunction x = pure x
-- Function that depends on `dllFunction`
implementation :: CallDll :> es => Int -> Eff es Int
implementation x = do
value <- dllFunction x
return value
-- Call using myDllFunction
myFunctionReal :: Int -> IO (Int)
myFunctionReal x = runIOE $ runDllFunction (implementation x)
-- Call using myMockFunction
myFunctionMock :: Int -> Int
myFunctionMock x = runPure $ runMockFunction (implementation x)
main :: IO ()
main = do
r <- myFunctionReal 2
putStrLn ("Real: 2 + 1 = " ++ (show r))
putStrLn ("Mock: 2 + 1 = " ++ (show (myFunctionMock 2)))
This seems to work, and it allows for the mock function to be “pure” which is neat:
I love your suggestion - it’s simple and effective:
module Main where
-- This is a stand in for a DLL function, which does big, BIG things
myDllFunction :: Int -> IO Int
myDllFunction x = return (x+1)
myMockFunction :: Int -> IO Int
myMockFunction x = return x
_myFunction :: (Int -> IO Int) -> Int -> IO (Int)
_myFunction f x = f x
-- This is the function that will be the expected way a user should call the Dll
-- Function, which does some super cool stuff
myFunctionReal :: Int -> IO Int
myFunctionReal = _myFunction myDllFunction
myFunctionMock :: Int -> IO Int
myFunctionMock = _myFunction myMockFunction
main :: IO ()
main = do
r <- myFunctionReal 2
m <- myFunctionMock 2
putStrLn ("Real: 2 + 1 = " ++ (show r))
putStrLn ("Mock: 2 + 1 = " ++ (show m))
Output:
Real: 2 + 1 = 3
Mock: 2 + 1 = 2
I’ll think about which of these options would be best for what I’m doing thank you all.