How can I test functions polymorphic over Applicatives?

Question

I've just written a function (for Data.Sequence)

traverseWithIndex :: Applicative f => (Int -> a -> f b) -> Seq a -> f (Seq b)

which should obey

traverseWithIndex f = sequenceA . mapWithIndex f

Thankfully, this is a straightforward mechanical modification of the source of mapWithIndex, so I am quite confident it is correct. However, in more complex cases thorough testing would be required. I'm trying to write a QuickCheck property to test this simple one. Obviously, I can't try it out with every Applicative functor! When testing monoids, it makes good sense to test with the free monoid over (i.e., finite lists of) some type. So it seems sensible here to test with the free applicative functor over some functor. There are two difficulties:

1. How do I choose an appropriate base functor? I presumably want a nasty one that isn't applicative or traversable or anything, but such a thing seems likely hard to work with.

2. How do I compare the results? They'll have functions in them, so they have no Eq instance.

Answer 1

Here's a partial(?) solution. The main aspects we want to check are 1) obviously the same value is computed, and 2) the effects are performed in the same order. I think the following code is self-explanatory enough:

{-# LANGUAGE FlexibleInstances #-}
module Main where
import Control.Applicative
import Control.Applicative.Free
import Data.Foldable
import Data.Functor.Identity
import Test.QuickCheck
import Text.Show.Functions -- for Show instance for function types

data Fork a = F a | G a deriving (Eq, Show)

toIdentity :: Fork a -> Identity a
toIdentity (F a) = Identity a
toIdentity (G a) = Identity a

instance Functor Fork where
    fmap f (F a) = F (f a)
    fmap f (G a) = G (f a)

instance (Arbitrary a) => Arbitrary (Fork a) where
    arbitrary = elements [F,G] <*> arbitrary

instance (Arbitrary a) => Arbitrary (Ap Fork a) where
    arbitrary = oneof [Pure <$> arbitrary, 
                       Ap <$> (arbitrary :: Gen (Fork Int)) <*> arbitrary]

effectOrder :: Ap Fork a -> [Fork ()]
effectOrder (Pure _) = []
effectOrder (Ap x f) = fmap (const ()) x : effectOrder f

value :: Ap Fork a -> a
value = runIdentity . runAp toIdentity

checkApplicative :: (Eq a) => Ap Fork a -> Ap Fork a -> Bool
checkApplicative x y = effectOrder x == effectOrder y && value x == value y

succeedingExample = quickCheck (\f x -> checkApplicative 
    (traverse (f :: Int -> Ap Fork Int) (x :: [Int])) 
    (sequenceA (fmap f x)))

-- note reverse
failingExample = quickCheck (\f x -> checkApplicative 
    (traverse (f :: Int -> Ap Fork Int) (reverse x :: [Int])) 
    (sequenceA (fmap f x)))

-- instance just for example, could make a more informative one
instance Show (Ap Fork Int) where show _ = "<Ap>"

-- values match ...
betterSucceedingExample = quickCheck (\x -> 
    value (sequenceA (x :: [Ap Fork Int])) 
 == value (fmap reverse (sequenceA (reverse x))))

-- but effects don't.
betterFailingExample = quickCheck (\x -> checkApplicative 
    (sequenceA (x :: [Ap Fork Int])) 
    (fmap reverse (sequenceA (reverse x))))

The output looks like:

*Main Text.Show.Functions> succeedingExample             
+++ OK, passed 100 tests.                                
*Main Text.Show.Functions> failingExample                
*** Failed! Falsifiable (after 3 tests and 2 shrinks):   
<function>                                               
[0,1]               
*Main Text.Show.Functions> betterSucceedingExample
+++ OK, passed 100 tests.
*Main Text.Show.Functions> betterFailingExample
*** Failed! Falsifiable (after 10 tests and 1 shrink):
[<Ap>,<Ap>]