Unit testing several implementations of a functional data structure without code duplication

Question

As part of an assignment on functional data types, we're asked to give different implementations of queues in Haskell, two of which are given below.

Coming from an OO world, the first reflex is to let them implement a common interface such that they can e.g. share test code. From what we read up on Haskell, this translates into two data types that are instances of a common typeclass. This part was fairly straight-forward:

data SimpleQueue a = SimpleQueue [a]
data FancyQueue a = FancyQueue ([a], [a])

class Queue q where
  empty :: q a
  enqueue :: a -> q a -> q a
  dequeue :: q a -> (a, q a)

instance Queue SimpleQueue where
  empty = SimpleQueue []
  enqueue e (SimpleQueue xs) = SimpleQueue $ xs ++ [e]
  dequeue (SimpleQueue (x:xs)) = (x, SimpleQueue xs)

instance Queue FancyQueue where
  empty = FancyQueue ([], [])
  enqueue e (FancyQueue (h, t)) =
    if length h > length t
    then FancyQueue (h, e:t)
    else FancyQueue (h ++ reverse (e:t), [])
  dequeue (FancyQueue ((e:h), t)) =
    if length h > length t
    then (e, FancyQueue (h, t))
    else (e, FancyQueue (h ++ reverse t, []))

After enormous amounts of fiddling around, we arrived at the following, working way of writing a test case (using HUnit) that tests both implementations using the same function f:

f :: (Queue q, Num a) => q a -> (a, q a)
f = dequeue . enqueue 4

makeTest = let (a, _) = f (empty :: SimpleQueue Int)
               (b, _) = f (empty :: FancyQueue Int)
           in assertEqual "enqueue, then dequeue" a b

test1 = makeTest

main = runTestTT (TestCase test1)

As the code suggests, we are very interested in letting the function makeTest take the test-function as a parameter, such that we can use it for generating several test cases without having to duplicate the code that applies the function all over them:

makeTest t = let (a, _) = t (empty :: SimpleQueue Int)
                 (b, _) = t (empty :: FancyQueue Int)
             in assertEqual "enqueue, then dequeue" a b

test1 = makeTest f

main = runTestTT (TestCase test1)

This, however, fails to compile with the error

queue.hs:52:30:
    Couldn't match expected type `FancyQueue Int'
                with actual type `SimpleQueue Int'
    In the first argument of `t', namely `(empty :: SimpleQueue Int)'
    In the expression: t (empty :: SimpleQueue Int)
    In a pattern binding: (a, _) = t (empty :: SimpleQueue Int)

Our question is if there is some way to make this work: Is it possible to write a function for generating our unit tests; one that takes a function and applies it to both implementations in such a way that we avoid duplicating the code that apply the function? Also, an explanation of the error above would be very welcome.

EDIT

Based on the answers below, here is what we end up with:

{-# LANGUAGE RankNTypes #-}

import Test.HUnit

import Queue
import SimpleQueue
import FancyQueue

makeTest :: String -> (forall q a. (Num a, Queue q) => q a -> (a, q a)) -> Assertion
makeTest msg t = let (a, _) = t (empty :: SimpleQueue Int)
                     (b, _) = t (empty :: FancyQueue Int)
                 in assertEqual msg a b

test1 = makeTest "enqueue, then dequeue" $ dequeue . enqueue 4
test2 = makeTest "enqueue twice, then dequeue" $ dequeue . enqueue 9 . enqueue 4
test3 = makeTest "enqueue twice, then dequeue twice" $ dequeue . snd . dequeue . enqueue 9 . enqueue 4

tests = TestList $ map (\ test -> TestCase test) [test1, test2, test3]

main = runTestTT tests

I was wondering if the type annotation on makeTest is the correct way to write it? I tried fiddling around with it, but this is the only thing that I could get to work. It's just that I thought that the part (Num a, Queue q) => should always be before the type itself. But maybe that's just a convention? Or is it all different for higher-rank types? Anyway, is it possible to write the type that way?

Also, not that it matters here, but out of curiosity; do the use of this extension impact performance (significantly)?

Answer 1

Yes, you need a language extension called Rank2Types. It allows functions like this

makeTest :: (forall q a. (Num a, Queue q) => q a -> (a, q a)) -> Assertion
makeTest t = let (a, _) = t (empty :: SimpleQueue Int)
                 (b, _) = t (empty :: FancyQueue Int)
             in assertEqual "enqueue, then dequeue" a b

Now you're making sure that the function you receive is polymorphic so you can apply it to both a SimpleQueue and an FancyQueue.

Otherwise, Haskell is going to unify t's first argument with SimpleQueue and then become angry when you attempt it use it on a FancyQueue. In other words, by default Haskell makes function parameters monomorphic. To make them polymorphic though you will have to use an explicit signature, Haskell will not infer it.

To use this extension, you'll need to enable it with

{-# LANGUAGE RankNTypes #-}

at the top of your file. See here for a longer explanation on what this extension does and how it works.

Response to the edit

That's how it should correctly be typed. Haskell implicitly turns

foo :: Show a => a -> b -> c

into

foo :: forall a b c. Show a => a -> b -> c

With higher rank types, you're moving the forall into a lambda and the constraints move with it. You can't put the constraints all the way to the left because the relevant type variables aren't even in scope.

Answer 2

You are trying to use a function argument (namely t) at two different types. First at type SimpleQueue Int -> (Int, SimpleQueue Int) and then at FancyQueue Int -> (Int, FancyQueue Int). That is you really want the type of t to be polymorphic.

But by default in Haskell, function arguments are monomorphic. They may only be used at a single type. That type itself may be a type variable such as a, but within a single instance once you've picked what a is, that's the type it will always have.

The solution is to use the RankNTypes language extension and to give makeTest a rank-2 type:

{-# LANGUAGE RankNTypes #-}
module QueueTests where
...

makeTest :: (forall a q. (Num a, Queue q) => q a -> (a, q a)) -> Assertion
makeTest =  -- same as before