How do I create an applicative instance for ziplist? - list

Question

I want to implement an instance of Applicative for my custom list.
import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes
data List a =
Nil
| Cons a (List a)
deriving (Eq, Show)
instance Eq a => EqProp (List a) where (=-=) = eq
instance Functor List where
fmap _ Nil = Nil
fmap f (Cons a Nil) = (Cons (f a) Nil)
fmap f (Cons a as) = (Cons (f a) (fmap f as))
main = do
let trigger = undefined :: List (Int, String, Int)
quickBatch $ applicative trigger
instance Arbitrary a => Arbitrary (List a) where
arbitrary = sized go
where go 0 = pure Nil
go n = do
xs <- go (n - 1)
x <- arbitrary
return (Cons x xs)
instance Applicative List where
pure x = (Cons x Nil)
Nil <*> _ = Nil
_ <*> Nil = Nil
(Cons f fs) <*> (Cons a as) = (Cons (f a) (fs <*> as))
This gives the following bugs:
λ> main
applicative:
identity: *** Failed! Falsifiable (after 3 tests):
Cons 0 (Cons (-1) Nil)
composition: *** Failed! Falsifiable (after 3 tests):
Cons <function> (Cons <function> Nil)
Cons <function> (Cons <function> Nil)
Cons 1 (Cons (-2) Nil)
homomorphism: +++ OK, passed 500 tests.
interchange: +++ OK, passed 500 tests.
functor: *** Failed! Falsifiable (after 3 tests):
<function>
Cons (-2) (Cons (-1) Nil)
First is the id law is failing:
λ> Cons id Nil <*> Cons 0 (Cons (-1) Nil)
Cons 0 Nil
How do I fix this? pure takes an a not a List a so I do not see how to match on List and preserve the nested list structure.
The composition law also fails which is not strange:
λ> (Cons "b" Nil) <*> (Cons "c" Nil)
<interactive>:295:7:
Couldn't match expected type ‘[Char] -> b’
with actual type ‘[Char]’
Relevant bindings include
it :: List b (bound at <interactive>:295:1)
In the first argument of ‘Cons’, namely ‘"b"’
In the first argument of ‘(<*>)’, namely ‘(Cons "b" Nil)’
In the expression: (Cons "b" Nil) <*> (Cons "c" Nil)
Edit: since I got great answers implementing applicative for ziplists, I have changed the question to be about ziplists.

Answer 1

For your ZipList-like approach we expect the following left-identity to hold:
pure id <*> someList = someList
For this, pure cannot return a single-element list, since this will stop immediately:
(Cons id Nil) <*> Cons 1 (Cons 2 Nil)
= Cons (id 1) (Nil <*> Cons 2 Nil)
= Cons 1 Nil
Which isn't the expected result for the left-identity. If pure cannot return only a single element list, how many should it return? The answer is: infinite:
repeatList :: a -> List a
repeatList x = let c = Cons x c in c
Why did I call this the ZipList approach? Because it's the same behaviour as in Control.Applicative.ZipList, which can be motivated with zipWith:
zipWithList :: (a -> b -> c) -> List a -> List b -> List c
zipWithList f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWithList f xs ys)
zipWithList _ _ _ = Nil
Now your instance is
instance Applicative List where
pure = repeatList
(<*>) = zipWithList ($)
However, checkers cannot check this instance either due to your EqProb instance, since pure f <*> pure x == pure (f x) (homomorphism) results in a check on infinite lists. You can provide an alternative one, though. For example, you can take an arbitrary number of elements and compare them:
prop_sameList :: Eq a => (Int, Int) -> List a -> List a -> Property
prop_sameList bounds xs ys = forAll (choose bounds) $ \n ->
takeList n xs `eq` takeList n ys
takeList :: Int -> List a -> List a
takeList _ Nil = Nil
takeList n (Cons x xs)
| n <= 0 = Nil
| otherwise = Cons x (takeList (n - 1) xs)
Then, if you want to compare at least 1000 and at most 10000 elements, you can use:
instance Eq a => EqProb (List a) where
(=-=) = prop_sameList (1000, 10000)
After all, we're just trying to find a list where our property does not hold.

Answer 2

Expanding on my comment to Zeta's much more deserving answer, you need a second change to get this test to run:
-- | Test lists for equality (fallibly) by comparing finite prefixes
-- of them. I've arbitrarily chosen a depth of 1,000. There may be
-- better ideas than that.
instance Eq a => EqProp (List a) where
xs =-= ys = takeList 1000 xs `eq` takeList 1000 ys
-- | Take a prefix of up to #n# elements from a 'List'.
takeList :: Int -> List a -> List a
takeList _ Nil = Nil
takeList n (Cons a as)
| n > 0 = Cons a (takeList (n-1) as)
| otherwise = Nil
With Zeta's changes and this one, your test suite passes:
applicative:
identity: +++ OK, passed 500 tests.
composition: +++ OK, passed 500 tests.
homomorphism: +++ OK, passed 500 tests.
interchange: +++ OK, passed 500 tests.
functor: +++ OK, passed 500 tests.
The key insight to get here is that QuickCheck is, fundamentally, a tool for finding counterexamples to properties. QuickCheck generally cannot prove that a property holds for all possible inputs, because the domain may be infinite. That's the reason why there's an EqProp class in checkers ("Types of values that can be tested for equality, perhaps through random sampling")—so that we may implement techniques for searching for counterexamples for types and tests that don't admit of simple equality comparisons.