get function name inside it

Question

I have a bunch of functions like: method1, method2, method3. For all of them there are HUnit test functions like: testMethod1, testMethod2, testMethod3.

testMethod1 = TestCase $
  assertEqual "testmethod1" ...

testMethod2 = TestCase $
  assertEqual "testmethod2" ...

testMethod3 = TestCase $
  assertEqual "testmethod3" ...

I would like to avoid redundant copying of function's name as prefix of error message and call it something like that:

testMethod1 = TestCase $
  assertEqual_ ...

How can it be achieved (any "magic" trick is appreciated)?

So actually question is how can function name be taken inside of it's definition?

---

Update.

It's not actually clear from original question, that I wanna handle that type of situation too:

tProcess = TestCase $ do
  assertEqual "tProcess" testResult $ someTest
  assertEqual "tProcess" anotherTestResult $ anotherTest
  assertEqual "tProcess" resultAgain $ testAgain

Finally I want to write something like that:

tProcess = TestCase $ do
  assertEqual_ testResult $ someTest
  assertEqual_ anotherTestResult $ anotherTest
  assertEqual_ resultAgain $ testAgain

Answer 1

You can't do this directly (i.e. so that your test case starts with testMethodN = ...), but you can use Template Haskell to get this:

testCase "testMethod1" [| do
    assertEqual_ a b
    assertEqual_ c d
 |]

This involves writing testCase :: String -> Q Exp -> Q [Dec], a function to turn the name of the test case and a quoted expression into a list of declarations. For instance:

{-# LANGUAGE TemplateHaskell #-}
    
import Data.Char
import Control.Applicative
import Control.Monad
import Language.Haskell.TH
import Data.Generics

assertEqual :: (Eq a) => String -> a -> a -> IO ()
assertEqual s a b = when (a /= b) . putStrLn $ "Test " ++ s ++ " failed!"

assertEqual_ :: (Eq a) => a -> a -> IO ()
assertEqual_ = error "assertEqual_ used outside of testCase"

testCase :: String -> Q Exp -> Q [Dec]
testCase name expr = do
    let lowerName = map toLower name
    e' <- [| assertEqual lowerName |]
    pure <$> valD
        (varP (mkName name))
        (normalB (everywhere (mkT (replaceAssertEqual_ e')) <$> expr))
        []
  where
    replaceAssertEqual_ e' (VarE n) | n == 'assertEqual_ = e'
    replaceAssertEqual_ _ e = e

The basic idea here is to generate a definition of the name given, and replace every occurrence of the variable assertEqual_ in the quoted expression with assertEqual lowerName. Thanks to Template Haskell's Scrap Your Boilerplate support, we don't need to traverse the entire AST, just specify a transformation for each Exp node.

Note that assertEqual_ must be a bound identifier with the correct type, since the quoted expression is typechecked before being passed on to testCase. Additionally, testCase must be defined in a separate module than the one it's used in, due to GHC's stage restriction.

Answer 2

The existing answers explain how to do this with metaprogramming, but one way to avoid the issue is to have anonymous tests which take their name as an argument.

We can then use a Data.Map to associate them with their names (in this case I'm just using raw Assertions, plus some syntactic sugar from the map-syntax package):

import Data.Map
import Data.Map.Syntax
import Test.HUnit

assertEqual_ x y n = assertEqual n x y

Right tests = runMap $ do
  "test1" ## assertEqual_ 1 2
  "test2" ## assertEqual_ 1 1
  "test3" ## assertEqual_ 3 2

To run these, we can fold the Data.Map using a function which:

• Takes the name and assertion-waiting-for-a-name as arguments
• Passes the name to the assertion-waiting-for-a-name
• Passes the resulting Assertion to TestCase
• Runs the TestCase
• Binds to another monadic action, using >>

We use return () as our default monadic action:

runTests = foldWithKey go (return ()) tests
    where go name test = (runTestTT (TestCase (test name)) >>)

This gives results like:

> go
### Failure:
test1
expected: 1
 but got: 2
Cases: 1  Tried: 1  Errors: 0  Failures: 1
Cases: 1  Tried: 1  Errors: 0  Failures: 0
### Failure:
test3
expected: 3
 but got: 2
Cases: 1  Tried: 1  Errors: 0  Failures: 1