如何抽象一个常见的Haskell递归applicative仿函数模式

Question

在Haskell中使用applicative functor的时候,我经常会遇到这样的情况,我最终会得到这样的重复代码:

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

检查派生.任何其他好的泛型库也应该能够做到这一点; 派生只是我熟悉的那个.例如:

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

$( derive makeArbitrary ''MyType )

为了解决你实际问过的问题,FUZxxl是对的,这在普通的Hillaell中是不可能的.正如你所指出的,目前还不清楚它的类型应该是什么.有可能使用Template Haskell元编程(不太令人愉快).如果你走这条路,你应该只使用一个已经为你做过艰苦研究的仿制库.我相信它也可以使用类型级自然和类型类,但不幸的是这种类型级解决方案通常难以抽象.Conor McBride 正在研究这个问题.

Answer 2

我认为你可以用OverlappingInstances hack来做到这一点:

{-# 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 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.Hoogling说,知道Gen是一个实例Monad,我一眼就认出liftM作为monadical魔法解决我的问题.

Hoogle再次拯救了这一天.我知道可能有一些"提升"组合器来获得理想的结果,但老实说我没想到使用liftM(durrr!),直到我用类型签名.

Answer 4

这是我至少得到的:

{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}

module ApplyMany where

import Control.Applicative
import TypeLevel.NaturalNumber -- from type-level-natural-number package

class GetVal a where
  getVal :: a

class Applicative f => ApplyMany n f g where
  type Res n g
  app :: n -> f g -> f (Res n g)

instance Applicative f => ApplyMany Zero f g where
  type Res Zero g = g
  app _ fg = fg

instance
  (Applicative f, GetVal (f a), ApplyMany n f g)
  => ApplyMany (SuccessorTo n) f (a -> g)
  where
    type Res (SuccessorTo n) (a -> g) = Res n g
    app n fg = app (predecessorOf n) (fg<*>getVal)

用法示例:

import Test.QuickCheck

data MyType = MyType Char Int Bool deriving Show
instance Arbitrary a => GetVal (Gen a) where getVal = arbitrary

test3 = app n3 (pure MyType) :: Gen MyType
test2 = app n2 (pure MyType) :: Gen (Bool -> MyType)
test1 = app n1 (pure MyType) :: Gen (Int -> Bool -> MyType)
test0 = app n0 (pure MyType) :: Gen (Char -> Int -> Bool -> MyType)

顺便说一句,我认为这个解决方案在现实世界中并不是很有用.特别是没有本地类型.