Is it possible to fold <*> in haskell?

Question

I want to realize something like

fun1 f a_ziplist

for example

getZipList $ (\x y z -> x*y+z) <$> ZipList [4,7] <*> ZipList [6,9] <*> ZipList [5,10]

f = (\x y z -> x*y+z) 
ziplist = [[4,7],[6,9],[5,10]]

To do this, I want to recursively apply <*> like

foldx (h:w) = h <*> foldx w
foldx (w:[]) = w

but it seems impossible to make <*> recursive.

Answer 1

Let's play with the types in ghci, to see where they carry us.

λ import Control.Applicative

The type of (<*>)

λ :t (<*>)
(<*>) :: Applicative f => f (a -> b) -> f a -> f b

The type of foldr:

λ :t Prelude.foldr
Prelude.foldr :: (a -> b -> b) -> b -> [a] -> b

Perhaps we could use (<*>) as the function that is passed as the first parameter of foldr. What would be the type?

λ :t Prelude.foldr (<*>)
Prelude.foldr (<*>) :: Applicative f => f a -> [f (a -> a)] -> f a

So it seems that it takes an initial value in an applicative context, and a list of functions in an applicative context, and returns another applicative.

For example, using ZipList as the applicative:

λ getZipList $ Prelude.foldr (<*>) (ZipList [2,3]) [ ZipList [succ,pred], ZipList [(*2)] ]

The result is:

[5]

I'm not sure if this is what the question intended, but it seems like a natural way to fold using (<*>).

Answer 2

If the ziplist argument has to be a plain list, it looks impossible. This is because fold f [a1,...,an] must be well typed for every n, hence f must be a function type taking at least n arguments for every n, hence infinitely many.

However, if you use a GADT list type, in which values expose their length as a type-level natural you can achieve something similar to what you want.

{-# LANGUAGE DataKinds, KindSignatures, TypeFamilies, GADTs #-}

import Control.Applicative

-- | Type-level naturals
data Nat = Z | S Nat

-- | Type family for n-ary functions
type family   Fn (n :: Nat) a b
type instance Fn Z     a b = b
type instance Fn (S n) a b = a -> Fn n a b

-- | Lists exposing their length in their type
data List a (n :: Nat) where
  Nil :: List a Z
  Cons :: a -> List a n -> List a (S n)

-- | General <*> applied to a list of arguments of the right length
class Apply (n :: Nat) where
   foldF :: Applicative f => f (Fn n a b) -> List (f a) n -> f b

instance Apply Z where
   foldF f0 Nil = f0

instance Apply n => Apply (S n) where
   foldF fn (Cons x xs) = foldF (fn <*> x) xs

test :: [(Integer,Integer,Integer)]
test = foldF (pure (,,)) (Cons [10,11] (Cons [20,21] (Cons [30,31] Nil)))
-- Result: [(10,20,30),(10,20,31),(10,21,30),(10,21,31)
--         ,(11,20,30),(11,20,31),(11,21,30),(11,21,31)]