summaryrefslogtreecommitdiff
path: root/src/Card.hs
blob: c674b5d23653fecf0f26af92978ffbee0f6f45c1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
module Card where

import qualified Data.List as L
import System.Random (RandomGen, random)

data Suit = Spade | Heart | Diamond | Club deriving (Show, Eq, Ord, Enum)
data Rank = Two | Three | Four | Five | Six | Seven | Eight
          | Nine | Ten | Jack | Queen | King | Ace
          deriving (Show, Eq, Ord, Enum)
data Card = Card { suit :: Suit, rank :: Rank } deriving (Show, Eq, Ord)

-- | Pretty print a card.
showCard :: Card -> String
showCard (Card st rk) = (show st) ++ " " ++ (rkStr)
    where rkStr = case rk of
                    Jack  -> "J"
                    Queen -> "Q"
                    King  -> "K"
                    Ace   -> "A"
                    _     -> show $ fromEnum rk + 2

-- | Pretty print a list of cards.
showCards :: [Card] -> String
showCards = L.intercalate ", " . map showCard

-- | Produce one full 52-deck.
fullDeck = [Card st rk | st <- allSuits, rk <- allRanks]
    where allSuits = enumFrom $ toEnum 0
          allRanks = enumFrom $ toEnum 0

-- | Produce n full 52-decks.
fullDecks :: Int -> [Card]
fullDecks n = concat $ replicate n fullDeck

-- | Shuffle a list. Works by taking a random entry each time.
shuffle :: (RandomGen g) => g -> [a] -> [a]
shuffle _ [] = []
shuffle _ [x] = [x]
shuffle gen xs = (head right):(shuffle newGen (left ++ (tail right)))
    where (rand, newGen) = random gen
          i = rand `mod` (length xs)
          (left, right) = splitAt i xs

-- | Check if card is special.
isSpecial :: Card -> Bool
isSpecial (Card _ rk)
  | rk `elem` [Two, Three, Seven, Jack, Queen] = True
  | otherwise = False

-- | Check if card attacks.
isAttack :: Card -> Bool
isAttack (Card _ rk)
  | rk `elem` [Two, Three] = True
  | otherwise = False

-- | Check if `card` is valid after `prev`.
-- | If `att > 1`, player is under attack and `card` must be special.
isValid :: Card -> Int -> Card -> Bool
isValid prev@(Card st' rk') att card@(Card st rk) =
    match && (att < 2 || isSpecial card)
        where match = (st == st') || (rk == rk')