我已经使用该Parsec库编写了一个文件解析器。我想使用Tasty测试框架编写一个高级单元测试，以确保解析器正确解析一些给定的文件。
我在以下目录结构中有三个格式正确的文件：
path/to/files -+
|-> fileA
|-> fileB
|-> fileC
我想：
- 获取所有文件
path/to/files - 读取每个文件的内容
- 为每个文件创建一个
testCase，以确保成功解析文件的内容 - 是否动态完成此操作，以便我以后可以添加更多文件而永远不会更改代码
我设法构建了以下内容：
{-# 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
这种结构有效，但并不理想。这是因为testSuite运行时生成的输出描述性不是很强。
成功时：
Files that should successfully be parsed
Valid files
Unexpected parse errors: OK (6.54s)
失败时：
Files that should successfully be parsed
Valid files
Unexpected parse errors: FAIL (3.40s)
path/to/files/fileB
这个输出并不理想，因为它只会输出第一个解析失败的文件，而不是所有失败的文件。此外，无论是否有任何失败，它也不会告诉您哪些文件被成功解析。
我希望测试树看起来像这样：
成功时：
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)
失败时：
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)
这是我尝试TestTree从文件系统动态生成格式良好的尝试：
-- | 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
如您所见，unsafePerformIO此代码中有一个难看的调用来提取TestTreevia unsafePerformIO :: IO [TestTree] -> [TestTree]。我觉得有必要使用这个不安全的函数调用，因为我不知道如何在testCase结构中使用从文件系统（文件名）派生的信息。结果被困在[TestTree] IOmonad中。
使用这个不安全的函数不仅不理想，而且它甚至不起作用，因为这个IO动作实际上是不安全的。测试套件永远不会运行，因为引发了以下异常：
*** Exception: Unhandled resource. Probably a bug in the runner you're using.
给定 的类型签名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
我发现不可能IO a -> TestTree 为最后一个参数构造一个类型的函数，withResource该函数不使用或调用的参数中的IO a输入。尽管查看了框架作者的详细解释，但也许我想念应该如何使用 to。也许 Tasty 框架内有更好的功能来实现预期？TestNametestCasetestGroupTastywithResourcesTestTree
问题：
如何TestTree从具有所需描述性输出的文件系统动态创建一个？