{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Card where import Data.List import System.Random (newStdGen) import Utils class Countable a b where count :: a -> b data Type = Seven | Eight | Nine | Queen | King | Ten | Ace | Jack deriving (Eq, Ord, Show, Enum) instance Countable Type Int where count Ace = 11 count Ten = 10 count King = 4 count Queen = 3 count Jack = 2 count _ = 0 data Colour = Diamonds | Hearts | Spades | Clubs deriving (Eq, Ord, Show, Enum, Read) data Card = Card Type Colour deriving (Eq, Show, Ord) getColour :: Card -> Colour getColour (Card _ c) = c getID :: Card -> Int getID (Card t _) = case t of Seven -> 0 Eight -> 0 Nine -> 0 Queen -> 2 King -> 4 Ten -> 8 Ace -> 16 Jack -> 32 instance Countable Card Int where count (Card t _) = count t instance Countable [Card] Int where count = sum . map count equals :: Colour -> Maybe Colour -> Bool equals col (Just x) = col == x equals col Nothing = True isTrump :: Colour -> Card -> Bool isTrump trumpCol (Card tp col) | tp == Jack = True | otherwise = col == trumpCol effectiveColour :: Colour -> Card -> Colour effectiveColour trumpCol card@(Card _ col) = if trump then trumpCol else col where trump = isTrump trumpCol card isAllowed :: Colour -> Maybe Colour -> [Card] -> Card -> Bool isAllowed trumpCol turnCol cs card = if col `equals` turnCol then True else not $ any (\ca -> effectiveColour trumpCol ca `equals` turnCol && ca /= card) cs where col = effectiveColour trumpCol card compareCards :: Colour -> Maybe Colour -> Card -> Card -> Ordering compareCards _ _ (Card Jack col1) (Card Jack col2) = compare col1 col2 compareCards trumpCol turnCol c1@(Card tp1 col1) c2@(Card tp2 col2) = case (trp1, trp2) of (True, True) -> compare tp1 tp2 (False, False) -> case compare (col1 `equals` turnCol) (col2 `equals` turnCol) of EQ -> compare tp1 tp2 v -> v _ -> compare trp1 trp2 where trp1 = isTrump trumpCol c1 trp2 = isTrump trumpCol c2 sortCards :: Colour -> Maybe Colour -> [Card] -> [Card] sortCards trumpCol turnCol cs = sortBy (compareCards trumpCol turnCol) cs highestCard :: Colour -> Maybe Colour -> [Card] -> Card highestCard trumpCol turnCol cs = maximumBy (compareCards trumpCol turnCol) cs shuffleCards :: IO [Card] shuffleCards = do gen <- newStdGen return $ shuffle gen allCards -- TESTING VARS c1 :: Card c1 = Card Jack Spades c2 :: Card c2 = Card Ace Diamonds c3 :: Card c3 = Card Queen Diamonds c4 :: Card c4 = Card Queen Hearts c5 :: Card c5 = Card Jack Clubs h1 :: [Card] h1 = [c1,c2,c3,c4,c5] allCards :: [Card] allCards = [ Card t c | t <- tps, c <- cols ] where tps = [Seven .. Jack] cols = [Diamonds .. Clubs]