Dynamically generate Tasty `TestTree` from the file system

Question

I have written a file parser using the Parsec library. I would like to write a high-level unit test using the Tasty testing framework to ensure that the parser correctly parses some given files.

I have three well formatted files in the following directory structure:

path/to/files -+
               |-> fileA
               |-> fileB
               |-> fileC

I would like to:

1. Get all files in path/to/files
2. Read each file's contents
3. Create a testCase for each file which ensures that the file's content is successfully parsed
4. Have this be done dynamically so I can add more files later and never change the code

I managed to construct the following:

{-# LANGUAGE BangPatterns, FlexibleContexts #-}

module Test.MyParser
  ( testSuite
  ) where

import Control.Arrow              ((&&&))
import Data.Map                   (Map,fromList,toList)
import System.Directory
import System.IO.Unsafe           (unsafePerformIO) -- This is used for a hack
import Test.Tasty                 (TestTree,testGroup,withResource)
import Test.Tasty.HUnit
import Text.Parsec

-- | Determine if an Either is a Right or Left value
--   Useful for determining if a parse attempt was successful
isLeft, isRight :: Either a b  -> Bool
isLeft (Left _) = True
isLeft _        = False
isRight = not . isLeft

-- | My file parser, a Parsec monad definition
myFileParser :: Parsec s u a
myFileParser = undefined -- The parser's definition is irrelivant

-- | Gets all the given files and thier contents in the specified directory
getFileContentsInDirectory :: FilePath -> IO (Map FilePath String)
getFileContentsInDirectory path = do
    files <- filter isFile <$> getDirectoryContents path
    sequence . fromList $ (id &&& readFile) . withPath <$> files
  where
    isFile = not . all (=='.')
    withPath file = if last path /= '/'
                    then concat [path,"/",file]
                    else concat [path,    file]

-- | Reads in all files in a directory and ensures that they correctly parse
--   NOTE: Library hack :(
--   On success, no file names will be displayed.
--   On the first failure, no subsequent files will have parsing attempt tried
--   and the file path for the failed file will be displayed.

testSuite :: TestTree
testSuite = testGroup "Files that should successfully be parsed" [withResource validContents release validateFiles]
  where
    validContents = getFileContentsInDirectory "path/to/files"
    release = const $ pure ()
    parse'  :: (FilePath,String) -> Either ParseError a
    parse'  (path,content) = parse myFileParser path content
    success :: (FilePath,String) -> Assertion
    success (path,content) = assertBool path . isRight $ parse' (path,content)
    validateFiles :: IO (Map FilePath String) -> TestTree
    validateFiles !filesIO = testGroup "Valid files" [testCase "Unexpected parse errors" fileTree]
      where
        fileTree :: IO () --also an Assertion
        fileTree = do
          files <- toList <$> filesIO
          sequence_ $ success <$> files

This construction works, but is not ideal. This is because the output generated when the testSuite is run is not very descriptive.

On success:

Files that should successfully be parsed
  Valid files
    Unexpected parse errors: OK (6.54s)

On failure:

Files that should successfully be parsed
  Valid files
    Unexpected parse errors: FAIL (3.40s)
      path/to/files/fileB

This output is not ideal because it will only output the first file that failed to successfully be parsed rather then all files that failed. Also, regardless of whether there are any failures, it also doesn't tell you which files are successfully being parsed.

What I would like the test tree to look like is this:

On success:

Files that should successfully be parsed
  Valid files
    "path/to/files/fileA": OK (2.34s)
    "path/to/files/fileB": OK (3.45s)
    "path/to/files/fileC": OK (4.56s)

On failure:

Files that should successfully be parsed
  Valid files
    "path/to/files/fileA": OK   (2.34s)
    "path/to/files/fileB": FAIL (3.45s)
    "path/to/files/fileC": FAIL (4.56s)

Here's my attempt to make a well formed TestTree dynamically from the file system:

-- | How I would like the code to work, except for the `unsafePerformIO` call
testSuite' :: TestTree
testSuite' = testGroup "Files that should successfully be parsed" [withResource validContents release validateFiles]
  where
    validContents = getFileContentsInDirectory "path/to/files"
    release = const $ pure ()
    parse'  :: (FilePath,String) -> Either ParseError a
    parse'  (path,content) = parse myFileParser path content
    success :: (FilePath,String) -> TestTree
    success (path,content) = testCase (show path) . assert . isRight $ parse' (path,content)
    validateFiles :: IO (Map FilePath String) -> TestTree
    validateFiles !filesIO = testGroup "Valid files" $ unsafePerformIO fileTree
      where
        fileTree :: IO [TestTree]
        fileTree = fmap success . toList <$> filesIO

As you can see, there is an unsightly unsafePerformIO call in this code to extract a TestTree via unsafePerformIO :: IO [TestTree] -> [TestTree]. I felt compelled to use this unsafe function call because I could not figure out how to use information derived from the file system (file names) within the testCase constructions. The resulting [TestTree] was trapped in the IO monad.

Not only is this using this unsafe function not ideal, but it doesn't even work because the IO action is in fact unsafe. The test suite is never run because the following exception is raised:

*** Exception: Unhandled resource. Probably a bug in the runner you're using.

Given the type signature of withResource:

withResource :: IO a               -- initialize the resource
             -> (a -> IO ())       -- free the resource
             -> (IO a -> TestTree) -- IO a is an action which returns the acquired resource. Despite it being an IO action, the resource it returns will be acquired only once and shared across all the tests in the tree.
             -> TestTree

I find it impossible to construct a function of type IO a -> TestTree for the last parameter of withResource which doesn't use the IO a input in the TestName parameters of testCase or testGroup calls. Despite reviewing the Tasty framework author's verbose explanation, perhaps I am miss understanding how to withResources is supposed to be used. Perhaps there is a better function within the Tasty framework to achieve the desired TestTree?

Question:

How can I dynamically create a TestTree from the file system which has the desired descriptive output?

Answer 1

The fact that you cannot construct the TestTree dynamically through resources is very much intentional. As I write here,

One of the major problems with tests receiving the resource value directly, as in

withResource
  :: IO a
  -> (a -> IO ())
  -> (a -> TestTree)
  -> TestTree

... was that the resource could be used not only in the tests themselves, but to construct the tests, which is bad/wrong for a number of reasons. For instance, we don't want to create the resources when we're not running tests, but we still want to know which tests we have.

So resources shouldn't be used to construct the test tree; they are designed for a different use case.

How, then, can you construct a test tree dynamically? The trick is to realize that your main can be more than just defaultMain. Indeed, it can use the full power of IO to construct a test tree, and then call defaultMain with that dynamically constructed test tree.

So,

main = do
  testTree <- constructTestTree
  defaultMain testTree

You can see a real-world example of this in haskell-src-ext's test suite.