poker.hs

import Data.List

data Suit = Spade | Diamond | Club | Heart
  deriving (Eq, Show, Ord)

data Card = Card Suit Int
  deriving (Eq, Show, Ord)

suit (Card s _) = s
rank (Card _ r) = r


isOnePair :: [Card] -> Bool
isOnePair = (\h -> (countPairs h == 1) && (countThreeCards h == 0)) . groupByRank

isTwoPair :: [Card] -> Bool
isTwoPair = (\h -> (countPairs h == 2)) . groupByRank

isThreeOfAKind :: [Card] -> Bool
isThreeOfAKind = (\h -> (countPairs h == 0) && (countThreeCards h == 1)) . groupByRank

isFourOfAKind :: [Card] -> Bool
isFourOfAKind = (\h -> countFourCards h == 1) . groupByRank

isFullHouse :: [Card] -> Bool
isFullHouse cs = isThreeOfAKind cs && isOnePair cs

isFlush :: [Card] -> Bool
isFlush cs = length (groupBySuit cs) == 1

isStraight :: [Card] -> Bool
isStraight cs = all (== 1) (zipWith (-) (tail rs) rs)
  where rs = sort (map rank cs)

isStraightFlush :: [Card] -> Bool
isStraightFlush cs = (isStraight cs) && (isFlush cs)



groupByRank :: [Card] -> [[Card]]
groupByRank cards = dropEmpty (map (\r -> filterByRank r cards) [1..13])

groupBySuit :: [Card] -> [[Card]]
groupBySuit cards = dropEmpty (map (\s -> filterBySuit s cards) [Spade, Diamond, Club, Heart])

filterBySuit :: Suit -> [Card] -> [Card]
filterBySuit s = filter ((== s) . suit)

filterByRank :: Int -> [Card] -> [Card]
filterByRank r = filter ((== r) . rank)

dropEmpty = filter (not . null)

makeCollecter n = filter (\g -> length g == n)
collectPairs      = makeCollecter 2
collectThreeCards = makeCollecter 3
collectFourCards  = makeCollecter 4

countPairs      = length . collectPairs
countThreeCards = length . collectThreeCards
countFourCards  = length . collectFourCards


--
-- Samples
--
sampleOnePair        = [(Card Spade 1), (Card Diamond 1), (Card Club  3), (Card Heart 4), (Card Spade 5)]
sampleTwoPair        = [(Card Spade 1), (Card Diamond 1), (Card Club  3), (Card Heart 3), (Card Spade 5)]
sampleThreeOfAKind   = [(Card Spade 1), (Card Diamond 1), (Card Club  1), (Card Heart 4), (Card Spade 5)]
sampleFlush          = [(Card Club  1), (Card Club    2), (Card Club  3), (Card Club  4), (Card Club  5)]
sampleStraight       = [(Card Spade 3), (Card Diamond 2), (Card Club  1), (Card Heart 5), (Card Spade 4)]
sampleStraightFlush  = [(Card Spade 1), (Card Spade   2), (Card Spade 3), (Card Spade 4), (Card Spade 5)]