如何为类型类指定具体实现？

Question

我有以下简单的Haskell模块,其限定了类型类Queue在其上的操作push,pop并且top必须被定义,以及作为空队列一个构造函数和来检查,如果队列为空的函数.然后它提供两种实现:先进先出队列和堆栈.

代码有效.然而,似乎我不必要地重复自己.特别是,队列和堆栈之间唯一不同的push操作是操作(我们将新对象推送到列表的前面还是后面？).似乎应该有一些方法来定义类型类定义中的常见操作.事实上,这可能吗？

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

嗯,只有少量的重复,但让我们摆脱它.

关键是我们可以提供默认值,Queue因为我们知道如何将其转换为列表,还提供了一个队列,我们​​可以列出一个列表.为此,我们只需添加两个函数的定义,toList并fromList,并确保无论是给予toList和fromList,或提供其他功能,做一个完整的定义.

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

如您所见,队列的任何实现都必须提供toList和/ fromList或其他功能,因此两个队列的实现变为:

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])