diff --git a/general-games.cabal b/general-games.cabal --- a/general-games.cabal +++ b/general-games.cabal @@ -1,5 +1,5 @@ name: general-games -version: 0.4.0 +version: 1.0.1 synopsis: Library supporting simulation of a number of games homepage: https://github.com/cgorski/general-games bug-reports: https://github.com/cgorski/general-games/issues diff --git a/src/Game/Game/Poker.hs b/src/Game/Game/Poker.hs --- a/src/Game/Game/Poker.hs +++ b/src/Game/Game/Poker.hs @@ -2,7 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiWayIf #-} -- | --- Module : Game.Implement.Card +-- Module : Game.Game.Poker -- Copyright : (c) 2017 Christopher A. Gorski -- License : MIT -- Maintainer : Christopher A. Gorski @@ -10,15 +10,22 @@ -- The Game.Game.Poker module provides operations for five card poker. module Game.Game.Poker ( - AceRank (..) - , PokerHand + -- * Poker Hand Types + PokerHand , PokerHandType(..) - + , AceRank (..) + , cardsOfPokerHand , typeOfPokerHand + + -- * Building Hands + , mkHand + + -- * Hand Type Existence Checks + , isHand + -- * Sets of Hand Types , allPossibleHands - , allRoyalFlush , allStraightFlush , allFourOfAKind @@ -29,30 +36,9 @@ , allTwoPair , allPair , allHighCard - - , isRoyalFlush - , isStraightFlush - , isFourOfAKind - , isFullHouse - , isFlush - , isStraight - , isThreeOfAKind - , isTwoPair - , isPair - , isHighCard - , mkHand - , mkRoyalFlush - , mkStraightFlush - , mkFourOfAKind - , mkFullHouse - , mkFlush - , mkStraight - , mkThreeOfAKind - , mkTwoPair - , mkPair - , mkHighCard + -- * Random Hands , randomHighCard , randomPair , randomTwoPair @@ -63,8 +49,31 @@ , randomFourOfAKind , randomStraightFlush , randomRoyalFlush + + -- * Additional Hand Building Functions + , mkHighCard + , mkPair + , mkTwoPair + , mkThreeOfAKind + , mkStraight + , mkFlush + , mkFullHouse + , mkFourOfAKind + , mkStraightFlush + , mkRoyalFlush - , mkConsecutiveRanks + -- * Additional Hand Type Existence Checks + , isHighCard + , isPair + , isTwoPair + , isThreeOfAKind + , isStraight + , isFlush + , isFullHouse + , isFourOfAKind + , isStraightFlush + , isRoyalFlush + ) @@ -76,32 +85,30 @@ import Game.Implement.Card import Game.Implement.Card.Standard import Game.Implement.Card.Standard.Poker -import Data.List (tails,nub,find) +import Data.List (nub,find) import Data.Maybe (isJust, fromJust, catMaybes) -import System.Random.Shuffle (shuffleM) -randomAceRank :: MonadRandom m => m AceRank -randomAceRank = - let - minB = minBound :: AceRank - maxB = maxBound :: AceRank in - do - (randomn :: Int) <- getRandomR(fromEnum minB, fromEnum maxB); - return $ toEnum randomn -orderOfAceRank :: AceRank -> Order -orderOfAceRank AceHigh = AceHighRankOrder -orderOfAceRank AceLow = AceLowRankOrder -- | --- Indicates if a poker hand uses the Ace as a high card or a low card. +-- Indicates if a poker hand uses the Ace as a high card or a low card. AceLow is only +-- used when an Ace is in a hand. Any hand without an Ace is considered AceHigh. -- -- >>> -data AceRank = AceHigh | AceLow deriving (Eq, Show, Enum, Bounded) +data AceRank = AceHigh | AceLow deriving (Eq, Show, Ord, Enum, Bounded) +-- | +-- Return the cards in a 'PokerHand' +cardsOfPokerHand :: PokerHand -> [PlayingCard] cardsOfPokerHand (PokerHand _ h) = h + +-- | +-- Return the 'PokerHandType' of a 'PokerHand' +typeOfPokerHand :: PokerHand -> PokerHandType typeOfPokerHand (PokerHand t _) = t +-- | +-- The type of a 'PokerHand'. data PokerHandType = HighCard | Pair @@ -115,8 +122,29 @@ | RoyalFlush deriving(Eq,Show) + +-- | +-- A poker hand. Constructors are hidden, so any hand encapsulated in this type +-- can be considered a valid hand. +-- +-- >>> deck <- evalRandIO $ shuffle $ (fullDeck :: [PlayingCard]) +-- >>> hand = draw1_ 5 deck +-- >>> hand +-- [Five of Diamonds,Jack of Spades,Queen of Spades,Queen of Diamonds,Jack of Hearts] +-- +-- >>> pokerhand = fromJust $ mkHand hand +-- >>> pokerhand +-- PokerHand TwoPair [Five of Diamonds,Jack of Spades,Queen of Spades,Queen of Diamonds,Jack of Hearts] +-- +-- >>> typeOfPokerHand pokerhand +-- TwoPair +-- +-- >>> cardsOfPokerHand pokerhand +-- [Five of Diamonds,Jack of Spades,Queen of Spades,Queen of Diamonds,Jack of Hearts] data PokerHand = PokerHand PokerHandType [PlayingCard] deriving(Eq,Show) +-- | +-- Return a random hand that is not any other hand, also known as "High Card" randomHighCard :: RandomGen g => Rand g PokerHand randomHighCard = let r = do @@ -124,11 +152,11 @@ return randHand in do - candidate <- r hand <- iterateUntil (\h -> isHighCard h) r return $ PokerHand HighCard hand - +-- | +-- Return a random hand that is a Pair randomPair :: RandomGen g => Rand g PokerHand randomPair = do @@ -148,6 +176,8 @@ shuffleset <- shuffle cardset return $ PokerHand Pair shuffleset +-- | +-- Return a random hand that is a Two Pair randomTwoPair :: RandomGen g => Rand g PokerHand randomTwoPair = do @@ -167,6 +197,8 @@ return $ PokerHand TwoPair shuffleset +-- | +-- Return a random hand that is a Three of a Kind randomThreeOfAKind :: RandomGen g => Rand g PokerHand randomThreeOfAKind = do @@ -182,7 +214,8 @@ shuffleset <- shuffle cardset return $ PokerHand ThreeOfAKind shuffleset - +-- | +-- Return a random hand that is a Straight randomStraight :: RandomGen g => Rand g PokerHand randomStraight = let @@ -203,6 +236,8 @@ shuffledHand <- shuffle hand return $ PokerHand (Straight aceRank) shuffledHand +-- | +-- Return a random hand that is a Flush randomFlush :: RandomGen g => Rand g PokerHand randomFlush = let @@ -218,6 +253,8 @@ hand <- iterateUntil (\h -> (not $ isRoyalFlush h) && (not $ isStraightFlush h)) l return $ PokerHand Flush hand +-- | +-- Return a random hand that is a Full House randomFullHouse :: RandomGen g => Rand g PokerHand randomFullHouse = do @@ -233,7 +270,9 @@ cardset <- zipWithM (\r s -> return(PlayingCard r s)) rankLst suitLst shuffleset <- shuffle cardset return $ PokerHand FullHouse shuffleset - + +-- | +-- Return a random hand that is a Four of a Kind randomFourOfAKind :: RandomGen g => Rand g PokerHand randomFourOfAKind = do @@ -246,6 +285,8 @@ shuffleSet <- shuffle mergedLst return $ PokerHand FourOfAKind $ shuffleSet +-- | +-- Return a random hand that is a Straight Flush randomStraightFlush :: RandomGen g => Rand g PokerHand randomStraightFlush = let @@ -266,6 +307,8 @@ shuffledHand <- shuffle hand return $ PokerHand (StraightFlush aceRank) shuffledHand +-- | +-- Return a random hand that is a Royal Flush randomRoyalFlush :: RandomGen g => Rand g PokerHand randomRoyalFlush = let @@ -273,13 +316,16 @@ mkRanklst = Ace : (map (\m -> toEnum m) [9..12]) mergelst r s = return(PlayingCard r s) in do - startRank :: Int <- getRandomR(0,9) randSuit <- randomSuit suitlst :: [Suit] <- return (replicate 5 randSuit) cardset <- zipWithM mergelst mkRanklst suitlst shuffledHand <- shuffle cardset return $ PokerHand RoyalFlush shuffledHand +-- | +-- Given a list of cards, find the best hand in the set. If the number +-- of cards is not equal to five, or there are duplicate cards, mkHand returns +-- Nothing. mkHand :: [PlayingCard] -> Maybe PokerHand mkHand hand = let checks = @@ -347,6 +393,10 @@ then True else False + +-- | +-- Verify that the best hand of a set of cards is a high card hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkHighCard :: [PlayingCard] -> Maybe PokerHand mkHighCard hand | isValidPokerHand hand = @@ -362,13 +412,43 @@ then Just (PokerHand HighCard hand) else Nothing | otherwise = Nothing - + +-- | +-- Return True if a hand matches a specific PokerHandType. False otherwise. +isHand :: PokerHandType -> [PlayingCard] -> Bool +isHand HighCard cards = if isHighCard cards then True else False +isHand Pair cards = if isPair cards then True else False +isHand TwoPair cards = if isTwoPair cards then True else False +isHand ThreeOfAKind cards = if isThreeOfAKind cards then True else False +isHand (Straight AceHigh) cards = + let f (Just (PokerHand (Straight AceHigh) _)) = True + f _ = False in f $ mkStraight cards +isHand (Straight AceLow) cards = + let f (Just (PokerHand (Straight AceLow) _)) = True + f _ = False in f $ mkStraight cards +isHand Flush cards = if isFlush cards then True else False +isHand FullHouse cards = if isFullHouse cards then True else False +isHand FourOfAKind cards = if isFourOfAKind cards then True else False +isHand (StraightFlush AceHigh) cards = + let f (Just (PokerHand (StraightFlush AceHigh) _)) = True + f _ = False in f $ mkStraightFlush cards +isHand (StraightFlush AceLow) cards = + let f (Just (PokerHand (StraightFlush AceLow) _)) = True + f _ = False in f $ mkStraightFlush cards +isHand RoyalFlush cards = if isRoyalFlush cards then True else False + +-- | +-- Verify that the best hand of a set of cards is a high card hand, +-- and if so, return True. Otherwise, return False. isHighCard :: [PlayingCard] -> Bool isHighCard hand | isJust $ mkHighCard hand = True | otherwise = False +-- | +-- Verify that the best hand of a set of cards is a pair hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkPair :: [PlayingCard] -> Maybe PokerHand mkPair hand | isValidPokerHand hand = @@ -378,11 +458,17 @@ else Nothing | otherwise = Nothing +-- | +-- Verify that the best hand of a set of cards is a pair hand, +-- and if so, return True. Otherwise, return False. isPair :: [PlayingCard] -> Bool isPair hand | isJust $ mkPair hand = True | otherwise = False +-- | +-- Verify that the best hand of a set of cards is a two pair, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkTwoPair :: [PlayingCard] -> Maybe PokerHand mkTwoPair hand | isValidPokerHand hand = @@ -392,12 +478,17 @@ else Nothing | otherwise = Nothing +-- | +-- Verify that the best hand of a set of cards is a two pair hand, +-- and if so, return True. Otherwise, return False. isTwoPair :: [PlayingCard] -> Bool isTwoPair hand | isJust $ mkTwoPair hand = True | otherwise = False - +-- | +-- Verify that the best hand of a set of cards is a three-of-a-kind hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkThreeOfAKind :: [PlayingCard] -> Maybe PokerHand mkThreeOfAKind hand | isValidPokerHand hand = @@ -407,6 +498,9 @@ else Nothing | otherwise = Nothing +-- | +-- Verify that the best hand of a set of cards is a three-of-a-kind hand, +-- and if so, return True. Otherwise, return False. isThreeOfAKind :: [PlayingCard] -> Bool isThreeOfAKind hand | isJust $ mkThreeOfAKind hand = True @@ -421,9 +515,10 @@ | consecLow h2 = Just (sortCardsBy AceLowRankOrder h2, AceLow) | otherwise = Nothing in f hand - - +-- | +-- Verify that the best hand of a set of cards is a straight hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkStraight :: [PlayingCard] -> Maybe PokerHand mkStraight hand | isValidPokerHand hand = @@ -436,11 +531,17 @@ else Nothing | otherwise = Nothing +-- | +-- Verify that the best hand of a set of cards is a straight hand, +-- and if so, return True. Otherwise, return False. isStraight :: [PlayingCard] -> Bool isStraight hand | isJust $ mkStraight hand = True | otherwise = False - + +-- | +-- Verify that the best hand of a set of cards is a flush hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkFlush :: [PlayingCard] -> Maybe PokerHand mkFlush hand | isValidPokerHand hand = @@ -451,11 +552,17 @@ else Nothing | otherwise = Nothing +-- | +-- Verify that the best hand of a set of cards is a flush hand, +-- and if so, return True. Otherwise, return False. isFlush :: [PlayingCard] -> Bool isFlush hand | isJust $ mkFlush hand = True | otherwise = False +-- | +-- Verify that the best hand of a set of cards is a full house hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkFullHouse :: [PlayingCard] -> Maybe PokerHand mkFullHouse hand | isValidPokerHand hand = @@ -465,11 +572,17 @@ else Nothing | otherwise = Nothing +-- | +-- Verify that the best hand of a set of cards is a full house hand, +-- and if so, return True. Otherwise, return False. isFullHouse :: [PlayingCard] -> Bool isFullHouse hand | isJust $ mkFullHouse hand = True | otherwise = False - + +-- | +-- Verify that the best hand of a set of cards is a four-of-a-kind hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkFourOfAKind :: [PlayingCard] -> Maybe PokerHand mkFourOfAKind hand | isValidPokerHand hand = @@ -478,11 +591,17 @@ else Nothing | otherwise = Nothing +-- | +-- Verify that the best hand of a set of cards is a four-of-a-kind hand, +-- and if so, return True. Otherwise, return False. isFourOfAKind :: [PlayingCard] -> Bool isFourOfAKind hand | isJust $ mkFourOfAKind hand = True | otherwise = False - + +-- | +-- Verify that the best hand of a set of cards is a straight flush hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkStraightFlush :: [PlayingCard] -> Maybe PokerHand mkStraightFlush hand | isValidPokerHand hand = @@ -491,15 +610,22 @@ if isConsecRanks && (isSameSuit hand) && (not $ isRoyalFlush hand) - then Just (PokerHand (Straight $ snd $ fromJust consecRanks) hand) + then Just (PokerHand (StraightFlush $ snd $ fromJust consecRanks) hand) else Nothing | otherwise = Nothing +-- | +-- Verify that the best hand of a set of cards is a straight flush hand, +-- and if so, return True. Otherwise, return False. isStraightFlush :: [PlayingCard] -> Bool isStraightFlush hand | isJust $ mkStraightFlush hand = True | otherwise = False + +-- | +-- Verify that the best hand of a set of cards is a royal flush hand, +-- and if so, return a 'PokerHand'. Otherwise, return Nothing. mkRoyalFlush :: [PlayingCard] -> Maybe PokerHand mkRoyalFlush hand | isValidPokerHand hand = @@ -515,7 +641,9 @@ else Nothing | otherwise = Nothing - +-- | +-- Verify that the best hand of a set of cards is a royal flush hand, +-- and if so, return True. Otherwise, return False. isRoyalFlush :: [PlayingCard] -> Bool isRoyalFlush hand | isJust $ mkRoyalFlush hand = True @@ -526,44 +654,79 @@ | ((length hand) == 5) && ((dedupe hand) == hand) = True | otherwise = False -choose :: Ord r => Int -> [r] -> [[r]] -choose 0 _ = [[]] -choose n lst = do - (x:xs) <- tails lst - rest <- choose (n-1) xs - return $ x : rest - +-- | +-- All possible hands of a full deck of playing cards allPossibleHands :: [[PlayingCard]] allPossibleHands = choose 5 fullDeck +-- | +-- All royal flushes in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allRoyalFlush :: [[PlayingCard]] allRoyalFlush = [x | x <- allPossibleHands, isRoyalFlush x] +-- | +-- All straight flushes in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allStraightFlush :: [[PlayingCard]] allStraightFlush = [x | x <- allPossibleHands, isStraightFlush x] +-- | +-- All four-of-a-kinds in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allFourOfAKind :: [[PlayingCard]] allFourOfAKind = [x | x <- allPossibleHands, isFourOfAKind x] +-- | +-- All full houses in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allFullHouse :: [[PlayingCard]] allFullHouse = [x | x <- allPossibleHands, isFullHouse x] +-- | +-- All flushes in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allFlush :: [[PlayingCard]] allFlush = [x | x <- allPossibleHands, isFlush x] +-- | +-- All straights in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allStraight :: [[PlayingCard]] allStraight = [x | x <- allPossibleHands, isStraight x] +-- | +-- All three-of-a-kind in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allThreeOfAKind :: [[PlayingCard]] allThreeOfAKind = [x | x <- allPossibleHands, isThreeOfAKind x] +-- | +-- All two pairs in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allTwoPair :: [[PlayingCard]] allTwoPair = [x | x <- allPossibleHands, isTwoPair x] +-- | +-- All pairs in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allPair :: [[PlayingCard]] allPair = [x | x <- allPossibleHands, isPair x] +-- | +-- All high card hands in a full deck of playing cards. +-- The current implementation traverses the entire list of allPossibleHands, +-- and is not efficient. allHighCard :: [[PlayingCard]] allHighCard = [x | x <- allPossibleHands, isHighCard x] diff --git a/src/Game/Implement/Card.hs b/src/Game/Implement/Card.hs --- a/src/Game/Implement/Card.hs +++ b/src/Game/Implement/Card.hs @@ -17,10 +17,8 @@ where import Control.Monad.Random -import Control.Monad.Loops import System.Random.Shuffle (shuffleM) -import Data.List (nub, maximumBy, minimumBy, sortBy, foldl1') -import Data.Maybe (fromJust) +import Data.List (nub, maximumBy, minimumBy, sortBy, foldl1', tails) -- | -- Represents a physical card with no order and no value. @@ -29,15 +27,70 @@ -- Game value functions are provided by other typeclasses. class (Enum c, Eq c, Ord c, Bounded c) => Card c where -- | - -- Return all cards in a list. Cards will appear at most once. Order is not guaranteed. + -- Return all combinations of size n of a deck of cards + choose :: Int -> [c] -> [[c]] + choose 0 _ = [[]] + choose n lst = do + (x:xs) <- tails lst + rest <- choose (n-1) xs + return $ x : rest + + -- | + -- Return a full deck of cards. Cards are unique. Order is not guaranteed. -- -- >>> fullDeck :: [PlayingCard] -- [Ace of Clubs,Two of Clubs,Three of Clubs,Four of Clubs,Five of Clubs,Six of Clubs,Seven of Clubs,Eight of Clubs,Nine of Clubs,Ten of Clubs,Jack of Clubs,Queen of Clubs,King of Clubs,Ace of Diamonds,Two of Diamonds,Three of Diamonds,Four of Diamonds,Five of Diamonds,Six of Diamonds,Seven of Diamonds,Eight of Diamonds,Nine of Diamonds,Ten of Diamonds,Jack of Diamonds,Queen of Diamonds,King of Diamonds,Ace of Hearts,Two of Hearts,Three of Hearts,Four of Hearts,Five of Hearts,Six of Hearts,Seven of Hearts,Eight of Hearts,Nine of Hearts,Ten of Hearts,Jack of Hearts,Queen of Hearts,King of Hearts,Ace of Spades,Two of Spades,Three of Spades,Four of Spades,Five of Spades,Six of Spades,Seven of Spades,Eight of Spades,Nine of Spades,Ten of Spades,Jack of Spades,Queen of Spades,King of Spades] fullDeck :: [c] + + -- | + -- Returns all unique cards in a list. All duplicates are removed. dedupe :: [c] -> [c] + + -- | + -- Draws cards from a deck, and groups them based on the list provided + -- in the first argument. Returns the grouped hands and the remaining deck. + -- Arguments that are negative or exceed bounds return Nothing. + -- + -- For instance, to simulate a three player Hold'em game, one might wish + -- to draw two cards for each player, and five cards for the community: + -- + -- >>> deck <- evalRandIO $ shuffle $ (fullDeck :: [PlayingCard]) + -- >>> draw [2,2,2,5] deck + -- Just ([[Ace of Spades,Jack of Spades],[Queen of Hearts,Seven of Clubs],[Jack of Diamonds,Six of Hearts],[Jack of Hearts,Five of Spades,Three of Spades,Two of Diamonds,Ace of Hearts]],[Four of Clubs,Six of Diamonds,Four of Diamonds,Eight of Spades,Six of Clubs,Seven of Spades,Three of Diamonds,Ten of Diamonds,Eight of Hearts,Nine of Diamonds,Three of Clubs,Six of Spades,King of Clubs,Nine of Clubs,Four of Spades,Five of Diamonds,Nine of Spades,Queen of Spades,Ace of Diamonds,Four of Hearts,Two of Clubs,Five of Clubs,Two of Hearts,King of Diamonds,Ten of Spades,Eight of Clubs,Seven of Hearts,Three of Hearts,Queen of Diamonds,Queen of Clubs,Ten of Clubs,King of Hearts,Eight of Diamonds,Jack of Clubs,Ten of Hearts,Seven of Diamonds,Two of Spades,Nine of Hearts,King of Spades,Ace of Clubs,Five of Hearts]) draw :: [Int] -> [c] -> Maybe ([[c]],[c]) + + + -- | + -- The same as 'draw', except draw only one hand of specified size. + -- + -- >>> deck <- evalRandIO $ shuffle $ (fullDeck :: [PlayingCard]) + -- >>> draw1 5 deck + -- Just ([Six of Clubs,Ace of Hearts,Nine of Hearts,Four of Hearts,Two of Diamonds],[King of Diamonds,Queen of Spades,Four of Spades,Seven of Hearts,Five of Hearts,Seven of Clubs,Three of Hearts,Ace of Spades,Three of Diamonds,Seven of Diamonds,Two of Clubs,Five of Spades,King of Hearts,Jack of Hearts,Queen of Hearts,Ten of Clubs,Five of Clubs,Eight of Spades,Ace of Clubs,King of Clubs,Five of Diamonds,Queen of Diamonds,Eight of Hearts,Four of Clubs,Three of Clubs,Jack of Clubs,Jack of Diamonds,Ten of Diamonds,Queen of Clubs,Eight of Diamonds,Six of Diamonds,Eight of Clubs,Three of Spades,Two of Hearts,Six of Spades,King of Spades,Ten of Hearts,Nine of Spades,Nine of Diamonds,Two of Spades,Ten of Spades,Nine of Clubs,Four of Diamonds,Ace of Diamonds,Six of Hearts,Seven of Spades,Jack of Spades]) + draw1 :: Int -> [c] -> Maybe ([c],[c]) + + -- | + -- The same as 'draw1', except throw away the deck. + -- + -- >>> deck <- evalRandIO $ shuffle $ (fullDeck :: [PlayingCard]) + -- >>> draw1_ 5 deck + -- Just [Five of Hearts,Ace of Diamonds,Ten of Hearts,Two of Spades,Six of Clubs] + draw1_ :: Int -> [c] -> Maybe [c] + + -- | + -- Shuffle a deck of cards. + -- + -- >>> deck <- evalRandIO $ shuffle $ (fullDeck :: [PlayingCard]) + -- >>> [Three of Clubs,Nine of Spades,Five of Clubs,Two of Hearts,Four of Spades,King of Hearts,Ten of Hearts,Two of Clubs,Ace of Hearts,Eight of Diamonds,Six of Diamonds,Seven of Diamonds,Jack of Spades,Three of Hearts,Three of Spades,Queen of Clubs,Ten of Diamonds,Six of Spades,Two of Diamonds,Nine of Clubs,Five of Diamonds,Five of Spades,Seven of Spades,Jack of Clubs,Six of Hearts,Jack of Diamonds,Four of Hearts,Ace of Spades,Nine of Diamonds,King of Clubs,Two of Spades,Four of Clubs,Eight of Hearts,Queen of Hearts,Ace of Clubs,Five of Hearts,Ten of Spades,Six of Clubs,Ten of Clubs,Four of Diamonds,Three of Diamonds,Seven of Hearts,King of Diamonds,Ace of Diamonds,Nine of Hearts,Queen of Spades,Seven of Clubs,Jack of Hearts,King of Spades,Eight of Spades,Queen of Diamonds,Eight of Clubs] shuffle :: RandomGen m => [c] -> Rand m [c] + + -- | + -- Return a random card. + -- + -- >>> card :: PlayingCard <- evalRandIO $ randomCard + -- >>> card + -- Four of Diamonds randomCard :: RandomGen m => Rand m c + fullDeck = [minBound .. maxBound] dedupe l = nub l shuffle deck = shuffleM deck @@ -62,12 +115,44 @@ newDeck = drop nToTake deckOutput in draw2 hst (newHand:handOutput, newDeck) in Just (draw2 handSizeLst ([],deck)) + + draw1 handSize deck = + let + f (Just ([h], d)) = Just (h,d) + f _ = Nothing + in + f $ draw [handSize] deck + + draw1_ handSize deck = + let + f (Just ([h], _)) = Just h + f _ = Nothing + in + f $ draw [handSize] deck + -- | -- Represents a playing card with a game value. For instance, -- a standard playing card with a type representing -- rank and suit. class (Card c) => ValuedCard c v where + -- | + -- Return a value associated with a card. + -- + -- >>> card = PlayingCard Six Clubs + -- >>> toValue card :: Rank + -- Six + -- >>> toValue card :: Suit + -- Clubs toValue :: c -> v + + -- | + -- Return values associated with multiple cards. + -- + -- >>> cards = [PlayingCard Six Clubs, PlayingCard Four Diamonds] + -- >>> toValueLst cards :: [Rank] + -- [Six,Four] + -- >>> toValueLst cards :: [Suit] + -- [Clubs,Diamonds] toValueLst :: [c] -> [v] toValueLst l = map toValue l @@ -82,7 +167,6 @@ highestCardBy o cl = maximumBy (compareCardBy o) cl lowestCardBy o cl = minimumBy (compareCardBy o) cl sortCardsBy o cl = sortBy (compareCardBy o) cl - class (OrderedCard c o) => OrderedValuedCard c o vt where -- | diff --git a/src/Game/Implement/Card/Standard.hs b/src/Game/Implement/Card/Standard.hs --- a/src/Game/Implement/Card/Standard.hs +++ b/src/Game/Implement/Card/Standard.hs @@ -1,14 +1,41 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Module : Game.Implement.Card.Standard +-- Copyright : (c) 2017 Christopher A. Gorski +-- License : MIT +-- Maintainer : Christopher A. Gorski +-- +-- The Game.Game.Poker module defines structures and operations for +-- a standard set of 52 playing cards. module Game.Implement.Card.Standard + ( + PlayingCard(..) + , Rank(..) + , Suit(..) + , randomRank + , randomRankR + , randomSuit + , randomSuitR + , ranks + , nRanks + , toRank + , toRankLst + , suits + , nSuits + , toSuit + , uniqueNumList + , uniqueNumLists + ) where import Control.Monad.Random import Game.Implement.Card import System.Random.Shuffle(shuffleM) - +-- | +-- The rank of a standard playing card. data Rank = Ace | Two | @@ -26,30 +53,37 @@ deriving (Show, Enum, Eq, Ord, Bounded) +-- | +-- Returns a random standard playing card rank, with Ace low. randomRank :: RandomGen m => Rand m Rank randomRank = let - min = minBound :: Rank - max = maxBound :: Rank in + minS = minBound :: Rank + maxS = maxBound :: Rank in do - (randomn :: Int) <- getRandomR(fromEnum min, fromEnum max); + (randomn :: Int) <- getRandomR(fromEnum minS, fromEnum maxS); return $ toEnum randomn +-- | +-- Returns a random standard playing card from a range, with Ace low. randomRankR :: RandomGen m => Rank -> Rank -> Rand m Rank randomRankR l u = - let - min = l :: Rank - max = u :: Rank in - do - (randomn :: Int) <- getRandomR(fromEnum l, fromEnum u); - return $ toEnum randomn + do + (randomn :: Int) <- getRandomR(fromEnum l, fromEnum u); + return $ toEnum randomn +-- | +-- Returns all standard playing card ranks, with Ace low. ranks :: [Rank] ranks = [minBound .. maxBound] +-- | +-- Returns the number of unique standard playing card ranksu. nRanks :: Int nRanks = length ranks +-- | +-- The suit of a standard playing card. data Suit = Clubs | Diamonds | @@ -57,25 +91,27 @@ Spades deriving (Show, Enum, Eq, Ord, Bounded) +-- | +-- Returns a random Suit. randomSuit :: RandomGen m => Rand m Suit randomSuit = let - min = minBound :: Suit - max = maxBound :: Suit in + minS = minBound :: Suit + maxS = maxBound :: Suit in do - (randomn :: Int) <- getRandomR(fromEnum min, fromEnum max); + (randomn :: Int) <- getRandomR(fromEnum minS, fromEnum maxS); return $ toEnum randomn +-- | +-- Returns a random suit in a given range. randomSuitR :: RandomGen m => Suit -> Suit -> Rand m Suit randomSuitR l u = - let - min = l :: Suit - max = u :: Suit in - do - (randomn :: Int) <- getRandomR(fromEnum l, fromEnum u); - return $ toEnum randomn - + do + (randomn :: Int) <- getRandomR(fromEnum l, fromEnum u); + return $ toEnum randomn +-- | +-- Return a list of unique numbers of length n, within range r and s. uniqueNumList :: RandomGen g => Int -> Int -> Int -> Rand g (Maybe [Int]) uniqueNumList numToReturn n m = if (numToReturn > ((m-n)+1)) || (numToReturn < 0) @@ -98,15 +134,24 @@ return $ Just $ f deck numToReturn [] +-- | +-- Returns all standard card suits. suits :: [Suit] suits = [minBound .. maxBound] +-- | +-- Returns the number of all standard card unique suits. nSuits :: Int nSuits = length suits instance Card PlayingCard where +-- | +-- A representation of a standard playing card, distinguishable by rank and suit. data PlayingCard = PlayingCard Rank Suit deriving (Eq, Ord, Bounded) + +-- | +-- A type used to indicate if referring to the rank value of a card, or the suit value. data Value = RankValue | SuitValue deriving (Eq) instance Enum PlayingCard where @@ -124,15 +169,21 @@ instance ValuedCard PlayingCard Rank where toValue (PlayingCard r _) = r +-- | +-- Returns the 'Rank' of a 'PlayingCard' toRank :: PlayingCard -> Rank toRank c = toValue c +-- | +-- Returns a list of 'Rank' of a list of 'PlayingCard' toRankLst :: [PlayingCard] -> [Rank] toRankLst l = toValueLst l instance ValuedCard PlayingCard Suit where toValue (PlayingCard _ s) = s +-- | +-- Returns the 'Suit' of a 'PlayingCard' toSuit :: PlayingCard -> Suit toSuit (PlayingCard _ s) = s diff --git a/src/Game/Implement/Card/Standard/Poker.hs b/src/Game/Implement/Card/Standard/Poker.hs --- a/src/Game/Implement/Card/Standard/Poker.hs +++ b/src/Game/Implement/Card/Standard/Poker.hs @@ -1,12 +1,33 @@ {-# LANGUAGE MultiParamTypeClasses #-} +-- | +-- Module : Game.Implement.Card.Standard.Poker +-- Copyright : (c) 2017 Christopher A. Gorski +-- License : MIT +-- Maintainer : Christopher A. Gorski +-- +-- The Game.Implement.Card.Standard.Poker module defines data types and type class instances +-- for ordered operations on PlayingCard cards. module Game.Implement.Card.Standard.Poker + ( + Order(..), + ValueType(..), + + ) where import Game.Implement.Card import Game.Implement.Card.Standard +-- | +-- 'Order' defines an order to use when sorting a card. 'AceHighRankOrder' sorts under the +-- assumption that an Ace is a high card, and 'AceLowRankOrder' under the assumption that an +-- Ace is a low card. 'SuitOrder' sorts cards by suit, irrespective of their rank. data Order = AceHighRankOrder | AceLowRankOrder | SuitOrder deriving (Eq) + +-- | +-- 'ValueType' indicates the type Int value to be assigned to a card when the card +-- is evaluated by game value. data ValueType = RankValueType | SuitValueType instance OrderedCard PlayingCard Order where diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -203,6 +203,13 @@ it "returns unique cards" $ do isUnique (fullDeck :: [PlayingCard]) `shouldBe` True + describe "Game.Game.Poker.isHand" $ do + it "confirms that an Ace low straight flush exists" $ do + isHand (StraightFlush AceLow) [PlayingCard Ace Spades, PlayingCard Two Spades, PlayingCard Three Spades, PlayingCard Four Spades, PlayingCard Five Spades] `shouldBe` True + it "confirms that an Ace high straight flush is not Ace low" $ do + isHand (StraightFlush AceLow) [PlayingCard Six Spades, PlayingCard Two Spades, PlayingCard Three Spades, PlayingCard Four Spades, PlayingCard Five Spades] `shouldBe` False + it "confirms that an Ace high straight flush exists" $ do + isHand (StraightFlush AceHigh) [PlayingCard Six Spades, PlayingCard Two Spades, PlayingCard Three Spades, PlayingCard Four Spades, PlayingCard Five Spades] `shouldBe` True describe "Game.Implement.Card.Standard.Poker.isRoyalFlush" $ do it "confirms that [AH, QH, KH, JH, TH] is a Royal Flush" $ do @@ -289,7 +296,8 @@ it "returns 10000 different fullDeck shuffles using the global random generator" $ do (isUnique randdecks) `shouldBe` True - describe "Game.Implement.Card.Standard.Poker allPossibleHands / mkHand / isHand functions" $ do + + describe "Game.Game.Poker allPossibleHands / mkHand / isHand functions" $ do it "confirms that sets of each hand are disjoint and that total count correct" $ do confirmDisjoint `shouldBe` (allHandsCountExpected, True) it "confirms the total number of poker hands" $ do @@ -314,4 +322,6 @@ (length allPair) `shouldBe` allPairCountExpected it "confirms the total number of high card hands" $ do (length allHighCard) `shouldBe` allHighCardCountExpected + +