How do I specify concrete implementations for a typeclass?

Question

I have the following simple Haskell module which defines a typeclass Queue on which the operations push, pop and top must be defined, as well as a constructor for the empty queue and a function that checks if the queue is empty. It then provides two implementations: a first-in-first-out queue and a stack.

The code works. However, it seems as though I'm repeating myself unnecessarily. In particular, the only operations that differs between the queue and the stack is the push operation (do we push new objects onto the front or the back of the list?). It seems as though there should be some way to define the common operations in the typeclass definition. Is that, in fact, possible?

module Queue (
    Queue,
    FifoQueue(FifoQueue),
    Stack(Stack),
    empty,
    isEmpty,
    push,
    pop,
    top
) where

class Queue q where
    empty :: q a
    isEmpty :: q a -> Bool
    push :: a -> q a -> q a
    pop :: q a -> (a, q a)
    top :: q a -> a

data Stack a = Stack [a] deriving (Show, Eq)

instance Queue Stack where
    empty = Stack []
    isEmpty (Stack xs) = null xs
    push x (Stack xs) = Stack (x:xs)
    pop (Stack xs) = (head xs, Stack (tail xs))
    top (Stack xs) = head xs

data FifoQueue a = FifoQueue [a] deriving (Show, Eq)

instance Queue FifoQueue where
    empty = FifoQueue []
    isEmpty (FifoQueue xs) = null xs
    push x (FifoQueue xs) = FifoQueue (xs ++ [x])
    pop (FifoQueue xs) = (head xs, FifoQueue (tail xs))
    top (FifoQueue xs) = head xs

Answer 1

It seems the "duplication" you are concerned about is the similarity in some of the implementation:

instance Queue Stack where
    empty = Stack []
    isEmpty (Stack xs) = null xs
    ...

instance Queue FifoQueue where
    empty = FifoQueue []
    isEmpty (FifoQueue xs) = null xs
    ...

But sadly, there just isn't a way to merge parts of these two instances. You could remove the typeclass, and simply have Stack and FifoQueue be two different constructors of the same type. From here, HaskellElephant's solutions mostly apply (substituting toList with lst).

data Queue a = Stack { lst :: [a] }
             | FifoQueue { lst :: [a] }
             deriving (Eq, Show)

-- "empty" obviously cannot be preserved as it was
-- you need to specify whether you want an empty Stack or empty FifoQueue
emptyS = Stack []
emptyQ = FifoQueue []

-- but some functions are the same either way
isEmpty = null . lst
top queue = head . lst

-- other functions behave *mostly* the same for both cases...
pop queue = (top queue, liftQ tail queue)

-- ...they just need a little helper to abstract over the slight difference
liftQ :: ([a] -> [b]) -> Queue a -> Queue b
liftQ f (Stack xs) = Stack (f xs)
liftQ f (FifoQueue xs) = FifoQueue (f xs)

-- then for functions where the implementation is completely different,
-- you just pattern match
push x (Stack xs) = Stack (x:xs)
push x (FifoQueue xs) = FifoQueue (xs ++ [x]) -- this is slow, by the way

The drawback to this, of course, is that instead of an open typeclass, your module now provides a closed ADT.

---

There is some middle ground, though. Sort of. Consider this alternate approach:

data QueueImpl q a = QueueImpl { _empty :: q a
                               , _isEmpty :: q a -> Bool
                               , _top :: q a -> a
                               , _pop :: q a -> (a, q a)
                               , _push :: a -> q a -> q a
                               }

-- partially applied constructor!
shared :: (a -> [a] -> [a]) -> QueueImpl [] a
shared = QueueImpl empty' isEmpty' top' pop'
  where empty' = []
        isEmpty' = null
        top' = head
        pop' (x:xs) = (x, xs)

stack :: QueueImpl [] a
stack = shared push'
  where push' = (:)

fifoQueue :: QueueImpl [] a
fifoQueue = shared push'
  where push' x = (++[x])

By turning the typeclass into a data type, we are able to partially apply the constructor, thus sharing implementations for most of the methods. The catch is that we don't have access to functions that are polymorphic in the same way as before. To access the methods we need to do top stack or top fifoQueue. This leads to some interesting changes in designing "polymorphic" functions: since we reified the typeclass, we need to pass in an implementation explicitly to any compound functions:

-- if you haven't figured out by now, "impl" is short for "implementation"
_push3 :: QueueImpl [] a -> a -> [a] -> [a]
_push3 impl x = push x . push x . push x
  where push = _push impl

-- _push3 as implemented by a stack:
sPush3 :: a -> [a] -> [a]
sPush3 = _push3 stack

Note that we lose out on some type safety here; the representation of both a Stack and FifoQueue is exposed as a raw list. There might be some newtype hackery that could make this a little safer. The takeaway message is this: each approach has its own advantages and drawbacks. Typeclasses are a Pretty Good Idea, but don't confuse them for a Silver Bullet; be aware of other options, such as these.

Answer 2

Well, there is just a small amount of duplication, but lets get rid of it.

The key is that we can provide a defaults to Queue given that we know how to turn it into a list, furthermore provided with a queue we can make a list. Therefor we just add two functions to your definition, toList and fromList, and make sure that either giving toList and fromList, or giving the other functions, make a complete definition.

import Control.Arrow

class Queue q where
    empty :: q a
    empty = fromList []
    isEmpty :: q a -> Bool
    isEmpty = null . toList
    push :: a -> q a -> q a
    push a b = fromList (a : toList b)
    pop :: q a -> (a, q a)
    pop qs = (head . toList $ qs,fromList . tail . toList $ qs)
    top :: q a -> a
    top = head . toList
    toList :: q a -> [a]
    toList queue = if isEmpty queue then [] 
                   else uncurry (:) . second toList . pop $ queue
    fromList :: [a] -> q a
    fromList = foldr push empty

As you can see, any implementation of queue either has to provide toList and fromList or the other functions, and so the implementations of your two queues become the following:

data Stack a = Stack [a] deriving (Show, Eq)

instance Queue Stack where
    toList (Stack a) = a
    fromList a = Stack a

data FifoQueue a = FifoQueue [a] deriving (Show, Eq)

instance Queue FifoQueue where
    toList (FifoQueue a) = a
    fromList a = FifoQueue a
    push x (FifoQueue xs) = FifoQueue (xs ++ [x])

Answer 3

You can shave off the two implementations for top if you add a default implementations in the Queue type class:

top = fst . pop

but besides that, I don't think there's much to do here. There isn't a lot of duplication, anyway.