强制模式顺序

Question

我正在Haskell写一个Magic The Gathering(MTG)游戏引擎.

对于那些不熟悉MTG的人来说,它是一种纸牌游戏,其中卡片最多可以有5种颜色:白色(W),蓝色(U),黑色(B),红色(R)和绿色(G).

{-# LANGUAGE ViewPatterns #-}
import Data.Set

data Color = W | U | B | R | G
    deriving (Show, Eq, Ord)

data Card = Card (Set Color) -- simplified Card type with only its colors

viewColors :: Card -> [Color]
viewColors (Card colors) = toList colors

---

我想做的是像这样的颜色模式匹配:

foo :: Card -> String
foo (viewColors -> [W, B]) = "card is white and black"
foo _ = "whatever"

到现在为止还挺好.但这里有一个问题:我可以在视图模式中错误地键入颜色顺序,如下所示:

bar :: Card -> String
bar (viewColors -> [B, W]) = "this will never get hit"
bar _ = "whatever"

当然,我可以用viewColors直接解决这个问题的方式编写.或者我可以使用警卫,但我宁愿不.这有几种方法可以做到这一点

viewColors :: Card -> (Bool, Bool, Bool, Bool, Bool)
viewColors (Card colors) = let m = (`member` colors)
    in (m W, m U, m B, m R, m G)

这种解决方案在模式匹配时过于冗长,即使我使用的是同构类型,Bool但标识符较短(和/或有意义).匹配绿卡看起来像

baz :: Card -> String
baz (viewColors -> (False, False, False, False, True)) = "it's green"

---

data ColorView = W | WU | WUB | ... all combos here

viewColors :: Card -> ColorView
viewColors (Card colors) = extract correct Colorview from colors

该解决方案具有组合爆炸.看起来非常糟糕,但很好用,特别是如果我colorViewToList :: ColorView -> [Color]在模式匹配后允许编程提取.

---

我不知道以下是否可以在Haskell中近似,但以下是理想的:

fuz :: Card -> String
fuz (viewColors -> (W :* ())) = "it's white"
fuz (viewColors -> (W :* U :* ())) = "it's white and blue"
fuz (viewColors -> (W :* B :* ())) = "it's white and black"

---

我愿意使用高级语言扩展来允许这种代码:DataKinds,PolyKinds,TypeFamilies,MultiParamTypeClasses,GADT,你可以命名它.

这样的事情可能吗？你有其他建议的方法吗？

Answer 1

我喜欢记录解决方案，但使用类型类很容易做到

{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.Set as Set

data Color = W' | U' | B' | R' | G' deriving (Show, Eq, Ord)
data Card = Card (Set.Set Color) 

newtype W a = W a
newtype U a = U a
newtype B a = B a
newtype R a = R a
newtype G a = G a

class ToColors x where
  toColors :: x -> [Color]
  reify :: x

instance ToColors () where
  toColors _ = []
  reify = ()

instance ToColors a => ToColors (W a) where
  toColors (W a) = W':toColors a
  reify = W reify

--other instances

members :: Set.Set Color -> [Color] -> Bool
members s = foldl (\b e -> b && (Set.member e s)) True

viewColors :: forall a. ToColors a => Card -> Maybe a
viewColors (Card s) = let a = reify :: a in 
  if members s (toColors a) then (Just a) else Nothing

foo :: Card -> String
foo (viewColors -> Just (W (B ()))) = "card is white and black"
foo _ = "whatever"

这可以很容易地被修改以获得其他语法。例如，您可以将颜色定义为不带参数的类型，然后使用中缀异构列表构造函数。无论哪种方式，它都不关心顺序。

编辑：如果你想匹配精确的集合，这也很容易——只需members像这样替换函数

viewColors :: forall a. ToColors a => Card -> Maybe a
viewColors (Card s) = let a = reify :: a in 
  if s == (Set.fromList . toColors $ a) then (Just a) else Nothing