module PlayingCards.Deck(
card,
spades, hearts, clubs, diamonds,
ace, king, queen, jack, ten, nine, eight,
seven, six, five, four, three, two,
dealCard,
dealHands,
containsCard,
newDeck,
shuffleDeck,
cardsLeft) where
import Control.Monad
import Control.Monad.Random
import Data.List
import System.Random.Shuffle
import Test.QuickCheck
data Deck = Deck [Card]
deriving (Eq, Ord, Show)
type Hand = [Card]
data Card = Flat Rank Suit
deriving (Eq, Ord)
instance Show Card where
show (Flat r s) = show r ++ show s
card = Flat
data Suit = Spades
| Hearts
| Diamonds
| Clubs
deriving (Enum, Eq, Ord, Bounded)
instance Show Suit where
show Spades = "s"
show Hearts = "h"
show Diamonds = "d"
show Clubs = "c"
spades = Spades
hearts = Hearts
diamonds = Diamonds
clubs = Clubs
data Rank = Ace
| King
| Queen
| Jack
| Ten
| Nine
| Eight
| Seven
| Six
| Five
| Four
| Three
| Two
deriving (Enum, Eq, Ord, Bounded)
instance Show Rank where
show Ace = "A"
show King = "K"
show Queen = "Q"
show Jack = "J"
show Ten = "10"
show Nine = "9"
show Eight = "8"
show Seven = "7"
show Six = "6"
show Five = "5"
show Four = "4"
show Three = "3"
show Two = "2"
ace = Ace
king = King
queen = Queen
jack = Jack
ten = Ten
nine = Nine
eight = Eight
seven = Seven
six = Six
five = Five
four = Four
three = Three
two = Two
newDeckCards :: [Card]
newDeckCards = [Flat r s | r <- [minBound..maxBound], s <- [minBound..maxBound]]
newDeck :: Deck
newDeck = Deck newDeckCards
shuffleDeck :: (MonadRandom m) => Deck -> m Deck
shuffleDeck (Deck d) = liftM Deck (shuffleM d)
cardsLeft :: Deck -> Int
cardsLeft (Deck d) = length d
dealCard :: Deck -> (Card, Deck)
dealCard (Deck []) = error "Attempt to deal from empty deck"
dealCard (Deck (c:rest)) = (c, Deck rest)
dealHands :: Int -> Int -> Deck -> ([Hand], Deck)
dealHands numHands cardsPerHand (Deck d) = case notEnoughCards of
False -> (hands, remainingDeck)
True -> error "Not enough cards to deal"
where
totalCardsInHands = numHands * cardsPerHand
totalCards = cardsLeft (Deck d)
notEnoughCards = (numHands > totalCards && cardsPerHand > 0) ||
(cardsPerHand > totalCards && numHands > 0) ||
totalCardsInHands > totalCards
handCardsAndLeftovers = splitAt totalCardsInHands d
remainingDeck = Deck $ snd handCardsAndLeftovers
handCards = fst handCardsAndLeftovers
hands = map (take cardsPerHand) $ take numHands $ iterate (drop cardsPerHand) handCards
containsCard :: Card -> Deck -> Bool
containsCard c (Deck d) = elem c d
instance Arbitrary Suit where
arbitrary = elements [Spades, Hearts, Clubs, Diamonds]
instance Arbitrary Rank where
arbitrary =
elements [Ace, King, Queen, Jack, Ten, Nine, Eight, Seven, Six, Five, Four, Three, Two]
instance Arbitrary Card where
arbitrary = do
suit <- arbitrary
rank <- arbitrary
return $ Flat suit rank
instance Arbitrary Deck where
arbitrary = do
cardsToRemove <- arbitrary
return $ Deck (newDeckCards \\ cardsToRemove)