这行得通，尽管它依赖于一些相当深刻和脆弱的类型类魔法。它还要求我们将元组结构更改为更规则一些。特别是，它应该是一个类型级的链表，优先选择(a, (b, (c, ()))) 而不是(a, (b, c))。
{-# LANGUAGE TypeFamilies #-}
import Control.Arrow
-- We need to be able to refer to functions presented as tuples, generically.
-- This is not possible in any straightforward method, so we introduce a type
-- family which recursively computes the desired function type. In particular,
-- we can see that
--
-- Fun (a, (b, ())) r ~ a -> b -> r
type family Fun h r :: *
type instance Fun () r = r
type instance Fun (a, h) r = a -> Fun h r
-- Then, given our newfound function specification syntax we're now in
-- the proper form to give a recursive typeclass definition of what we're
-- after.
class Zup tup where
zup :: Fun tup r -> tup -> r
instance Zup () where
zup r () = r
-- Note that this recursive instance is simple enough to not require
-- UndecidableInstances, but normally techniques like this do. That isn't
-- a terrible thing, but if UI is used it's up to the author of the typeclass
-- and its instances to ensure that typechecking terminates.
instance Zup b => Zup (a, b) where
zup f ~(a, b) = zup (f a) b
arrTup :: (Arrow a, Zup b) => Fun b c -> a b c
arrTup = arr . zup
现在我们可以做
> zup (+) (1, (2, ()))
3
> :t arrTup (+)
arrTup (+)
:: (Num a1, Arrow a, Zup b n, Fun n b c ~ (a1 -> a1 -> a1)) =>
a b c
> arrTup (+) (1, (2, ()))
3
如果你想定义具体的变体，它们都只是arrTup。
arr8
:: Arrow arr
=> (a -> b -> c -> d -> e -> f -> g -> h -> r)
-> arr (a, (b, (c, (d, (e, (f, (g, (h, ())))))))) r
arr8 = arrTup
最后值得注意的是，如果我们定义一个惰性uncurry
uncurryL :: (a -> b -> c) -> (a, b) -> c
uncurryL f ~(a, b) = f a b
然后我们可以写出Zup 的递归分支，以说明这里发生了什么
instance Zup b => Zup (a, b) where
zup f = uncurryL (zup . f)