类型类挑战:具有可变参数和结果

Question

在编写一些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 = []
• 产生所有的shrinkers
• 有很多类型的hackery,我很喜欢
• 跳过可怕的扩展,如不连贯/不可判断/重叠的实例
• 让我有我的鱼和熊掌兼得,太:不需要我uncurry f在路过的时候它还是咖喱的应用shrinkX f把它应用到的时候a,b和c

Answer 1

编译,我希望它的工作原理:

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

(++*) 仅用于实现收缩.

很抱歉相对缺乏类型类hackery.该[r]规定的类型递归一个很好的停止条件,因此不需要两轮牛车.