Принудительный заказ

Ответ 1

Мне нравится решение для записи, но это легко сделать с typeclasses

{-# 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"

это может быть легко переработано, чтобы получить другие синтаксисы. Например, вы можете определить цвета как типы, которые не принимают параметры, а затем использовать конструктор гетерогенных списков infix. В любом случае это не заботит порядок.

Изменить: если вы хотите точно совместить точные наборы - просто замените функцию 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

Ответ 2

Основная проблема заключается в том, что вы хотите иметь замену вместо одного значения из 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"

Ответ 3

EDIT. Дальнейшее тестирование показывает, что это решение на самом деле не работает.

На самом деле вам больше не нужны расширения, я придумал решение, которое делает то, что вы хотите, но вы, вероятно, захотите его оптимизировать, переименовать в некоторые вещи и сделать его немного менее уродливым. Вам просто нужно создать новый тип данных и реализовать 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 white"
fuz (viewColors -> (W :* U :* END)) = "it white and blue"
fuz (viewColors -> (W :* B :* END)) = "it white and black"
fuz (viewColors -> (W :* B :* R :* END)) = "it white, black, and red"
fuz (viewColors -> (W :* U :* B :* R :* G :* END)) = "it all colors"
fuz _ = "I don't know all my colors"

main = do
    putStrLn $ fuz $ Card $ fromList [W, B]
    putStrLn $ fuz $ Card $ fromList [B, W]

РЕДАКТИРОВАТЬ: только немного скорректированный код

Ответ 4

Я думаю, вам стоит сосредоточиться на том, чтобы точно выразить, какие цвета карт могут быть первыми, а затем беспокоиться о других проблемах, например, о том, как сделать вещи краткими позже. Мне кажется, что ваш кортеж Bool почти идеален, однако я предполагаю, что карта должна иметь один цвет, правильно?

В этом случае что-то вроде этого может работать, и будет довольно легко сопоставить шаблон:

data CardColors = W' BlackBool GreenBool ...
                | B' WhiteBool GreenBool ...
                | G' BlackBool WhiteBool ...
                ....

data BlackBool = B 
               | NotB
-- etc.

Вы можете создать гетерогенный список с определенным порядком довольно легко, но я не думаю, что этот полиморфизм послужит вам здесь.

Ответ 5

(Не ответ на ваш вопрос, но, надеюсь, решение вашей проблемы!)

Я бы пошел с самой тупой вещью, которая могла бы работать:

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

Есть ли причина, по которой это неприемлемо?