summaryrefslogtreecommitdiff
path: root/src/Card.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Card.hs')
-rw-r--r--src/Card.hs61
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')