Search code examples
haskelltypeclassapplicativealgebraic-data-typescustom-data-type

Implement Applicative for custom ZipList


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.


Solution

  • 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 f x == (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