import Control.Monad.Random
import Test.Hspec
import Game.Game.Poker
import Game.Implement.Card
import Game.Implement.Card.Standard
allHandsCount :: Int
allHandsCount = length allPossibleHands
allHandsCountExpected :: Int
allHandsCountExpected = 2598960
allRoyalFlushCountExpected :: Int
allRoyalFlushCountExpected = 4
allStraightFlushCountExpected :: Int
allStraightFlushCountExpected = 36
allFourOfAKindCountExpected :: Int
allFourOfAKindCountExpected = 624
allFullHouseCountExpected :: Int
allFullHouseCountExpected = 3744
allFlushCountExpected :: Int
allFlushCountExpected = 5108
allStraightCountExpected :: Int
allStraightCountExpected = 10200
allThreeOfAKindCountExpected :: Int
allThreeOfAKindCountExpected = 54912
allTwoPairCountExpected :: Int
allTwoPairCountExpected = 123552
allPairCountExpected :: Int
allPairCountExpected = 1098240
allHighCardCountExpected :: Int
allHighCardCountExpected = 1302540
royalFlush :: [PlayingCard]
royalFlush =
[PlayingCard Ace Hearts,
PlayingCard Queen Hearts,
PlayingCard King Hearts,
PlayingCard Jack Hearts,
PlayingCard Ten Hearts]
royalFlushNot :: [PlayingCard]
royalFlushNot =
[PlayingCard Ace Hearts,
PlayingCard Queen Hearts,
PlayingCard Eight Hearts,
PlayingCard Jack Hearts,
PlayingCard Ten Hearts]
drawDeck :: [PlayingCard]
drawDeck =
[PlayingCard Five Diamonds,
PlayingCard Seven Clubs,
PlayingCard Two Spades,
PlayingCard King Spades,
PlayingCard King Hearts,
PlayingCard Ace Diamonds,
PlayingCard Seven Diamonds,
PlayingCard Three Clubs,
PlayingCard Four Clubs]
drawDeckSizes :: [Int]
drawDeckSizes = [1,4,2]
drawDeckSizesFail :: [Int]
drawDeckSizesFail = [5,9]
drawDeckSizesFailNeg :: [Int]
drawDeckSizesFailNeg = [-3,4]
drawDeckExpectedOutput :: Maybe ([[PlayingCard]],[PlayingCard])
drawDeckExpectedOutput = Just
([[PlayingCard Five Diamonds],
[PlayingCard Seven Clubs,
PlayingCard Two Spades,
PlayingCard King Spades,
PlayingCard King Hearts],
[PlayingCard Ace Diamonds,
PlayingCard Seven Diamonds]],
[PlayingCard Three Clubs,
PlayingCard Four Clubs])
confirmDisjoint :: (Int, Bool)
confirmDisjoint =
let mfunc1 hand = [mkRoyalFlush hand,
mkStraightFlush hand,
mkFourOfAKind hand,
mkFullHouse hand,
mkFlush hand,
mkStraight hand,
mkThreeOfAKind hand,
mkTwoPair hand,
mkPair hand,
mkHighCard hand]
maybem (Just _) = 1
maybem Nothing = 0
countJust hand = sum $ map maybem $ mfunc1 hand
allSums = map countJust allPossibleHands
collect _ (outsum, False) = (outsum, False)
collect (x:xs) (outsum, _) =
collect xs (x+outsum, if x==0 || x==1 then True else False)
collect [] output = output
in
collect allSums (0, True)
isUnique :: Eq a => [a] -> Bool
isUnique lst = f lst True where
f _ False = False
f [] result = result
f (x:xs) _ = if x `elem` xs then f xs False else f xs True
shuffledDeck :: RandomGen g => Rand g [PlayingCard]
shuffledDeck = shuffle $ fullDeck
main :: IO ()
main =
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
(draw drawDeckSizes drawDeck) `shouldBe` drawDeckExpectedOutput
it "returns Nothing when trying to return more cards than in deck" $ do
(draw drawDeckSizesFail drawDeck) `shouldBe` Nothing
it "returns Nothing when trying to return negative cards" $ do
(draw drawDeckSizesFailNeg drawDeck) `shouldBe` Nothing
describe "Game.Implement.Card.fullDeck (PlayingCard)" $ do
it "returns 52 cards" $ do
length (fullDeck :: [PlayingCard]) `shouldBe` 52
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
(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.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
allHandsCount `shouldBe` allHandsCountExpected
it "confirms the total number of royal flushes" $ do
(length allRoyalFlush) `shouldBe` allRoyalFlushCountExpected
it "confirms the total number of straight flushes" $ do
(length allStraightFlush) `shouldBe` allStraightFlushCountExpected
it "confirms the total number of four-of-a-kinds" $ do
(length allFourOfAKind) `shouldBe` allFourOfAKindCountExpected
it "confirms the total number of full houses" $ do
(length allFullHouse) `shouldBe` allFullHouseCountExpected
it "confirms the total number of flushes" $ do
(length allFlush) `shouldBe` allFlushCountExpected
it "confirms the total number of straights" $ do
(length allStraight) `shouldBe` allStraightCountExpected
it "confirms the total number of three-of-a-kinds" $ do
(length allThreeOfAKind) `shouldBe` allThreeOfAKindCountExpected
it "confirms the total number of two-pairs" $ do
(length allTwoPair) `shouldBe` allTwoPairCountExpected
it "confirms the total number of pairs" $ do
(length allPair) `shouldBe` allPairCountExpected
it "confirms the total number of high card hands" $ do
(length allHighCard) `shouldBe` allHighCardCountExpected