如何避免模板 Haskell 声明引用中的额外缩进？

Question

我有一个玩具程序：

$ cat a.hs
main = putStrLn "Toy example"
$ runghc a.hs
Toy example

让我们添加一些模板 Haskell 到它：

$ cat b.hs
{-# LANGUAGE TemplateHaskell #-}
id [d|
main = putStrLn "Toy example"
|]
$ runghc b.hs

b.hs:3:0: parse error (possibly incorrect indentation)

那么，让我们修复缩进：

$ cat c.hs
{-# LANGUAGE TemplateHaskell #-}
id [d|
 main = putStrLn "Toy example"
 |]
$ runghc c.hs
Toy example

一个空格就足够了，但我必须缩进两个尾行。

我可以避免缩进我的大部分模块吗？ （我的真实模块不止一行代码。）（并且不使用{ ; ; } 符号？）

我确实希望在引用中捕获所有的模块声明 - 在普通代码中，我可以将 (...) 替换为 $ ...，是否有一些等效的 [d|...|] 可以让我避免使用右括号和缩进吗？

或者有什么方法模块 A 可以说任何模块 B 的顶级声明 A 是自动导入的由 A 导出的函数处理？

注意事项：

1. 我的真实程序中的模板 Haskell 比 id 更复杂——它扫描声明以查找以 prop_ 开头的变量名，并构建一个包含它们的测试套件。有没有其他纯粹的 Haskell 方法可以代替，而无需直接修改源文件？
2. 我正在使用 GHC v6.12.1。当我使用 GHC v7.0.3 时，针对不同位置（b.hs:3:1）报告了 b.hs 的错误，但其他方面的行为是相同的。

Answer 1

如果测试套件用于 QuickCheck，我建议您改用新的 All 模块： http://hackage.haskell.org/packages/archive/QuickCheck/2.4.1.1/doc/html/Test-QuickCheck-All.html

除了它通过访问文件系统并解析拼接所在的文件来获取属性名称外，它做同样的事情（如果您使用其他一些测试框架，您仍然可以使用相同的方法）。

如果你真的想引用整个文件，你可以使用一个准引号来代替（它不需要缩进）。您可以轻松地在 haskell-src-meta 上构建您的报价器，但我建议不要使用这种方法，因为它不支持某些 Haskell 功能，并且可能会给出糟糕的错误消息。

---

聚合测试套件是一个难题，可以扩展名称收集例程以以某种方式跟踪导入，但工作量很大。这是一个解决方法：

你可以使用forAllProperties的这个修改版：

import Test.QuickCheck
import Test.QuickCheck.All
import Language.Haskell.TH
import Data.Char
import Data.List
import Control.Monad

allProperties :: Q Exp -- :: [(String,Property)]
allProperties = do
  Loc { loc_filename = filename } <- location
  when (filename == "<interactive>") $ error "don't run this interactively"
  ls <- runIO (fmap lines (readFile filename))
  let prefixes = map (takeWhile (\c -> isAlphaNum c || c == '_') . dropWhile (\c -> isSpace c || c == '>')) ls
      idents = nubBy (\x y -> snd x == snd y) (filter (("prop_" `isPrefixOf`) . snd) (zip [1..] prefixes))
      quickCheckOne :: (Int, String) -> Q [Exp]
      quickCheckOne (l, x) = do
        exists <- return False `recover` (reify (mkName x) >> return True)
        if exists then sequence [ [| ($(stringE $ x ++ " on " ++ filename ++ ":" ++ show l),
                                     property $(mono (mkName x))) |] ]
         else return []
  [|$(fmap (ListE . concat) (mapM quickCheckOne idents)) |]

你还需要函数runQuickCheckAll，它不是从All导出的：

runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool
runQuickCheckAll ps qc =
  fmap and . forM ps $ \(xs, p) -> do
    putStrLn $ "=== " ++ xs ++ " ==="
    r <- qc p
    return $ case r of
      Success { } -> True
      Failure { } -> False
      NoExpectedFailure { } -> False

在您现在定义的每个测试模块中

propsN = $allProperties

其中N 是某个数字或其他唯一标识符（或者您可以使用相同的名称并在下面的步骤中使用限定名称）。

在您定义的主测试套件中

props :: [(String,Property)]
props = concat [props1, props2 ... propsN]

如果你真的想避免为每个模块添加一个列表成员，你可以制作一个 TH 脚本来生成这个列表。

要运行所有测试，您只需说一下

runTests = runQuickCheckAll quickCheckResult props

Answer 2

[我的程序] 扫描以 prop_ 开头的变量名的声明，并构建一个包含它们的测试套件。有没有其他纯粹的 Haskell 方法可以代替，而无需直接修改源文件？

是的，有！使用the language-haskell-extract package。

{-# LANGUAGE TemplateHaskell #-}

import Language.Haskell.Extract
import Test.QuickCheck

prop_foo xs = reverse (reverse xs) == (xs :: [Int])
prop_bar = 2 + 2 == 4

properties = $(functionExtractorMap "^prop_"
    [|\name prop -> putStrLn name >> quickCheck prop|])

main = sequence_ properties

运行这个，我们得到：

prop_foo
+++ OK, passed 100 tests.
prop_bar
+++ OK, passed 100 tests.

---

然而，在你重新发明轮子之前，我还建议你看一下 the test-framework-th package，它几乎可以做到这一点，而且还支持 HUnit 并且有一个很好的测试运行器（有颜色！）。

{-# LANGUAGE TemplateHaskell #-}

import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.Framework.TH
import Test.HUnit
import Test.QuickCheck

prop_bar = 1+1 == 2
case_foo = 2+2 @?= 4

main = $(defaultMainGenerator)

输出：

Main:
  bar: [OK, passed 100 tests]
  foo: [OK]

         Properties  Test Cases  Total      
 Passed  1           1           2          
 Failed  0           0           0          
 Total   1           1           2   

还有一个testGroupGenerator，如果您想合并来自多个文件的测试，它会很有用。