Implement Applicative for custom ZipList

Question

This comes from an exercise in book Haskell from First Principles . The exercise is to implement Applicative for ZipList' , which is analogous to the Prelude's ZipList . The book has this hint

Check Prelude for functions that can give you what you need. One starts with the letter z , the other with the letter r . You're looking for inspiration from these functions, not to be able to directly reuse them as you're using a custom List type, not the Prelude provided list type.

I guessed the function that starts with z is zipWith , but I do not know about a function that starts with r .

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Show)

zipWith' :: (a -> b -> c) -> List a -> List b -> List c
zipWith' _ Nil _ = Nil
zipWith' _ _ Nil = Nil
zipWith' f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWith' f xs ys)

newtype ZipList' a = ZipList' (List a)
  deriving (Eq, Show)

instance Functor ZipList' where
  fmap f (ZipList' xs) = ZipList' $ fmap f xs

instance Applicative ZipList' where
  pure x = ZipList' $ Cons x Nil
  (ZipList' fs) <*> (ZipList' xs) = ZipList' $ zipWith' ($) fs xs

This passes a test case in the book, but I am wondering if there's a better way to implement it since I did not use a function that starts with r . I have a feeling this was supposed to be repeat because it's also supposed to work over infinite lists.

Answer 1

Reading the thread under the original post, I came to a conclusion the author of the post is trying to prove that the implementation satisfies the law ( fmap f xs = (pure f) <*> xs ):

Let's try proving it as a classical identity, getting rid of the wrapper. Thus, let's work with the right hand:

(pure f) <*> xs = (repeat' f) <*> xs = zipWith' ($) (repeat' f) xs ;

As far as identity goes, proving that zipWith' ($) (repeat' f) xs equals fmap f xs would suffice.

The reason they are the same is pretty obvious:

length (zipWith op xs ys) == min (length xs) (length ys) ; (this expression could not be evaluated in case of both xs and ys being infinite).

Since repeat' f is infinite, length $ zipWith' ($) (repeat' f) xs is, in fact, length xs (here, it does not actually matter, whether such a value exists: the existence of indices would suffice). Each element of xs gets applied to the same function f , which is repeated. As you can see, the size is preserved and every element is morphed by a constant function, which is the definition of fmap .

Answer 2

I thought about it for a bit after Robin Zigmond's comment :

The key is to think about the requirement for a lawful Applicative instance that fmap fx == (pure f) <*> x , and recognise that there is no upper limit on the length of the list x .

This implementation should satisfy the Applicative laws.

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Show)

zipWith' :: (a -> b -> c) -> List a -> List b -> List c
zipWith' _ Nil _ = Nil
zipWith' _ _ Nil = Nil
zipWith' f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWith' f xs ys)

repeat' :: a -> List a
repeat' x = Cons x $ repeat' x

newtype ZipList' a = ZipList' (List a)
  deriving (Eq, Show)

instance Functor ZipList' where
  fmap f (ZipList' xs) = ZipList' $ fmap f xs

instance Applicative ZipList' where
  pure x = ZipList' $ repeat' x
  (ZipList' fs) <*> (ZipList' xs) = ZipList' $ zipWith' ($) fs xs