Haskell Poker Hand Kata

Question

Similar to, but distinct from this. I'm working towards solving this kata. The below code doesn't print the result yet, and it reads hand strings rather than game strings.

Take 4:

import Data.String
import Data.List
import Data.Ord

data Rank = Two | Three | Four | Five | Six | Seven | Eight | Nine 
          | Ten | Jack | Queen | King | Ace 
          deriving (Eq, Ord, Show, Bounded, Enum)

instance Read Rank where
  readsPrec _ value = 
    let tbl = zip "23456789TJQKA" [Two .. Ace]
    in case lookup (head value) tbl of
      Just r -> [(r, tail value)]
      Nothing -> error $ "Invalid rank: " ++ value

data Suit = H | C | D | S deriving (Eq, Ord, Show, Read)

data Card = Card { rank :: Rank, suit :: Suit } deriving (Eq, Ord, Show)

instance Read Card where
  readsPrec _ [r, s] = [(Card (read [r]) (read [s]), "")]
  readsPrec _ value = error $ "Invalid card: " ++ value

data Hand = Hand { handRank :: HandRank, cards :: [Card] } 
          deriving (Eq, Show, Ord)

instance Read Hand where
  readsPrec _ value =
    [(Hand (getHandRank res) res, "")]
    where res = reverse . sort . map read $ words value

data HandRank = HighCard [Rank] 
              | Pair [Rank]
              | TwoPair [Rank]
              | ThreeOfAKind [Rank]
              | Straight [Rank]
              | Flush [Rank]
              | FullHouse [Rank] 
              | FourOfAKind [Rank] 
              | StraightFlush [Rank]
              deriving (Eq, Ord, Show)

data GameOutcome = Winner String Hand | Tie deriving (Eq, Ord)

instance Show GameOutcome where
  show o = case o of
    Winner player hand -> player ++ " wins with " ++ show (handRank hand)
    Tie -> "Tie"

isFlush :: [Card] -> Bool
isFlush = (1==) . length . group . map suit

isStraight :: [Card] -> Bool
isStraight cards = 
  let rs = sort $ map rank cards
      run = [(head rs) .. (last rs)]
  in rs == run

getHandRank :: [Card] -> HandRank
getHandRank cards =
  let ranks = map rank cards
      rankGroups = sortByLen $ group ranks
      relevantRanks = map (!!0) rankGroups
      handRank = case cards of
        _ | isFlush cards && isStraight cards  -> StraightFlush
          | has4 rankGroups                        -> FourOfAKind
          | has3 rankGroups && has2 rankGroups -> FullHouse
          | isFlush cards                          -> Flush
          | isStraight cards                       -> Straight
          | has3 rankGroups                        -> ThreeOfAKind 
          | countGroupsOf 2 rankGroups == 2      -> TwoPair
          | has2 rankGroups                        -> Pair
          | otherwise                              -> HighCard
  in handRank relevantRanks

winner :: Hand -> Hand -> GameOutcome
winner h1 h2 =
  case compare h1 h2 of
    GT -> Winner "Player 1" h1
    LT -> Winner "Player 2" h2
    EQ -> Tie

-------------------------------
-- General Utility Functions --
-------------------------------
hasGroupOf :: Int -> [[a]] -> Bool
hasGroupOf n groups = n `elem` map length groups
has4 = hasGroupOf 4
has3 = hasGroupOf 3
has2 = hasGroupOf 2

countGroupsOf :: Int -> [[a]] -> Int
countGroupsOf n groups = length $ filter (\g -> length g == n) groups

sortByLen :: [[a]] -> [[a]]
sortByLen = sortBy (flip $ comparing length)

• Added comparison function
• Fixed a bug relating to improper sorting in some situations (replaced nub with relevantRanks in getHandRank
• Ran it through hlint

My only experience with Haskell so far is some playing around with Parsec and a few half-read-throughs of WYAS48, so please be obnoxious about style issues.

All feedback welcome, but I would particularly like to ask

1. Are there built-ins/better implementations of the "General Utility" functions defined at the bottom?
2. Is there a clearer or more succinct way of writing Read Rank?
3. Is there a clearer or more flexible way of writing getHandRank, with particular emphasis on closely connecting those predicates with the data entry?

Answer 1

It's generally a good idea to give explicit type signatures for your top level definitions. It helps your code's readers (e.g. us) understand your code.

hasGroupOf looks perfectly clear (save for the missing type signature), but I'd write the other two like this:

import Data.Ord (comparing)

countGroupsOf :: Int -> [a] -> Int
countGroupsOf n groups = length $ filter (\g -> length g == n) groups

sortByLen :: [[a]] -> [[a]]
sortByLen = sortBy (flip $ comparing length)

Actually, for that last one, I'd probably want lists of equal length to sort in a predictable order:

import Data.Monoid

sortByLen :: [[a]] -> [[a]]
sortByLen = sortBy (mconcat [flip $ comparing length, compare])

(You are expected to know that Ordering is a monoid, and that a -> b is a monoid when b is a monoid. The monoid I'm using is [a] -> [a] -> Ordering.)

Answer 2

I think your instance Read Card can be improved. There's no reason to use length if you just want to know whether the length is 2 or not 2. If the length is 2 then value is [r,s] (String is just [Char]), so you can write

readsPrec _ [r,s] = ...
readsPres _ _     = ...

Then you can just do read [r] and read [s]. I don't think you have to specify (read r :: Rank) either. The compiler should be able to figure it out from the way you're using it. And of course if you know that value is of length 2, you know what drop 2 value is.

I'm kind of sleepy so I apologize for any horrible mistakes I've made in this answer.

Answer 3

YourrankGroups list is sorted by the size of the group. If you reverse sort it you can use:

case rankGroups of
  (4:_)      -> -- four of a kind
  (3:2:_)    -> -- full house
  (3:_)      -> -- trips but not a full house
  (2:2:_)    -> -- two pair
  (2:_)      -> -- a pair but not two pair
  (1:_)      -> -- check for straights and flushes