QuickCheck：如何使用穷举检查器来防止忘记 sum 类型的构造函数

Question

我有一个 Haskell 数据类型，比如

data Mytype
  = C1
  | C2 Char
  | C3 Int String

如果我case在Mytype而忘记处理的情形之一的，GHC给我一个警告（全面性检查）。

我现在想编写一个MyTypes Arbitrary实例来生成MyTypes例如：

instance Arbitrary Mytype where
  arbitrary = do
    n <- choose (1, 3 :: Int)
    case n of
      1 -> C1
      2 -> C2 <$> arbitrary
      3 -> C3 <$> arbitrary <*> someCustomGen

这样做的问题是我可以为Mytype添加一个新的替代方案而忘记更新 Arbitrary 实例，因此我的测试不会测试该替代方案。

我想找到一种使用 GHC 的详尽检查器来提醒我任意实例中被遗忘的案例的方法。

我想出的最好的是

arbitrary = do
  x <- elements [C1, C2 undefined, C3 undefined undefined]
  case x of
    C1     -> C1
    C2 _   -> C2 <$> arbitrary
    C3 _ _ -> C3 <$> arbitrary <*> someCustomGen

但是感觉真的不是很优雅。

我直觉上觉得没有 100% 干净的解决方案，但会欣赏任何能减少忘记这种情况的机会的东西——尤其是在代码和测试分开的大项目中。

Answer 1

我用 TemplateHaskell 实现了一个解决方案，你可以在https://gist.github.com/nh2/d982e2ca4280a03364a8找到一个原型。 有了这个，你可以写：

instance Arbitrary Mytype where
  arbitrary = oneof $(exhaustivenessCheck ''Mytype [|
      [ pure C1
      , C2 <$> arbitrary
      , C3 <$> arbitrary <*> arbitrary
      ]
    |])

它是这样工作的：你给它一个类型名称（比如''Mytype ）和一个表达式（在我的例子中是一个arbitrary样式Gen的列表）。 它获取该类型名称的所有构造函数的列表，并至少检查一次表达式是否包含所有这些构造函数。 如果您刚刚添加了一个构造函数但忘记将其添加到 Arbitrary 实例中，此函数将在编译时警告您。

这是用 TH 实现的方式：

exhaustivenessCheck :: Name -> Q Exp -> Q Exp
exhaustivenessCheck tyName qList = do
  tyInfo <- reify tyName
  let conNames = case tyInfo of
        TyConI (DataD _cxt _name _tyVarBndrs cons _derives) -> map conNameOf cons
        _ -> fail "exhaustivenessCheck: Can only handle simple data declarations"

  list <- qList
  case list of
    input@(ListE l) -> do
      -- We could be more specific by searching for `ConE`s in `l`
      let cons = toListOf tinplate l :: [Name]
      case filter (`notElem` cons) conNames of
        [] -> return input
        missings -> fail $ "exhaustivenessCheck: missing case: " ++ show missings
    _ -> fail "exhaustivenessCheck: argument must be a list"

我正在使用GHC.Generics轻松遍历Exp的语法树：使用toListOf tinplate exp :: [Name] （来自lens ）我可以轻松找到整个exp中的所有Name 。

我很惊讶Language.Haskell.TH中的类型没有Generic实例，并且（使用当前的 GHC 7.8）也不需要Integer或Word8 - 这些的Generic实例因为它们出现在Exp 。 所以我将它们添加为孤立实例（对于大多数情况， StandaloneDeriving ，但对于像Integer这样的原始类型，我必须复制粘贴实例，因为Int拥有它们）。

该解决方案并不完美，因为它不像case那样使用穷举检查器，但正如我们所同意的，在保持 DRY 时这是不可能的，而这个 TH 解决方案是 DRY。

一种可能的改进/替代方法是编写一个 TH 函数，该函数一次对整个模块中的所有 Arbitrary 实例进行检查，而不是在每个 Arbitrary 实例内调用exhaustivenessCheck 。

Answer 2

您希望确保您的代码以特定方式运行； 检查代码行为的最简单方法是对其进行测试。

在这种情况下，期望的行为是每个构造函数在测试中获得合理的覆盖率。 我们可以通过一个简单的测试来检查：

allCons xs = length xs > 100 ==> length constructors == 3
             where constructors = nubBy eqCons xs
                   eqCons  C1       C1      = True
                   eqCons  C1       _       = False
                   eqCons (C2 _)   (C2 _)   = True
                   eqCons (C2 _)    _       = False
                   eqCons (C3 _ _) (C3 _ _) = True
                   eqCons (C3 _ _)  _       = False

