Haskell 如何为typeclass指定具体的实现？

我有以下简单的Haskell模块，它定义了一个typeclass

队列

，必须在该模块上定义操作

推

、

弹出

和

顶部

，还有一个空队列的构造函数和一个检查队列是否为空的函数。然后，它提供了两种实现：先进先出队列和堆栈

代码是有效的。然而，我似乎在不必要地重复我自己。特别是，队列和堆栈之间唯一不同的操作是

push

操作（我们是将新对象推到列表的前面还是后面？）。似乎应该有某种方法来定义typeclass定义中的公共操作。事实上，这是可能的吗

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

---

如果在

队列

类型类中添加默认实现，则可以删除

top

的两个实现：

top = fst . pop

---

但除此之外，我认为这里没什么可做的。不管怎么说，没有太多的重复。

嗯，只有少量的重复，但让我们把它去掉

关键是我们可以提供一个默认的

队列

，因为我们知道如何将其转换为列表，而且提供了一个队列，我们可以创建一个列表。因此，我们只需在您的定义中添加两个函数，

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

您关心的“重复”似乎是某些实现中的相似性：

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

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

但遗憾的是，没有办法合并这两个实例的一部分。您可以删除typeclass，只需让

Stack

和

FifoQueue

成为同一类型的两个不同构造函数。从这里开始，HaskellElephant的解决方案主要适用（用

lst

替换

toList

）

当然，这样做的缺点是，您的模块现在提供了一个封闭的ADT，而不是一个开放的typeclass

---

但也有一些中间立场。某种程度上。考虑这种替代方法：

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

通过将typeclass转换为数据类型，我们可以部分应用构造函数，从而共享大多数方法的实现。问题是我们不能像以前那样访问多态函数。要访问这些方法，我们需要执行

top-stack

或

top-fifoQueue

。这导致在设计“多态”函数时发生了一些有趣的变化：因为我们具体化了typeclass，所以我们需要将实现显式地传递给任何复合函数：

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

---

请注意，我们在这里失去了某些类型的安全性；堆栈和FifoQueue的表示都作为原始列表公开。也许有一些新型黑客可以让这更安全一点。其要点是：每种方法都有自己的优点和缺点。类型类是一个很好的主意，但不要把它们当成一颗银弹；请注意其他选项，例如这些。

顺便说一句，我不介意这种代码复制。这是您使用列表作为数据结构的产物，它实际上并不涉及案例之间的某种重要共享概念，这就保证了额外的耦合。我想知道为什么您要首先将堆栈称为队列。堆栈不是与后进先出队列相同吗？

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