general-games 0.1.0.0 → 0.2.0

raw patch · 3 files changed

+110/−92 lines, 3 filesdep +hspecdep −MonadRandomdep −containersdep −permutationPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

Dependencies removed: MonadRandom, containers, permutation

API changes (from Hackage documentation)

Files

• general-games.cabal +3/−7
• src/Game/Implement/Card.hs +16/−5
• test/Spec.hs +91/−80

@@ -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

@@ -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

@@ -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+