packages feed

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