Package into cabal projectHEADmain

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