SO是一场狗屎秀。感谢您的搭车。
主要问题是您希望使用
view
中的排列而不是单个值。我们只有一种允许排列的类型 - 记录。
所以,我们可以添加新数据、记录类型
data B = F|T -- just shorter name for Bool in patterns
data Palette = P {isW, isU, isB, isR, isG :: B}
bool2b :: Bool -> B
bool2b True = T
bool2b False = F
viewColors :: Card -> Palette
viewColors (Card colors) = let m = bool2b . (`member` colors)
in P {isW = m W, isU = m U, isB = m B, isR = m R, isG = m G}
foo :: Card -> String
foo (viewColors -> P {isW=T, isB=T}) = "card is white and black"
foo _ = "whatever"
已更新
我们也可以否认错误的模式。但这个解决方案更丑陋,但它允许使用“经典”模式
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE RankNTypes #-}
data Color = W | U | B | R | G deriving (Eq)
data W'
data U'
data B'
data R'
data G'
data Color' a where
W' :: Color' W'
U' :: Color' U'
B' :: Color' B'
R' :: Color' R'
G' :: Color' G'
data M a = N | J a -- just shorter name for Maybe a in patterns
data Palette = Palette
(M (Color' W'))
(M (Color' U'))
(M (Color' B'))
(M (Color' R'))
(M (Color' G'))
并定义
viewColor
:
viewColors :: Card -> Palette
viewColors (Card colors) =
let
m :: Color -> Color' a -> M (Color' a)
m c e = if c `member` colors then J e else N
in P (m W W') (m U U') (m B B') (m R R') (m G G')
foo :: Card -> String
foo (viewColors -> Palette (J W') N (J B') N N) =
"card is white and black"
foo _ = "whatever"
我喜欢记录解决方案,但使用类型类很容易实现
{-# 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
编辑:进一步测试表明该解决方案实际上不起作用。
您实际上不需要更多的扩展,我想出了一个可以满足您想要的功能的解决方案,但您可能想要优化它,重命名一些东西,并使其不那么难看。你只需要创建一个新的数据类型并自己实现
Eq
并让操作员使用 infixr
:
{-# 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
-- you may need to fiddle with the precedence here
infixr 0 :*
data MyList a = END | a :* (MyList a) deriving (Show)
myFromList :: [a] -> MyList a
myFromList [] = END
myFromList (x:xs) = x :* myFromList xs
instance Eq a => Eq (MyList a) where
END == END = True
END == _ = False
_ == END = False
l1 == l2 = allElem l1 l2 && allElem l2 l1
where
-- optimize this, otherwise it'll just be really slow
-- I was just too lazy to write it correctly
elemMyList :: Eq a => a -> MyList a -> Bool
elemMyList a ml = case ml of
END -> False
(h :* rest) -> if a == h then True else elemMyList a rest
allElem :: Eq a => MyList a -> MyList a -> Bool
allElem END l = True
allElem (h :* rest) l = h `elemMyList` l && allElem rest l
viewColors :: Card -> MyList Color
viewColors (Card colors) = myFromList $ toList colors
fuz :: Card -> String
fuz (viewColors -> (W :* END)) = "it's white"
fuz (viewColors -> (W :* U :* END)) = "it's white and blue"
fuz (viewColors -> (W :* B :* END)) = "it's white and black"
fuz (viewColors -> (W :* B :* R :* END)) = "it's white, black, and red"
fuz (viewColors -> (W :* U :* B :* R :* G :* END)) = "it's all colors"
fuz _ = "I don't know all my colors"
main = do
putStrLn $ fuz $ Card $ fromList [W, B]
putStrLn $ fuz $ Card $ fromList [B, W]
编辑:只是稍微修复了代码
我认为你应该首先专注于准确表达卡片的颜色,然后再担心其他问题,例如稍后让事情变得简洁。在我看来,您的
Bool
元组解决方案几乎是完美的,但我猜测卡片必须有一种颜色,对吗?
在这种情况下,类似这样的东西可能会起作用,并且很容易进行模式匹配:
data CardColors = W' BlackBool GreenBool ...
| B' WhiteBool GreenBool ...
| G' BlackBool WhiteBool ...
....
data BlackBool = B
| NotB
-- etc.
您可以相当轻松地创建具有定义顺序的异构列表,但我认为这种多态性在这里不会为您服务。
(不是您问题的答案,但希望能解决您的问题!)
我会选择最愚蠢但可能有效的方法:
is :: Card -> Color -> Bool
is card col = col `elem` (viewColors card) -- can be optimized to use the proper elem!
然后
foo :: Card -> String
foo c
| c `is` B && c `is` W = "card is black and white"
| c `is` R || c `is` G = "card is red or green"
| otherwise = "whatever"
如果拼写出整个列表来检查卡片是否具有所有 5 种颜色太长,那么您可以定义额外的组合器,例如
hasColors :: Card -> [Color] -> Bool
hasColors card = all (`elem` (viewColors card))
有什么理由不可接受吗?