diff options
Diffstat (limited to 'src/Card.hs')
-rw-r--r-- | src/Card.hs | 61 |
1 files changed, 61 insertions, 0 deletions
diff --git a/src/Card.hs b/src/Card.hs new file mode 100644 index 0000000..c674b5d --- /dev/null +++ b/src/Card.hs @@ -0,0 +1,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') |