Prevent inadvertently using different type class instance

Question

I expect the following behavior from the applicative instance of my ZipList':

zipListApplyTest = fs <*> xs
  where fs = ZipList' [negate, id]
        xs = ZipList' [1..5]

-- Result: ZipList' [-1,2]

This was my first attempt:

newtype ZipList' a = ZipList' [a]
                   deriving (Eq, Show)

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

instance Applicative ZipList' where
  pure x = ZipList' [x]

  ZipList' (f:fs) <*> ZipList' (x:xs) =
     ZipList' $ f x : (fs <*> xs) -- <-- the bug is here
  ZipList' [] <*> _ = ZipList' []
  _ <*> ZipList' []  = ZipList' []

-- Unexpected result: ZipList' [-1,2,3,4,5]

After some head scratching, I realized that inside the applicative instance of ZipList' I accidentally used the wrong <*>:

In the line marked with the bug is here, I applied the <*> that belongs to the built-in list type [] instead of applying <*> of ZipList' recursively.

This is why the second function id was applied to the entire rest of the list, instead of only the second element, 2.

This yielded the expected result:

ZipList' fs <*> ZipList' xs = ZipList' $ zipApply fs xs
  where zipApply :: [(a -> b)] -> [a] -> [b]
        zipApply (f:fs) (x:xs) = f x : zipApply fs xs
        zipApply _ _           = []

Is there a compiler flag, language idiom, or other technique that would have prevented this bug or would have made it easier to spot?

I'm on GHC 8.2.2.

Answer 1

We can do this:

{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
-- at very top of file ^
-- ...
-- pick whatever names/operators you want
-- synonym signatures are given in GADT-like syntax
-- ZCons decomposes a ZipList' a into an a and a ZipList' a
-- (assuming it succeeds). This is the syntax even for pattern synonyms that
-- can only be used as patterns
-- (e.g. pattern Fst :: a -> (a, b); pattern Fst a <- (a, _)).
pattern ZCons :: a -> ZipList' a -> ZipList' a
-- xs needs to be a ZipList', but it's only a [a], so we uglify this synonym
-- by using the newtype wrapper as a view
pattern ZCons x xs <- ZipList' (x:(ZipList' -> xs))
-- views aren't in general invertible, so we cannot make this an automatically
-- bidirectional synonym (like ZNil is). We can give an explicit version
  where ZCons x (ZipList' xs) = ZipList' $ x:xs
-- simple enough that we can use one definition for both pattern and expression
pattern ZNil :: ZipList' a
pattern ZNil = ZipList' []
{-# COMPLETE ZNil, ZCons #-}
-- ZNil and ZCons cover all ZipLists

instance Applicative ZipList' where
  pure x = ZipList' $ repeat x
  -- these are bidirectional
  (ZCons f fs) <*> (ZCons x xs) = ZCons (f x) (fs <*> xs)
  _ <*> _ = ZNil

Answer 2

As a variant of AJFarmar's answer, you can keep your definition of ZipList' exploiting a [a] list inside, and instead declare pattern synonyms to pretend the type was declared as

data ZipList' a = ZipCons a (ZipList' a) | ZipNil

In that way, if you limit yourself in using these "pretend" constructors when you write your instances, you can not inadvertently involve a list.

{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS -Wall #-}
module ZipList where

newtype ZipList' a = ZipList' { unZipList' :: [a] }
                   deriving (Eq, Show)

Here are the pattern synonyms. We need to be a bit careful here since we need to convert lists to zip-lists as needed.

pattern ZipCons :: a -> ZipList' a -> ZipList' a
pattern ZipCons x xs <- ZipList' (x : (ZipList' -> xs))
  where ZipCons x xs = ZipList' (x : unZipList' xs)

pattern ZipNil :: ZipList' a
pattern ZipNil = ZipList' []

We can leave the functor instance as it was, exploiting the Functor [] instance. Here, we do want to call the list fmap. Otherwise, we could use the "pretend" constructors, but we'd have to re-implement it.

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

Finally, the applicative instance can use only the pretend constructors.

instance Applicative ZipList' where
  pure x = ZipCons x ZipNil

  ZipCons f fs <*> ZipCons x xs = ZipCons (f x) (fs <*> xs)
  _            <*> _            = ZipNil

To me a major downside of using the pattern synonyms is that the exhaustiveness checker gets easily confused, triggering spurious warnings. Above, if we replace the _ <*> _ case with the two obvious cases involving ZipNil, we trigger a warning.

(Update: HTNV used a COMPLETE pragma to silence the warning, which looks very nice! I did not know about that.)

Apart from that, pattern synonyms allow to offer a quite elegant interface. I wish they were used more often in the Haskell ecosystem.