这很幼稚，但这是一个很好的第一枪。 它的优点：

• 如果添加了新的构造函数， eqCons将触发详尽警告，这正是您想要的
• 它检查您的实例是否正在处理所有构造函数，这正是您想要的
• 它也将检查所有构造实际上与一些有用的概率产生的（在这种情况下，至少1％）
• 它还检查您的实例是可用的，如。 不挂

它的缺点：

• 需要大量的测试数据，为了过滤掉那些长度> 100的
• eqCons非常冗长，因为一个eqCons _ _ = False会绕过穷举检查
• 使用幻数 100 和 3
• 不是很一般

有办法改善这一点，例如。 我们可以使用 Data.Data 模块计算构造函数：

allCons xs = sufficient ==> length constructors == consCount
             where sufficient   = length xs > 100 * consCount
                   constructors = length . nub . map toConstr $ xs
                   consCount    = dataTypeConstrs (head xs)

这失去了编译时详尽性检查，但只要我们定期测试并且我们的代码变得更加通用，它就是多余的。

如果我们真的想要彻底检查，有几个地方我们可以把它硬塞回去：

allCons xs = sufficient ==> length constructors == consCount
             where sufficient   = length xs > 100 * consCount
                   constructors = length . nub . map toConstr $ xs
                   consCount    = length . dataTypeConstrs $ case head xs of
                                                                  x@(C1)     -> x
                                                                  x@(C2 _)   -> x
                                                                  x@(C3 _ _) -> x

请注意，我们使用 consCount 来完全消除魔法3 。 神奇的100 （它决定了构造函数所需的最低频率）现在随着 consCount 进行缩放，但这只是需要更多的测试数据！

我们可以使用 newtype 很容易地解决这个问题：

consCount = length (dataTypeConstrs C1)

newtype MyTypeList = MTL [MyType] deriving (Eq,Show)

instance Arbitrary MyTypeList where
  arbitrary = MTL <$> vectorOf (100 * consCount) arbitrary
  shrink (MTL xs) = MTL (shrink <$> xs)

allCons (MTL xs) = length constructors == consCount
                   where constructors = length . nub . map toConstr $ xs

如果我们愿意，我们可以在某个地方进行简单的详尽检查，例如。

instance Arbitrary MyTypeList where
  arbitrary = do x <- arbitrary
                 MTL <$> vectorOf (100 * consCount) getT
              where getT = do x <- arbitrary
                              return $ case x of
                                            C1     -> x
                                            C2 _   -> x
                                            C3 _ _ -> x
  shrink (MTL xs) = MTL (shrink <$> xs)

Answer 3

在这里，我利用了一个未使用的变量_x 。 不过，这并不比您的解决方案更优雅。

instance Arbitrary Mytype where
  arbitrary = do
    let _x = case _x of C1 -> _x ; C2 _ -> _x ; C3 _ _ -> _x
    n <- choose (1, 3 :: Int)
    case n of
      1 -> C1
      2 -> C2 <$> arbitrary
      3 -> C3 <$> arbitrary <*> someCustomGen

当然，必须使最后case与_x的虚拟定义保持一致，因此它不是完全 DRY。

或者，可以利用 Template Haskell 构建编译时断言，检查Data.Data.dataTypeOf中的构造Data.Data.dataTypeOf是否符合预期。 这个断言必须与Arbitrary实例保持一致，所以这也不是完全 DRY。

如果您不需要自定义生成器，我相信可以利用Data.Data通过 Template Haskell 生成Arbitrary实例（我想我看到一些代码就是这样做的，但我不记得在哪里）。 这样，实例就不可能错过构造函数。

Answer 4

这是使用generic-random库的解决方案：

{-# language DeriveGeneric #-}
{-# language TypeOperators #-}

import Generic.Random
import GHC.Generics
import Test.QuickCheck

data Mytype
  = C1
  | C2 Char
  | C3 Int String
  deriving Generic

instance Arbitrary Mytype where
  arbitrary = genericArbitraryG customGens uniform
    where
      customGens :: Gen String :+ ()
      customGens = someCustomGen :+ ()

someCustomGen :: Gen String
someCustomGen = undefined

genericArbitraryG负责生成MyType每个构造函数。 在这种情况下，我们使用uniform来获得构造函数的均匀分布。 随着customGens我们定义每个String在现场Mytype与产生someCustomGen 。

有关更多示例，请参阅Generic.Random.Tutorial 。