Commits

Tony Morris  committed b6c6f3d

Testing

  • Participants
  • Parent commits 3fb25f7

Comments (0)

Files changed (2)

File Cards/Poker/Hand.hs

 import Cards.Rank
 import Cards.Suit
 import Cards.Poker.Score
+import Test.QuickCheck
 
 data Hand = Hand {
   card1 :: Card,
 hand :: Card -> Card -> Card -> Card -> Card -> Hand
 hand = Hand
 
+hands :: [a] -> [[a]]
+hands = combinations 5
+
 allHands :: [Hand]
-allHands = (\[c1, c2, c3, c4, c5] -> hand c1 c2 c3 c4 c5) <$> 5 `combinations` allCards
+allHands = (\[c1, c2, c3, c4, c5] -> hand c1 c2 c3 c4 c5) <$> hands allCards
 
 cards :: Hand -> [Card]
 cards (Hand c1 c2 c3 c4 c5) = [c1, c2, c3, c4, c5]
 
 combinations :: Int -> [a] -> [[a]]
 combinations n = evalStateT (replicateM n (StateT pick))
+
+instance Arbitrary Hand where
+  arbitrary = liftM5 hand arbitrary arbitrary arbitrary arbitrary arbitrary
+
+prop_cardX f n c1 c2 c3 c4 c5 = f (hand c1 c2 c3 c4 c5) == [c1, c2, c3, c4, c5] !! n
+
+prop_card1 :: Card -> Card -> Card -> Card -> Card -> Bool
+prop_card1 = prop_cardX card1 0
+
+prop_card2 :: Card -> Card -> Card -> Card -> Card -> Bool
+prop_card2 = prop_cardX card2 1
+
+prop_card3 :: Card -> Card -> Card -> Card -> Card -> Bool
+prop_card3 = prop_cardX card3 2
+
+prop_card4 :: Card -> Card -> Card -> Card -> Card -> Bool
+prop_card4 = prop_cardX card4 3
+
+prop_card5 :: Card -> Card -> Card -> Card -> Card -> Bool
+prop_card5 = prop_cardX card5 4
+
+prop_cards :: [Card -> Card -> Card -> Card -> Card -> Bool]
+prop_cards = [prop_card1, prop_card2, prop_card3, prop_card4, prop_card5]

File Cards/Poker/Score.hs

 import Cards.Rank
 import Data.List
 import Control.Applicative
+import Test.QuickCheck
 
-data Score = StraightFlush Rank |
-             FourOfAKind Rank Rank |
-             FullHouse Rank Rank |
-             Flush Rank Rank Rank Rank Rank |
-             Straight Rank |
-             ThreeOfAKind Rank Rank Rank |
-             TwoPair Rank Rank Rank |
-             OnePair Rank Rank Rank Rank |
-             High Rank Rank Rank Rank Rank
+data Score = StraightFlush Rank | -- [high]
+             FourOfAKind Rank Rank | -- [four of, other]
+             FullHouse Rank Rank | -- [three of, two of]
+             Flush Rank Rank Rank Rank Rank | -- all five
+             Straight Rank | -- [high]
+             ThreeOfAKind Rank Rank Rank | -- [three of, one other, one other]
+             TwoPair Rank Rank Rank | -- [one pair, one pair, other]
+             OnePair Rank Rank Rank Rank | -- [pair, other, other, other]
+             High Rank Rank Rank Rank Rank -- all five
   deriving (Eq, Ord)
 
 instance Show Score where
 isHigh :: Score -> Bool
 isHigh (High _ _ _ _ _) = True
 isHigh _ = False
+
+instance Arbitrary Score where
+  arbitrary = oneof [
+                      StraightFlush <$> arbitrary,
+                      do a <- arbitrary
+                         b <- suchThat arbitrary (/= a)
+                         return (FourOfAKind a b),
+                      do a <- arbitrary
+                         b <- suchThat arbitrary (/= a)
+                         return (FullHouse a b),
+                      do a <- arbitrary
+                         b <- suchThat arbitrary (/= a)
+                         c <- suchThat arbitrary (`notElem` [a, b])
+                         d <- suchThat arbitrary (`notElem` [a, b, c])
+                         e <- suchThat arbitrary (`notElem` [a, b, c, d])
+                         return (Flush a b c d e),
+                      Straight <$> arbitrary,
+                      do a <- arbitrary
+                         b <- suchThat arbitrary (/= a)
+                         c <- suchThat arbitrary (`notElem` [a, b])
+                         return (ThreeOfAKind a b c),
+                      do a <- arbitrary
+                         b <- suchThat arbitrary (/= a)
+                         c <- suchThat arbitrary (`notElem` [a, b])
+                         return (TwoPair a b c),
+                      do a <- arbitrary
+                         b <- suchThat arbitrary (/= a)
+                         c <- suchThat arbitrary (`notElem` [a, b])
+                         d <- suchThat arbitrary (`notElem` [a, b, c])
+                         return (OnePair a b c d),
+                      do a <- arbitrary
+                         b <- suchThat arbitrary (/= a)
+                         c <- suchThat arbitrary (`notElem` [a, b])
+                         d <- suchThat arbitrary (`notElem` [a, b, c])
+                         e <- suchThat arbitrary (`notElem` [a, b, c, d])
+                         return (High a b c d e)
+                    ]
+
+prop_isX :: Score -> Bool
+prop_isX s = length (filter id (sequence [isStraightFlush, isFourOfAKind, isFullHouse, isFlush, isStraight, isThreeOfAKind, isTwoPair, isOnePair, isHigh] s)) == 1