在编写一些Arbitrary
实例时,我实现了几个具有以下非常机械模式的函数:
type A = Arbitrary -- to cut down on the size of the annotations below
shrink1 :: (A a ) => (a -> r) -> (a -> [r])
shrink2 :: (A a, A b ) => (a -> b -> r) -> (a -> b -> [r])
shrink3 :: (A a, A b, A c) => (a -> b -> c -> r) -> (a -> b -> c -> [r])
shrink1 f a = [f a' | a' <- shrink a]
shrink2 f a b = [f a' b | a' <- shrink a] ++ [f a b' | b' <- shrink b]
shrink3 f a b c = [f a' b c | a' <- shrink a] ++ [f a b' c | b' <- shrink b] ++ [f a b c' | c' <- shrink c]
我手写出了这些函数,直到shrink7
,这似乎足以满足我的需求。但我不禁想知道:这能合理地自动化吗?解决方案的加分项:
- 允许
shrink0 f = []
- 生成所有收缩器
- 有很多类型类黑客,我喜欢
- 跳过可怕的扩展,如不连贯/不可判定/重叠的实例
- 让我也吃我的蛋糕:不需要我在传递时解开
f
,也不要求我在将其应用于a
、b
和c
时shrinkX f
咖喱应用程序
这编译,我希望它有效:
{-# LANGUAGE TypeFamilies #-}
import Test.QuickCheck
class Shrink t where
type Inp t :: *
shrinkn :: Inp t -> t
(++*) :: [Inp t] -> t -> t
instance Shrink [r] where
type Inp [r] = r
shrinkn _ = []
(++*) = (++)
instance (Arbitrary a, Shrink s) => Shrink (a -> s) where
type Inp (a -> s) = a -> Inp s
shrinkn f a = [ f a' | a' <- shrink a ] ++* shrinkn (f a)
l ++* f = b -> map ($ b) l ++* f b
(++*)
仅用于实现收缩。
很抱歉相对缺乏类型类黑客。该[r]
为类型递归提供了一个很好的停止条件,因此不需要黑客攻击。
我怀疑在这种情况下您可以避免可怕的扩展,但除此之外:
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies,
UndecidableInstances, IncoherentInstances #-}
import Test.QuickCheck
class Shrinkable a r where
shrinkn :: a -> r
instance (Shrinkable [a -> b] r) => Shrinkable (a -> b) r where
shrinkn f = shrinkn [f]
instance (Arbitrary a, Shrinkable [b] r1, r ~ (a -> r1)) => Shrinkable [a -> b] r where
shrinkn fs@(f:_) a =
let fs' = [f a | f <- fs]
in shrinkn $ fs' ++ [f a' | a' <- shrink a]
instance (r ~ [a]) => Shrinkable [a] r where
shrinkn (_:vs) = vs
instance (r ~ [a]) => Shrinkable a r where
shrinkn e = []
下面是一些用于针对示例函数进行测试的快速检查属性:
prop0 a = shrinkn a == []
prop1 a = shrink1 not a == shrinkn not a
prop2 a b = shrink2 (++) a b == shrinkn (++) a b
f3 a b c = if a then b + c else b * c
prop3 a b c = shrink3 f3 a b c == shrinkn f3 a b c