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:
- Get all files in
path/to/files - Read each file's contents
- Create a
testCasefor each file which ensures that the file's content is successfully parsed - 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?
tasty >= 0.5 && < 0.7and use the older, less correct version ofwithResource? – Karren