For my work with hxt I implemented the following function:
-- | Construction of a 8 argument arrow from a 8-ary function. Same
-- implementation as in @Control.Arrow.ArrowList.arr4@.
arr8 :: ArrowList a => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> b7 -> b8 -> c)
-> a (b1, (b2, (b3, (b4, (b5, (b6, (b7, b8))))))) c
arr8 f = arr ( \ ~(x1, ~(x2, ~(x3, ~(x4, ~(x5, ~(x6, ~(x7, x8)))))))
-> f x1 x2 x3 x4 x5 x6 x7 x8 )
As mentioned in the haddock comment the above function arr8 takes an 8-ary function and returns a 8 argument arrow. I use the function like this: (x1 &&& x2 &&& ... x8) >>> arr8 f whereby x1 to x8 are arrows.
My question: Is there a way to avoid the big tuple definition? Is there a more elegant implementation of arr8?
Info: I used the same code schema as in the function arr4 (see source code of arr4)
This works, though it depends on some quite deep and fragile typeclass magic. It also requires that we change the tuple structure to be a bit more regular. In particular, it should be a type-level linked list preferring (a, (b, (c, ()))) to (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
And now we can do
> 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
If you want to define the specific variants, they're all just 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
It's finally worth noting that if we define a lazy uncurry
uncurryL :: (a -> b -> c) -> (a, b) -> c
uncurryL f ~(a, b) = f a b
then we can write the recursive branch of Zup in a way that is illustrative to what's going on here
instance Zup b => Zup (a, b) where
zup f = uncurryL (zup . f)