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.1.0.0 +version: 0.2.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 @@ -29,9 +29,6 @@ , Game.Game.Poker build-depends: base >= 4.7 && < 5 - , permutation - , containers - , MonadRandom default-language: Haskell2010 ghc-options: -Wall @@ -41,10 +38,9 @@ main-is: Spec.hs build-depends: base , general-games - , containers , HUnit - - ghc-options: -threaded -rtsopts -with-rtsopts=-N4 + , hspec + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 source-repository head 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 @@ -3,17 +3,28 @@ module Game.Implement.Card where -import Data.List (nub, maximumBy, minimumBy, sortBy) +import Data.List (nub, maximumBy, minimumBy, sortBy, foldl1') class (Enum c, Eq c, Ord c, Bounded c) => Card c where fullDeck :: [c] dedupe :: [c] -> [c] - draw :: Int -> [c] -> Maybe ([c],[c]) + draw :: [Int] -> [c] -> Maybe ([[c]],[c]) fullDeck = [minBound .. maxBound] dedupe l = nub l - draw n l - | n > (length l) = Nothing - | otherwise = Just (drop n l, take n l) + 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)) + class (Card c) => ValuedCard c v where toValue :: c -> v diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,13 +1,35 @@ -import Test.HUnit +import Test.Hspec import Game.Game.Poker import Game.Implement.Card import Game.Implement.Card.Standard -import Game.Implement.Card.Standard.Poker --- allHands = allPossibleHands + +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, @@ -15,6 +37,7 @@ PlayingCard Jack Hearts, PlayingCard Ten Hearts] +royalFlushNot :: [PlayingCard] royalFlushNot = [PlayingCard Ace Hearts, PlayingCard Queen Hearts, @@ -22,89 +45,77 @@ PlayingCard Jack Hearts, PlayingCard Ten Hearts] -singlePair = - [PlayingCard Three Clubs, - PlayingCard Three Spades, - PlayingCard Eight Hearts, - PlayingCard Jack Hearts, - PlayingCard Ten Hearts] - -twoPair = - [PlayingCard Three Clubs, - PlayingCard Three Spades, - PlayingCard Four Hearts, - PlayingCard Four Diamonds, - 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] --- royalFlushLstAH = AH.fromStandardCardLst royalFlushLst --- royalFlushLstAL = AL.fromStandardCardLst royalFlushLst +drawDeckSizesFail :: [Int] +drawDeckSizesFail = [5,9] -sortedRoyalFlush = - [PlayingCard Ace Hearts, - PlayingCard King Hearts, - PlayingCard Queen Hearts, - PlayingCard Jack Hearts, - PlayingCard Ten Hearts] +drawDeckSizesFailNeg :: [Int] +drawDeckSizesFailNeg = [-3,4] - -testPossibleHands = TestCase (assertEqual "Total number of poker hands" allHandsCountExpected allHandsCount) -testPossibleRoyalFlush = TestCase (assertEqual "Total number of royal flushes" 4 (length allRoyalFlush)) -testPossibleStraightFlush = TestCase (assertEqual "Total number of straight flushes" 36 (length allStraightFlush)) -testPossibleFourOfAKind = TestCase (assertEqual "Total number of four-of-a-kinds" 624 (length allFourOfAKind)) -testPossibleFullHouse = TestCase (assertEqual "Total number of full houses" 3744 (length allFullHouse)) -testPossibleFlush = TestCase (assertEqual "Total number of flushes" 5108 (length allFlush)) -testPossibleStraight = TestCase (assertEqual "Total number of straights" 10200 (length allStraight)) -testPossibleThreeOfAKind = TestCase (assertEqual "Total number of three-of-a-kinds" 54912 (length allThreeOfAKind)) -testPossibleTwoPair = TestCase (assertEqual "Total number of two-pairs" 123552 (length allTwoPair)) -testPossiblePair = TestCase (assertEqual "Total number of pairs" 1098240 (length allPair)) -testPossibleHighCard = TestCase (assertEqual "Total number of high cards" 1302540 (length allHighCard)) -testMkRoyalFlush = TestCase (assertEqual "Is [AH, KH, QH, JH, TH] a Royal Flush" (Just $ PokerHand RoyalFlush sortedRoyalFlush) (mkRoyalFlush royalFlush)) -testIsRoyalFlush = TestCase (assertEqual "Is [AH, QH, KH, JH, TH] a Royal Flush" True (isRoyalFlush royalFlush)) -testIsRoyalFlushNot = TestCase (assertEqual "Is [AH, QH, 8H, JH, TH] a Royal Flush" False (isRoyalFlush royalFlushNot)) --- testIsMinHandSize = TestCase (assertEqual "Is min size of 5" True (isMinHandSize royalFlush)) --- testIsMinHandSize2 = TestCase (assertEqual "Is min size of 5" False (isMinHandSize $ DS.fromList [S.Card S.Ace S.Spades])) --- testSortHighToLow = TestCase (assertEqual "Is sorted from high to low" --- sortedRoyalFlushLst --- (sortHighToLow $ AH.fromStandardCardLst royalFlushLst)) --- testIsSameSuit = TestCase (assertEqual "Is same suit" True (isSameSuit $ DS.fromList royalFlushLst)) --- --testHasConsecutiveRanks = TestCase (assertEqual "Is consecutive" True (AH.fromStdroyalFlush - - -tests = TestList [ - TestLabel "Test for testPossibleHands" testPossibleHands, - TestLabel "Test for testPossibleRoyalFlush" testPossibleRoyalFlush, - TestLabel "Test for testPossibleStraightFlush" testPossibleStraightFlush, - TestLabel "Test for testPossibleFourOfAKind" testPossibleFourOfAKind, - TestLabel "Test for testPossibleFullHouse" testPossibleFullHouse, - TestLabel "Test for testPossibleFlush" testPossibleFlush, - TestLabel "Test for testPossibleStraight" testPossibleStraight, - TestLabel "Test for testPossibleThreeOfAKind" testPossibleThreeOfAKind, - TestLabel "Test for testTwoPair" testPossibleTwoPair, - TestLabel "Test for testPair" testPossiblePair, - TestLabel "Test for testHighCard" testPossibleHighCard] --- TestLabel "Test for mkRoyalFlush" testMkRoyalFlush] --- TestLabel "Test for isRoyalFlush" testIsRoyalFlush, --- TestLabel "Test for isRoyalFlushNot" testIsRoyalFlushNot +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]) --- TestLabel "Test for isMinHandSize royalFlush" testIsMinHandSize, --- TestLabel "Test for isMinHandSize singleton" testIsMinHandSize2, --- TestLabel "Test for sortHighToLow royalFlush" testSortHighToLow, --- TestLabel "Test for isSameSuit royalFlush" testIsSameSuit] main :: IO () -main = - do --- putStrLn $ show $ map (fromEnum . S.toRank) $ sort royalFlushLstAH --- putStrLn $ show $ map (fromEnum . S.toRank) $ sort royalFlushLstAL --- putStrLn $ show $ allFourOfAKind - counts <- runTestTT tests - putStrLn $ show counts --- putStrLn $ show $ sortCardsBy AceHighRankOrder royalFlush --- putStrLn $ show $ nOfRank singlePair --- putStrLn $ show $ nOfRank twoPair --- putStrLn $ show $ hasNumNOfRank 2 1 singlePair --- putStrLn $ show $ hasNumNOfRank 2 2 twoPair +main = hspec $ do + describe "Game.Implement.Card instance" $ 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.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.Implement.Card.Standard.Poker allPossibleHands / isHand functions" $ do + 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 +