Haskell 快速检查：如何使用穷尽性检查器来防止忘记总和类型的构造函数

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

data Mytype
  = C1
  | C2 Char
  | C3 Int String

如果我在

Mytype

上执行

case

而忘记处理其中一个案例，GHC会向我发出警告（详尽性检查）

我现在想编写一个快速检查

任意

实例来生成

MyTypes

如下：

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

但感觉不太优雅

---

我直觉上觉得没有100%干净的解决方案，但我希望能减少忘记此类情况的机会——特别是在代码和测试分离的大型项目中。

这里我利用了一个未使用的变量

\ux

。不过，这并不比您的解决方案更优雅

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

实例任意Mytype，其中
任意的
设x=C1->ux的情形x；C2->x；C3 u->x
n C1
2->C2任意
3->C3任意自定义根

当然，最后一个

案例必须与
\ux
的虚拟定义保持一致，因此它不是完全干燥的

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

如果您不需要自定义生成器，我相信
Data.Data
可以通过Template Haskell被利用来生成
任意的
实例（我想我看到一些代码正是这样做的，但我不记得在哪里）。这样，实例就不会错过构造函数。
我用TemplateHaskell实现了一个解决方案，您可以在中找到原型。有了这个，你可以写：

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

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

我感到惊讶的是，
Language.Haskell.TH
中的类型没有
Generic
实例，也没有
Integer
或
Word8
-
Generic
实例，因为它们出现在
Exp
中。因此，我将它们添加为孤立实例（对于大多数情况，
StandaloneDeriving
会这样做，但对于
Integer
等基本类型，我必须复制粘贴实例，因为
Int
拥有它们）

这个解决方案并不完美，因为它不像
案例那样使用穷尽性检查器，但正如我们所同意的，保持干燥是不可能的，而这个解决方案是干燥的

一种可能的改进/替代方法是编写一个TH函数，该函数一次检查整个模块中的所有任意实例，而不是在每个任意实例中调用
ExtravenesCheck
。
您希望确保代码以特定方式运行；检查代码行为的最简单方法是测试它

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

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
非常冗长，因为一个catch-all
eqCons\uu=False
将绕过穷尽性检查
使用幻数100和3
不太一般

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

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

请注意，我们使用conscont来完全消除魔法
3
。魔术
100
（它确定了构造函数所需的最小频率）现在可以根据conscont进行缩放，但这只需要更多的测试数据

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

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

conscont=length（dataTypeConstrs C1）
newtype MyTypeList=MTL[MyType]派生（等式，显示）
实例任意MyTypeList，其中
任意=MTL向量（100*conscont）任意
收缩（MTL xs）=MTL（收缩xs）
allCons（MTL xs）=长度构造函数==conscont
其中构造函数=长度。核心。映射到constr$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)

实例任意MyTypeList，其中
任意=do x x
C3\uux->x
收缩（MTL xs）=MTL（收缩xs）
以下是使用库的解决方案：

genericArbitraryG
负责生成
MyType
的每个构造函数。在这种情况下，我们使用
uniform
来获得构造函数的均匀分布。使用
customGens
我们定义
Mytype
中的每个
String
字段都是使用
someCustomGen
生成的

有关更多示例，请参见。
另一种可能性是使用
GHC.Generics
派生任意实例
GHC.Generics
非常适合于您可以对sum（数据类型的构造函数）和Produ执行什么操作的情况
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)

{-# 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