如何抽象一个常见的Haskell递归应用函子模式？

Question

在Haskell中使用应用程序函子时，我经常遇到这样的情况：

instance Arbitrary MyType where
  arbitrary = MyType <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

在这个例子中，我想说：

instance Arbitrary MyType where
  arbitrary = applyMany MyType 4 arbitrary

但我不知道如何制作applyMany (或类似的东西)。我甚至不知道类型是什么，但是它需要一个数据构造函数、一个Int (n)和一个函数来应用n次。在为QuickCheck、SmallCheck、Data.Binary、Xml序列化和其他递归情况创建实例时会发生这种情况。

那么如何定义applyMany呢？

Answer 1

我想你可以用OverlappingInstances黑客来做：

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, OverlappingInstances #-}
import Test.QuickCheck
import Control.Applicative


class Arbitrable a b where
    convert :: Gen a -> Gen b

instance (Arbitrary a, Arbitrable b c) => Arbitrable (a->b) c where
    convert a = convert (a <*> arbitrary)

instance (a ~ b) => Arbitrable a b where
    convert = id

-- Should work for any type with Arbitrary parameters
data MyType a b c d = MyType a b c d deriving (Show, Eq)

instance Arbitrary (MyType Char Int Double Bool) where
    arbitrary = convert (pure MyType)

check = quickCheck ((\s -> s == s) :: (MyType Char Int Double Bool -> Bool))

Answer 2

看看导出。任何其他好的泛型库也应该能够做到这一点；派生正是我所熟悉的。例如：

{-# LANGUAGE TemplateHaskell #-}
import Data.DeriveTH
import Test.QuickCheck

$( derive makeArbitrary ''MyType )

为了解决你实际提出的问题，FUZxxl是对的，这在普通的香草Haskell中是不可能的。正如你所指出的，它的类型还不清楚。使用模板Haskell元编程是可能的(不太愉快)。如果你走这条路，你可能应该使用一个已经为你做了艰苦研究的泛型库。我相信使用类型级自然语言和类型类也是可能的，但不幸的是，这种类型级别的解决方案通常很难抽象出来。Conor McBride是致力于解决这个问题。

Answer 3

不满意我的另一个答案，我想出了一个令人惊叹的答案。

-- arb.hs
import Test.QuickCheck
import Control.Monad (liftM)

data SimpleType = SimpleType Int Char Bool String deriving(Show, Eq)
uncurry4 f (a,b,c,d) = f a b c d

instance Arbitrary SimpleType where
    arbitrary = uncurry4 SimpleType `liftM` arbitrary
    -- ^ this line is teh pwnzors.
    --  Note how easily it can be adapted to other "simple" data types

ghci> :l arb.hs
[1 of 1] Compiling Main             ( arb.hs, interpreted )
Ok, modules loaded: Main.
ghci> sample (arbitrary :: Gen SimpleType)
>>>a bunch of "Loading package" statements<<<
SimpleType 1 'B' False ""
SimpleType 0 '\n' True ""
SimpleType 0 '\186' False "\208! \227"
...

长篇解释我是如何解决这个问题的，

我就是这样得到它的。我在想，“Arbitrary实例是如何为(Int, Int, Int, Int)创建的?我确信没有人编写它，所以必须以某种方式导出它。

(Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (a, b, c, d)

如果他们已经有了这个定义，那为什么不滥用它呢？仅仅由较小的任意数据类型组成的简单类型与元组没有太大的不同。

所以现在我需要对4元组的“任意”方法进行某种程度的转换，这样它才能适用于我的类型。不速之客可能是其中之一。

停止播放。时间到了！

(我们可以很容易地定义我们自己的uncurry4，所以假设我们已经有了这个操作。)

我有一个生成器arbitrary :: Gen (q,r,s,t) (其中q，r，s，t都是任意的实例)。但我们只能说是arbitrary :: Gen a。换句话说，a代表(q,r,s,t)。我有一个函数，uncurry4，它的类型是(q -> r -> s -> t -> b) -> (q,r,s,t) -> b。显然，我们将把uncurry4应用于我们的SimpleType构造函数。所以uncurry4 SimpleType有(q,r,s,t) -> SimpleType类型。但是，让我们保持返回值的泛型，因为Hoogle不知道我们的SimpleType。因此，记住我们对a的定义，我们基本上就有了uncurry4 SimpleType :: a -> b。

所以我有一个Gen a和一个函数a -> b。我想要一个Gen b结果。(记住，对于我们的情况，a是(q,r,s,t)，b是SimpleType)。因此，我正在寻找一个具有此类型签名的函数：Gen a -> (a -> b) -> Gen b。胡扯，并且知道Gen是Monad的一个实例，我立即意识到liftM是解决我的问题的一种神奇的方法。

胡格尔再次拯救了这一天。我知道可能会有一些“提升”组合器来获得想要的结果，但老实说，我没有想到使用liftM (durrr!)直到我发现了那个类型的签名。