QuickCheck：如何使用穷举性检查器来防止遗忘总和类型的构造函数

Question

我有类似的Haskell数据类型

data Mytype
  = C1
  | C2 Char
  | C3 Int String

如果我case上的Mytype忘记处理其中一种情况，GHC会给我警告（穷举性检查。）

我现在想编写一个QuickCheck 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添加新的替代项，而忘记更新任意实例，因此我的测试未测试该替代项。

[我想找到一种使用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的列表）。它获取该类型名称的所有构造函数的列表，并检查表达式是否至少包含所有这些构造函数一次。如果您只是添加了一个构造函数而忘记将其添加到任意实例，则此函数将在编译时警告您。

这是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），我可以轻松地找到整个Name中的所有exp。

[令我感到惊讶的是，Language.Haskell.TH中的类型没有Generic实例，并且（在当前的GHC 7.8中）都不需要Integer或Word8-Generic实例，因为它们出现在[ C0]。因此，我将它们添加为孤立实例（对于大多数事情，Exp都是这样做的，但是对于像StandaloneDeriving的原始类型，我必须复制粘贴实例，因为Integer具有它们）。

该解决方案并不完美，因为它没有像Int那样使用穷举性检查器，但是我们同意，保持DRY是不可能的，而此TH解决方案是DRY。

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

Answer 2

这里，我利用未使用的变量exhaustivenessCheck。不过，这确实不比您的解决方案优雅。

_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的虚拟定义保持一致，因此它不是完全干燥的。​​

或者，可以利用模板Haskell构建编译时断言，检查_x中的构造函数是否为预期的构造函数。必须将该断言与Data.Data.dataTypeOf实例保持一致，因此也不完全是DRY。

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

Answer 3

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

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

Arbitrary

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

• [

  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

  将在添加新的构造函数时触发详尽警告，这是您想要的
• 它检查您的实例是否正在处理所有构造函数，这是您想要的
• 它还检查所有构造函数是否以某些有用的概率（在这种情况下至少为1％）实际生成]
• 它也检查您的实例是否可用，例如不挂机

其缺点：

• [需要大量的测试数据，以便过滤出长度> 100的数据
• [eqCons相当冗长，因为包罗万象的eqCons将绕过详尽性检查
• 使用魔术数字100和3
• 不是很通用

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

eqCons _ _ = False

这会丢失编译时的穷举性检查，但是只要我们定期进行测试并且我们的代码变得更加通用，它就是多余的。

如果我们真的想进行详尽的检查，可以在一些地方用力拔打它：

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

注意，我们使用consCount完全消除了魔法

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

。神奇的3（确定了构造函数的最低要求频率）现在可以通过consCount进行缩放，但这仅需要更多的测试数据！

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

100

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

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

Answer 4

这里是使用

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)

库的解决方案：

generic-random

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以获取更多示例。