Project Euler Problem 54 in Haskell

I wrote an implementation in Haskell for Project Euler Problem 54:

The file, poker.txt, contains one-thousand random hands dealt to two players. Each line of the file contains ten cards (separated by a single space): the first five are Player 1's cards and the last five are Player 2's cards. You can assume that all hands are valid (no invalid characters or repeated cards), each player's hand is in no specific order, and in each hand there is a clear winner.

How many hands does Player 1 win?

``
import Data.Monoid(mappend)
import Data.List(sortBy, sort, group, nub, elemIndex)
import Control.Arrow((&&&), (***))
import Data.Maybe(fromJust)
import Control.Monad(join)

type Hand = String
type Values = [Int]
data Ranking = HighCard | Pair | TwoPair | ThreeOfAKind | Straight | Flush | FullHouse | FourOfAKind | StraightFlush deriving (Eq, Ord)
data HandValue = HandValue Ranking Values
instance Eq HandValue where
HandValue r1 v1 == HandValue r2 v2 = r1 == r2 && v1 == v2
instance Ord HandValue where
HandValue r1 v1 compare HandValue r2 v2 = (r1 compare r2) mappend (v1 compare v2)

rateHand :: Hand -> HandValue
rateHand hand
| straight && flush = HandValue StraightFlush ranks
| flush = HandValue Flush ranks
| straight = HandValue Straight ranks
| otherwise = case map fst groups of
[4, 1] -> HandValue FourOfAKind values
[3, 2] -> HandValue FullHouse values
[3, 1, 1] -> HandValue ThreeOfAKind values
[2, 2, 1] -> HandValue TwoPair values
[2, 1, 1, 1] -> HandValue Pair values
otherwise -> HandValue HighCard values
where
sf = (elem "SCDH")
ranks = sortBy (flip compare) $ map (fromJust . (elemIndex` "23456789TJQKA")) $ filter (not . sf) hand
suits = filter sf hand
flush = length (nub suits) == 1
straight = ranks == reverse [last ranks..head rank

Not bad. Here are some suggestions for improvement:

import Data.Monoid(mappend)

Use a single space before the parentheses.

data HandValue = HandValue Ranking Values
instance Eq HandValue where
  HandValue r1 v1 == HandValue r2 v2 = r1 == r2 && v1 == v2
instance Ord HandValue where

Eq and Ord instances can be derived automagically:

data HandValue = HandValue Ranking Values deriving (Eq, Ord)

ranks = sortBy (flip compare) $ map (fromJust . (`elemIndex` "23456789TJQKA")) $ filter (not . sf) hand

Rename to sortedRanks.

groups = sortBy descSort . map (length &&& id) $ group ranks

I think it'll be a bit easier to read without function composition. Change the . to $.

descSort (l1,v1) (l2,v2) = (l2 `compare` l1) `mappend` (v2 `compare` v1)

You can simply write descSort = flip compare. And since you use sortBy descSort twice, I suggest extracting it to a new function sortDecreasing :: Ord a => [a] -> [a].

parseLine :: String -> Bool

• parseLine actually both parses and checks if the first player wins. Split to parseLine :: String -> (Hand, Hand) and playerOneWins :: (Hand, Hand) -> Bool.

• Some of the parsing happens in rateHand: sf, suits, and most of sf are all parsing the hand string. Move all parsing to parseHand and change the Hand type to [(Int, Char)] instead of String.

• Use partition instead of two filters.

• join (***) is confusing. I would write a mapOverPair :: (a -> b) -> (a, a) -> (b, b) function, which can implemented in a straightforward way.

• Rename sf to isSuit. I still can't figure out what sf stands for. (Also, what does pots mean?)

The code after applying these suggestions:

import Data.Monoid (mappend)
import Data.List (sortBy, sort, group, nub, elemIndex, partition)
import Control.Arrow ((&&&), (***))
import Data.Maybe (fromJust)
import Control.Monad (join)

type Hand = [(Int, Char)]
type Values = [Int]
data Ranking = HighCard | Pair | TwoPair | ThreeOfAKind | Straight | Flush | FullHouse | FourOfAKind  | StraightFlush deriving (Eq, Ord)
data HandValue = HandValue Ranking Values deriving (Eq, Ord)

sortDecreasing :: Ord a => [a] -> [a]
sortDecreasing = sortBy (flip compare)

rateHand :: Hand -> HandValue
rateHand hand
   | straight && flush = HandValue StraightFlush sortedRanks
   | flush = HandValue Flush sortedRanks
   | straight = HandValue Straight sortedRanks
   | otherwise = case map fst groups of
                         [4, 1] -> HandValue FourOfAKind values
                         [3, 2] -> HandValue FullHouse values
                         [3, 1, 1] -> HandValue ThreeOfAKind values
                         [2, 2, 1] -> HandValue TwoPair values
                         [2, 1, 1, 1] -> HandValue Pair values
                         otherwise -> HandValue HighCard values
                      where
       sortedRanks = sortDecreasing $ map fst hand
       suits = map snd hand
       flush = length (nub suits) == 1
       straight = sortedRanks == reverse [last sortedRanks..head sortedRanks] || sortedRanks == [12,3,2,1,0]
       groups = sortDecreasing $ map (length &&& id) $ group sortedRanks
       values = concatMap snd groups

mapOverPair :: (a -> b) -> (a, a) -> (b, b)
mapOverPair f (x, y) = (f x, f y)

parseHand :: String -> Hand
parseHand str = zip ranks suits
  where (suits, ranksChars) = partition isSuit str
        isSuit = (`elem` "SCDH")
        ranks = map (fromJust . (`elemIndex` "23456789TJQKA")) ranksChars

parseLine :: String -> (Hand, Hand)
parseLine = mapOverPair parseHand . splitAt 10 . filter (/= ' ')

playerOneWins :: (Hand, Hand) -> Bool
playerOneWins (h1, h2) = rateHand h1 > rateHand h2

main :: IO ()
main = do
  hands  readFile "p054_poker.txt"
  print $ length $ filter playerOneWins hands

StackExchange Code Review Q#110867, answer score: 2