从文件系统动态生成 Tasty `TestTree`

Question

我已经使用 Parsec library. I would like to write a high-level unit test using the 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调用来提取一个TestTree 通过 unsafePerformIO :: IO [TestTree] -> [TestTree]。我觉得不得不使用这个不安全的函数调用，因为我无法弄清楚如何在 testCase 结构中使用从文件系统（文件名）派生的信息。结果 [TestTree] 被困在 IO monad 中。

不仅使用这个不安全的函数不理想，而且它甚至不起作用，因为 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

我发现不可能为 withResource 的最后一个参数构造类型 IO a -> TestTree 的函数，它不使用 [ 中的 IO a 输入=91=]TestName testCase 或 testGroup[=128 的参数=] 电话。尽管查看了 Tasty 框架作者的详细解释，也许我还是想念如何withResources 应该被使用。也许在 Tasty 框架中有更好的功能来实现所需的 TestTree?

问题：

如何从具有所需描述性输出的文件系统动态创建 TestTree？

Answer 1

不能通过资源动态构建 TestTree 的事实是有意为之的。当我写 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.

因此不应使用资源来构建测试树；它们专为不同的用例而设计。

那么，如何动态构建测试树呢？诀窍是要意识到您的 main 可以不仅仅是 defaultMain。实际上，它可以使用 IO 的全部功能来构建测试树，然后然后调用 defaultMain 动态构建的测试树。

所以，

main = do
  testTree <- constructTestTree
  defaultMain testTree

你可以在 haskell-src-ext 的测试中看到一个真实的例子套房.

从文件系统动态生成 Tasty `TestTree`

Dynamically generate Tasty `TestTree` from the file system

haskell

unit-testing

dynamically-generated

hunit

io-monad

问题：