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.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 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 @@ -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 +-- +-- 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 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 @@ -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) 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,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 + + + diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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)