general-games 0.3.0 → 0.4.0
raw patch · 5 files changed
+515/−42 lines, 5 filesdep +monad-loopsdep +randomPVP ok
version bump matches the API change (PVP)
Dependencies added: monad-loops, random
API changes (from Hackage documentation)
- Game.Game.Poker: PokerHand :: PokerHandType -> [PlayingCard] -> PokerHand
- Game.Game.Poker: PokerHandType :: RankKicker -> PokerHandSplit
- Game.Game.Poker: RankHand :: KickerHand -> RankKicker
- Game.Game.Poker: choose :: Ord r => Int -> [r] -> [[r]]
- Game.Game.Poker: data PokerHandSplit
- Game.Game.Poker: data RankKicker
- Game.Game.Poker: hasConsecutiveRanks :: Order -> [PlayingCard] -> Bool
- Game.Game.Poker: hasNOfRank :: Int -> [PlayingCard] -> Bool
- Game.Game.Poker: hasNumNOfRank :: Int -> Int -> [PlayingCard] -> Bool
- Game.Game.Poker: instance GHC.Classes.Eq Game.Game.Poker.PokerHandSplit
- Game.Game.Poker: instance GHC.Classes.Eq Game.Game.Poker.RankKicker
- Game.Game.Poker: instance GHC.Show.Show Game.Game.Poker.PokerHandSplit
- Game.Game.Poker: instance GHC.Show.Show Game.Game.Poker.RankKicker
- Game.Game.Poker: isPokerHandSize :: [PlayingCard] -> Bool
- Game.Game.Poker: isSameSuit :: [PlayingCard] -> Bool
- Game.Game.Poker: mkBestHand :: [PlayingCard] -> Maybe PokerHand
- Game.Game.Poker: nOfRank :: [PlayingCard] -> [(Rank, Int)]
- Game.Game.Poker: orderOfAceRank :: AceRank -> Order
- Game.Game.Poker: type KickerHand = [PlayingCard]
- Game.Game.Poker: type RankHand = [PlayingCard]
- Game.Implement.Card: class (Enum c, Eq c, Ord c, Bounded c) => Card c where fullDeck = [minBound .. maxBound] dedupe l = nub l shuffle deck = shuffleM deck draw handSizeLst deck | let total = (foldl1' (+) handSizeLst) anyNeg = (length (filter (\ n -> n < 0) handSizeLst)) > 0 in (total > (length deck)) || (total < 1) || anyNeg = Nothing | otherwise = let draw2 [] (houtput, doutput) = ((reverse houtput), doutput) draw2 (nToTake : hst) (handOutput, deckOutput) = let newHand = take nToTake deckOutput newDeck = drop nToTake deckOutput in draw2 hst (newHand : handOutput, newDeck) in Just (draw2 handSizeLst ([], deck))
+ Game.Game.Poker: cardsOfPokerHand :: PokerHand -> [PlayingCard]
+ Game.Game.Poker: instance GHC.Enum.Bounded Game.Game.Poker.AceRank
+ Game.Game.Poker: instance GHC.Enum.Enum Game.Game.Poker.AceRank
+ Game.Game.Poker: mkHand :: [PlayingCard] -> Maybe PokerHand
+ Game.Game.Poker: randomFlush :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomFourOfAKind :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomFullHouse :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomHighCard :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomPair :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomRoyalFlush :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomStraight :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomStraightFlush :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomThreeOfAKind :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: randomTwoPair :: RandomGen g => Rand g PokerHand
+ Game.Game.Poker: typeOfPokerHand :: PokerHand -> PokerHandType
+ Game.Implement.Card: class (Enum c, Eq c, Ord c, Bounded c) => Card c where fullDeck = [minBound .. maxBound] dedupe l = nub l shuffle deck = shuffleM deck randomCard = let minB = minBound :: (Bounded c, Card c) => c maxB = maxBound :: (Bounded c, Card c) => c in do { randomd <- getRandomR (fromEnum minB, fromEnum maxB); return $ toEnum randomd } draw handSizeLst deck | let total = (foldl1' (+) handSizeLst) anyNeg = (length (filter (\ n -> n < 0) handSizeLst)) > 0 in (total > (length deck)) || (total < 1) || anyNeg = Nothing | otherwise = let draw2 [] (houtput, doutput) = ((reverse houtput), doutput) draw2 (nToTake : hst) (handOutput, deckOutput) = let newHand = take nToTake deckOutput newDeck = drop nToTake deckOutput in draw2 hst (newHand : handOutput, newDeck) in Just (draw2 handSizeLst ([], deck))
+ Game.Implement.Card: randomCard :: (Card c, RandomGen m) => Rand m c
+ Game.Implement.Card.Standard: randomRank :: RandomGen m => Rand m Rank
+ Game.Implement.Card.Standard: randomRankR :: RandomGen m => Rank -> Rank -> Rand m Rank
+ Game.Implement.Card.Standard: randomSuit :: RandomGen m => Rand m Suit
+ Game.Implement.Card.Standard: randomSuitR :: RandomGen m => Suit -> Suit -> Rand m Suit
+ Game.Implement.Card.Standard: uniqueNumList :: RandomGen g => Int -> Int -> Int -> Rand g (Maybe [Int])
+ Game.Implement.Card.Standard: uniqueNumLists :: RandomGen g => [Int] -> Int -> Int -> Rand g (Maybe [[Int]])
- Game.Implement.Card: shuffle :: (Card c, MonadRandom m) => [c] -> m [c]
+ Game.Implement.Card: shuffle :: (Card c, RandomGen m) => [c] -> Rand m [c]
Files
- general-games.cabal +5/−2
- src/Game/Game/Poker.hs +279/−36
- src/Game/Implement/Card.hs +13/−1
- src/Game/Implement/Card/Standard.hs +67/−0
- test/Spec.hs +151/−3
general-games.cabal view
@@ -1,5 +1,5 @@ name: general-games-version: 0.3.0+version: 0.4.0 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@@ -31,6 +31,8 @@ build-depends: base >= 4.7 && < 5 , random-shuffle , MonadRandom+ , random+ , monad-loops default-language: Haskell2010 ghc-options: -Wall @@ -43,7 +45,8 @@ , HUnit , hspec , MonadRandom- ghc-options: -fhpc -Wall -threaded -rtsopts -with-rtsopts=-N+-- ghc-options: -fhpc -Wall -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 source-repository head
src/Game/Game/Poker.hs view
@@ -1,27 +1,107 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-}-+{-# LANGUAGE MultiWayIf #-}+-- |+-- Module : Game.Implement.Card+-- Copyright : (c) 2017 Christopher A. Gorski+-- License : MIT+-- Maintainer : Christopher A. Gorski <cgorski@cgorski.org>+--+-- The Game.Game.Poker module provides operations for five card poker. module Game.Game.Poker+ (+ AceRank (..)+ , PokerHand+ , PokerHandType(..)+ + , cardsOfPokerHand+ , typeOfPokerHand+ + , allPossibleHands++ , allRoyalFlush+ , allStraightFlush+ , allFourOfAKind+ , allFullHouse+ , allFlush+ , allStraight+ , allThreeOfAKind+ , allTwoPair+ , allPair+ , allHighCard+ + , isRoyalFlush+ , isStraightFlush+ , isFourOfAKind+ , isFullHouse+ , isFlush+ , isStraight+ , isThreeOfAKind+ , isTwoPair+ , isPair+ , isHighCard++ , mkHand+ , mkRoyalFlush+ , mkStraightFlush+ , mkFourOfAKind+ , mkFullHouse+ , mkFlush+ , mkStraight+ , mkThreeOfAKind+ , mkTwoPair+ , mkPair+ , mkHighCard++ , randomHighCard + , randomPair+ , randomTwoPair+ , randomThreeOfAKind+ , randomStraight+ , randomFlush+ , randomFullHouse+ , randomFourOfAKind+ , randomStraightFlush+ , randomRoyalFlush+ + , mkConsecutiveRanks+ )++ where ++import Control.Monad.Loops+import Control.Monad.Random import Game.Implement.Card import Game.Implement.Card.Standard import Game.Implement.Card.Standard.Poker- import Data.List (tails,nub,find) import Data.Maybe (isJust, fromJust, catMaybes)+import System.Random.Shuffle (shuffleM) -type RankHand = [PlayingCard] -type KickerHand = [PlayingCard]-data RankKicker = RankHand KickerHand deriving(Eq,Show)--data AceRank = AceHigh | AceLow deriving (Eq, Show)-+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.+--+-- >>>+data AceRank = AceHigh | AceLow deriving (Eq, Show, Enum, Bounded)++cardsOfPokerHand (PokerHand _ h) = h+typeOfPokerHand (PokerHand t _) = t+ data PokerHandType = HighCard | Pair @@ -35,23 +115,185 @@ | RoyalFlush deriving(Eq,Show) -data PokerHandSplit = PokerHandType RankKicker deriving(Eq,Show) data PokerHand = PokerHand PokerHandType [PlayingCard] deriving(Eq,Show) -mkBestHand :: [PlayingCard] -> Maybe PokerHand-mkBestHand hand =+randomHighCard :: RandomGen g => Rand g PokerHand+randomHighCard =+ let r = do+ randHand <- replicateM 5 randomCard+ return randHand + in+ do + candidate <- r+ hand <- iterateUntil (\h -> isHighCard h) r+ return $ PokerHand HighCard hand+ ++randomPair :: RandomGen g => Rand g PokerHand+randomPair =+ do+ numLstR <- uniqueNumList 4 0 12+ rank1pair <- return $ replicate 2 $ toEnum $ (fromJust numLstR) !! 0+ rank2 <- return $ toEnum $ (fromJust numLstR) !! 1+ rank3 <- return $ toEnum $ (fromJust numLstR) !! 2+ rank4 <- return $ toEnum $ (fromJust numLstR) !! 3+ rankLst <- return $ rank4:rank3:rank2:rank1pair+ numLstS1 <- uniqueNumList 2 0 3+ suitLst1 <- return $ map (\r -> toEnum r) $ fromJust numLstS1+ suit2 <- randomSuit+ suit3 <- randomSuit+ suit4 <- randomSuit+ suitLst <- return $ suit4:suit3:suit2:suitLst1+ cardset <- zipWithM (\r s -> return(PlayingCard r s)) rankLst suitLst+ shuffleset <- shuffle cardset+ return $ PokerHand Pair shuffleset++randomTwoPair :: RandomGen g => Rand g PokerHand+randomTwoPair =+ do+ numLstR <- uniqueNumList 3 0 12+ rank1 <- return $ replicate 2 $ toEnum $ (fromJust numLstR) !! 0+ rank2 <- return $ replicate 2 $ toEnum $ (fromJust numLstR) !! 1+ rank3 <- return $ toEnum $ (fromJust numLstR) !! 2+ rankLst :: [Rank] <- return $ rank3:(rank1 ++ rank2)+ numLstS1 <- uniqueNumList 2 0 3+ numLstS2 <- uniqueNumList 2 0 3+ numS3 <- randomSuit+ suitLst1 <- return $ map (\r -> toEnum r) $ fromJust numLstS1+ suitLst2 <- return $ map (\r -> toEnum r) $ fromJust numLstS2+ suitLst <- return $ numS3:(suitLst1 ++ suitLst2)+ cardset <- zipWithM (\r s -> return(PlayingCard r s)) rankLst suitLst+ shuffleset <- shuffle cardset+ return $ PokerHand TwoPair shuffleset+++randomThreeOfAKind :: RandomGen g => Rand g PokerHand+randomThreeOfAKind =+ do+ numLst <- uniqueNumList 3 0 12+ rank1 <- return $ replicate 3 $ toEnum $ (fromJust numLst) !! 0+ rank2 <- return $ map (\r -> toEnum r) $ drop 1 (fromJust numLst)+ rankLst :: [Rank] <- return $ rank1 ++ rank2+ numLstS1 <- uniqueNumList 3 0 3+ suitLst1 <- return $ map (\r -> toEnum r) $ fromJust numLstS1+ suitLst2 <- replicateM 2 randomSuit+ suitLst <- return $ suitLst1 ++ suitLst2+ cardset <- zipWithM (\r s -> return(PlayingCard r s)) rankLst suitLst+ shuffleset <- shuffle cardset+ return $ PokerHand ThreeOfAKind shuffleset+++randomStraight :: RandomGen g => Rand g PokerHand+randomStraight =+ let+ mkRanklst :: Int -> [Rank]+ mkRanklst n = map (\m -> toEnum ((m+n) `mod` 13) ) [0..4] + mergelst r s = return(PlayingCard r s)+ l = do+ startRank :: Int <- getRandomR(0,9)++ ranklst <- return (mkRanklst startRank)+ suitlst :: [Suit] <- replicateM 5 randomSuit+ cardset <- zipWithM mergelst ranklst suitlst+ return cardset+ in+ do+ hand <- iterateUntil (\h -> (not $ isStraightFlush h) && (not $ isRoyalFlush h)) l+ aceRank <- return (if (toRank $ hand !! 0) == Ace then AceLow else AceHigh)+ shuffledHand <- shuffle hand+ return $ PokerHand (Straight aceRank) shuffledHand++randomFlush :: RandomGen g => Rand g PokerHand+randomFlush =+ let+ l = do+ numLst <- uniqueNumList 5 0 12+ rankLst :: [Rank] <- return $ map (\n -> toEnum n) $ fromJust $ numLst+ randSuit <- randomSuit+ suitLst :: [Suit] <- return $ replicate 5 randSuit+ cardset <- zipWithM (\r s -> return(PlayingCard r s)) rankLst suitLst + return cardset+ in+ do+ hand <- iterateUntil (\h -> (not $ isRoyalFlush h) && (not $ isStraightFlush h)) l+ return $ PokerHand Flush hand++randomFullHouse :: RandomGen g => Rand g PokerHand+randomFullHouse =+ do+ numLstR <- uniqueNumList 2 0 12+ rank1 <- return $ toEnum $ (fromJust numLstR) !! 0+ rank2 <- return $ toEnum $ (fromJust numLstR) !! 1 + rankLst :: [Rank] <- return [rank1, rank1, rank1, rank2, rank2]+ numLstS1 <- uniqueNumList 3 0 3+ numLstS2 <- uniqueNumList 2 0 3+ suitLst1 <- return $ map (\r -> toEnum r) $ fromJust numLstS1+ suitLst2 <- return $ map (\r -> toEnum r) $ fromJust numLstS2+ suitLst <- return $ suitLst1 ++ suitLst2+ cardset <- zipWithM (\r s -> return(PlayingCard r s)) rankLst suitLst+ shuffleset <- shuffle cardset+ return $ PokerHand FullHouse shuffleset+ +randomFourOfAKind :: RandomGen g => Rand g PokerHand+randomFourOfAKind =+ do+ randRank4 <- randomRank+ randRank <- iterateUntil (\r -> r /= randRank4) randomRank+ randRanks <- return $ randRank:(replicate 4 randRank4)+ randSuit <- randomSuit+ randSuits <- return [randSuit, Clubs, Diamonds, Hearts, Spades]+ mergedLst <- zipWithM (\r s -> return(PlayingCard r s)) randRanks randSuits+ shuffleSet <- shuffle mergedLst+ return $ PokerHand FourOfAKind $ shuffleSet++randomStraightFlush :: RandomGen g => Rand g PokerHand+randomStraightFlush =+ let+ mkRanklst :: Int -> [Rank]+ mkRanklst n = map (\m -> toEnum ((m+n) `mod` 13) ) [0..4] + mergelst r s = return(PlayingCard r s)+ l = do + startRank :: Int <- getRandomR(0,9)+ ranklst <- return (mkRanklst startRank)+ randSuit <- randomSuit+ suitlst :: [Suit] <- return (replicate 5 randSuit)+ cardset <- zipWithM mergelst ranklst suitlst+ return cardset + in+ do+ hand <- iterateUntil (\h -> (not $ isRoyalFlush h)) l+ aceRank <- return (if (toRank $ hand !! 0) == Ace then AceLow else AceHigh)+ shuffledHand <- shuffle hand+ return $ PokerHand (StraightFlush aceRank) shuffledHand++randomRoyalFlush :: RandomGen g => Rand g PokerHand+randomRoyalFlush =+ let+ mkRanklst :: [Rank]+ 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++mkHand :: [PlayingCard] -> Maybe PokerHand+mkHand hand = let checks =- [mkHighCard hand- ,mkPair hand- ,mkTwoPair hand- ,mkThreeOfAKind hand- ,mkStraight hand- ,mkFlush hand- ,mkFullHouse hand- ,mkFourOfAKind hand- ,mkStraightFlush hand- ,mkRoyalFlush hand]- cat = catMaybes checks+ [mkHighCard+ ,mkPair+ ,mkTwoPair+ ,mkThreeOfAKind+ ,mkStraight+ ,mkFlush+ ,mkFullHouse+ ,mkFourOfAKind+ ,mkStraightFlush+ ,mkRoyalFlush]+ cat = catMaybes $ map (\f -> f hand) checks in if length cat == 0 then Nothing@@ -107,7 +349,7 @@ mkHighCard :: [PlayingCard] -> Maybe PokerHand mkHighCard hand- | isPokerHandSize hand =+ | isValidPokerHand hand = if (not $ isPair hand) && (not $ isTwoPair hand) && (not $ isThreeOfAKind hand)@@ -129,7 +371,7 @@ mkPair :: [PlayingCard] -> Maybe PokerHand mkPair hand- | isPokerHandSize hand =+ | isValidPokerHand hand = if (hasNumNOfRank 2 1 hand) && (not $ isFullHouse hand) then Just (PokerHand Pair hand)@@ -143,7 +385,7 @@ mkTwoPair :: [PlayingCard] -> Maybe PokerHand mkTwoPair hand- | isPokerHandSize hand =+ | isValidPokerHand hand = if (hasNumNOfRank 2 2 hand) && (not $ isFullHouse hand) then Just (PokerHand TwoPair hand)@@ -158,7 +400,7 @@ mkThreeOfAKind :: [PlayingCard] -> Maybe PokerHand mkThreeOfAKind hand- | isPokerHandSize hand =+ | isValidPokerHand hand = if (hasNOfRank 3 hand) && (not $ isFullHouse hand) then Just (PokerHand ThreeOfAKind hand)@@ -184,7 +426,7 @@ mkStraight :: [PlayingCard] -> Maybe PokerHand mkStraight hand- | isPokerHandSize hand =+ | isValidPokerHand hand = let consecRanks = mkConsecutiveRanks hand isConsecRanks = isJust consecRanks in if isConsecRanks@@ -201,7 +443,7 @@ mkFlush :: [PlayingCard] -> Maybe PokerHand mkFlush hand- | isPokerHandSize hand =+ | isValidPokerHand hand = if (isSameSuit hand) && (not $ isRoyalFlush hand) && (not $ isStraightFlush hand) @@ -216,7 +458,7 @@ mkFullHouse :: [PlayingCard] -> Maybe PokerHand mkFullHouse hand- | isPokerHandSize hand =+ | isValidPokerHand hand = if (hasNOfRank 3 hand) && (hasNOfRank 2 hand) then Just (PokerHand FullHouse hand)@@ -230,7 +472,7 @@ mkFourOfAKind :: [PlayingCard] -> Maybe PokerHand mkFourOfAKind hand- | isPokerHandSize hand = + | isValidPokerHand hand = if (hasNOfRank 4 hand) then Just (PokerHand FourOfAKind hand) else Nothing@@ -243,7 +485,7 @@ mkStraightFlush :: [PlayingCard] -> Maybe PokerHand mkStraightFlush hand- | isPokerHandSize hand =+ | isValidPokerHand hand = let consecRanks = mkConsecutiveRanks hand isConsecRanks = isJust consecRanks in if isConsecRanks@@ -259,8 +501,8 @@ | otherwise = False mkRoyalFlush :: [PlayingCard] -> Maybe PokerHand-mkRoyalFlush hand- | isPokerHandSize hand =+mkRoyalFlush hand + | isValidPokerHand hand = if (isSameSuit hand) then let@@ -279,9 +521,9 @@ | isJust $ mkRoyalFlush hand = True | otherwise = False -isPokerHandSize :: [PlayingCard] -> Bool-isPokerHandSize hand - | (length hand) == 5 = True+isValidPokerHand :: [PlayingCard] -> Bool+isValidPokerHand hand + | ((length hand) == 5) && ((dedupe hand) == hand) = True | otherwise = False choose :: Ord r => Int -> [r] -> [[r]]@@ -290,6 +532,7 @@ (x:xs) <- tails lst rest <- choose (n-1) xs return $ x : rest+ allPossibleHands :: [[PlayingCard]] allPossibleHands = choose 5 fullDeck
src/Game/Implement/Card.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Game.Implement.Card -- Copyright : (c) 2017 Christopher A. Gorski@@ -16,8 +17,10 @@ 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) -- | -- Represents a physical card with no order and no value.@@ -33,10 +36,19 @@ fullDeck :: [c] dedupe :: [c] -> [c] draw :: [Int] -> [c] -> Maybe ([[c]],[c])- shuffle :: MonadRandom m => [c] -> m [c]+ shuffle :: RandomGen m => [c] -> Rand m [c]+ randomCard :: RandomGen m => Rand m c fullDeck = [minBound .. maxBound] dedupe l = nub l shuffle deck = shuffleM deck+ randomCard =+ let+ minB = minBound :: (Bounded c, Card c) => c+ maxB = maxBound :: (Bounded c, Card c) => c in+ do+ randomd <- getRandomR(fromEnum minB, fromEnum maxB)+ return $ toEnum randomd+ draw handSizeLst deck | let total = (foldl1' (+) handSizeLst)
src/Game/Implement/Card/Standard.hs view
@@ -1,10 +1,14 @@ {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-} module Game.Implement.Card.Standard where +import Control.Monad.Random import Game.Implement.Card+import System.Random.Shuffle(shuffleM) + data Rank = Ace | Two |@@ -19,8 +23,27 @@ Jack | Queen | King+ deriving (Show, Enum, Eq, Ord, Bounded) +randomRank :: RandomGen m => Rand m Rank+randomRank =+ let+ min = minBound :: Rank+ max = maxBound :: Rank in+ do+ (randomn :: Int) <- getRandomR(fromEnum min, fromEnum max);+ return $ toEnum randomn++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+ ranks :: [Rank] ranks = [minBound .. maxBound] @@ -34,6 +57,47 @@ Spades deriving (Show, Enum, Eq, Ord, Bounded) +randomSuit :: RandomGen m => Rand m Suit+randomSuit =+ let+ min = minBound :: Suit+ max = maxBound :: Suit in+ do+ (randomn :: Int) <- getRandomR(fromEnum min, fromEnum max);+ return $ toEnum randomn++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+++uniqueNumList :: RandomGen g => Int -> Int -> Int -> Rand g (Maybe [Int])+uniqueNumList numToReturn n m =+ if (numToReturn > ((m-n)+1)) || (numToReturn < 0)+ then return Nothing+ else+ do+ deck <- shuffleM [n..m]+ return $ Just $ take numToReturn deck++uniqueNumLists :: RandomGen g => [Int] -> Int -> Int -> Rand g (Maybe [[Int]])+uniqueNumLists numToReturn n m =+ if ((sum numToReturn > ((m-n)+1)) || (length $ filter (\x -> x <= 0) numToReturn)>0)+ then return Nothing+ else+ let+ f _ [] out = reverse out+ f deck (r:rs) out = f (drop r deck) rs ((take r deck):out) in+ do+ deck <- shuffleM [n..m]+ return $ Just $ f deck numToReturn []++ suits :: [Suit] suits = [minBound .. maxBound] @@ -71,6 +135,9 @@ toSuit :: PlayingCard -> Suit toSuit (PlayingCard _ s) = s+++
test/Spec.hs view
@@ -4,6 +4,7 @@ import Game.Implement.Card import Game.Implement.Card.Standard + allHandsCount :: Int allHandsCount = length allPossibleHands allHandsCountExpected :: Int@@ -117,6 +118,76 @@ do randdecks <- evalRandIO $ replicateM 10000 shuffledDeck; + randHighCards <-+ let+ r = do+ h <- randomHighCard+ return (h, isHighCard $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randPairs <-+ let+ r = do+ h <- randomPair+ return (h, isPair $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randTwoPairs <-+ let+ r = do+ h <- randomTwoPair+ return (h, isTwoPair $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randThreeOfAKinds <-+ let+ r = do+ h <- randomThreeOfAKind+ return (h, isThreeOfAKind $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randStraights <-+ let+ r = do+ h <- randomStraight+ return (h, isStraight $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randFlushes <-+ let+ r = do+ h <- randomFlush+ return (h, isFlush $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randFullHouses <-+ let+ r = do+ h <- randomFullHouse+ return (h, isFullHouse $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randFourOfAKinds <-+ let+ r = do+ h <- randomFourOfAKind+ return (h, isFourOfAKind $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randStraightFlushes <-+ let+ r = do+ h <- randomStraightFlush+ return (h, isStraightFlush $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r++ randRoyalFlushes <-+ let+ r = do+ h <- randomRoyalFlush+ return (h, isRoyalFlush $ cardsOfPokerHand h)+ in evalRandIO $ replicateM 100000 r+ hspec $ do describe "Game.Implement.Card.draw (PlayingCard)" $ do it "returns drawn hands from a deck, plus the remaining deck" $ do@@ -132,15 +203,92 @@ it "returns unique cards" $ do isUnique (fullDeck :: [PlayingCard]) `shouldBe` True - describe "Game.Implement.Card.shuffle (PlayingCard)" $ do- it "returns 10000 different fullDeck shuffles using the global random generator" $ do- (isUnique randdecks) `shouldBe` True describe "Game.Implement.Card.Standard.Poker.isRoyalFlush" $ do it "confirms that [AH, QH, KH, JH, TH] is a Royal Flush" $ do (isRoyalFlush royalFlush) `shouldBe` True it "confirms that [AH, QH, 8H, JH, TH] is not a Royal Flush" $ do (isRoyalFlush royalFlushNot) `shouldBe` False++ describe "Game.Game.Poker.randomHighCard" $ do+ it "returns a HighCard of typeOfPokerHand HighCard" $ do+ hand <- evalRandIO randomHighCard+ typeOfPokerHand hand `shouldBe` HighCard+ it "returns 100000 random HighCards" $ do + randHighCards `shouldBe` (map (\(h,_) -> (h,True)) randHighCards) ++ describe "Game.Game.Poker.randomPair" $ do+ it "returns a Pair of typeOfPokerHand Pair" $ do+ hand <- evalRandIO randomPair+ typeOfPokerHand hand `shouldBe` Pair+ it "returns 100000 random Pairs" $ do + randPairs `shouldBe` (map (\(h,_) -> (h,True)) randPairs) ++ describe "Game.Game.Poker.randomTwoPair" $ do+ it "returns a TwoPair of typeOfPokerHand TwoPair" $ do+ hand <- evalRandIO randomTwoPair+ typeOfPokerHand hand `shouldBe` TwoPair+ it "returns 100000 random TwoPairs" $ do + randTwoPairs `shouldBe` (map (\(h,_) -> (h,True)) randTwoPairs) + + describe "Game.Game.Poker.randomThreeOfAKind" $ do+ it "returns a ThreeOfAKind of typeOfPokerHand ThreeOfAKind" $ do+ hand <- evalRandIO randomThreeOfAKind+ typeOfPokerHand hand `shouldBe` ThreeOfAKind+ it "returns 100000 random ThreeOfAKinds" $ do + randThreeOfAKinds `shouldBe` (map (\(h,_) -> (h,True)) randThreeOfAKinds) + + describe "Game.Game.Poker.randomStraight" $ do+ it "returns a Straight of typeOfPokerHand Straight" $ do+ hand <- evalRandIO randomStraight+ typeOfPokerHand hand `shouldSatisfy`+ \t -> t == Straight AceHigh || t == Straight AceLow+ it "returns 100000 random Straights" $ do + randStraights `shouldBe` (map (\(h,_) -> (h,True)) randStraights) ++ describe "Game.Game.Poker.randomFlush" $ do+ it "returns a Flush of typeOfPokerHand Flush" $ do+ hand <- evalRandIO randomFlush+ typeOfPokerHand hand `shouldBe` Flush+ it "returns 100000 random Flushes" $ do + randFlushes `shouldBe` (map (\(h,_) -> (h,True)) randFlushes) + + describe "Game.Game.Poker.randomFullHouse" $ do+ it "returns a FullHouse of typeOfPokerHand FullHouse" $ do+ hand <- evalRandIO randomFullHouse+ typeOfPokerHand hand `shouldBe` FullHouse+ it "returns 100000 random Full Houses" $ do + randFullHouses `shouldBe` (map (\(h,_) -> (h,True)) randFullHouses)++ describe "Game.Game.Poker.randomFourOfAKind" $ do+ it "returns a FourOfAKind of typeOfPokerHand FourOfAKind" $ do+ hand <- evalRandIO randomFourOfAKind+ typeOfPokerHand hand `shouldBe` FourOfAKind+ it "returns 100000 random Four-of-a-Kinds" $ do + randFourOfAKinds `shouldBe` (map (\(h,_) -> (h,True)) randFourOfAKinds)+++ describe "Game.Game.Poker.randomStraightFlush" $ do+ it "returns a StraightFlush of typeOfPokerHand StraightFlush" $ do+ hand <- evalRandIO randomStraightFlush+ typeOfPokerHand hand `shouldSatisfy`+ \t -> t == StraightFlush AceHigh || t == StraightFlush AceLow+ it "returns 100000 random Straight Flushes" $ do + randStraightFlushes `shouldBe` (map (\(h,_) -> (h,True)) randStraightFlushes) ++ describe "Game.Game.Poker.randomRoyalFlush" $ do+ it "returns a RoyalFlush of typeOfPokerHand RoyalFlush" $ do+ hand <- evalRandIO randomRoyalFlush+ typeOfPokerHand hand `shouldBe` RoyalFlush+ it "returns 100000 random Royal Flushes" $ do + randRoyalFlushes `shouldBe` (map (\(h,_) -> (h,True)) randRoyalFlushes) ++++ describe "Game.Implement.Card.shuffle (PlayingCard)" $ do+ 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 it "confirms that sets of each hand are disjoint and that total count correct" $ do confirmDisjoint `shouldBe` (allHandsCountExpected, True)