{-# LANGUAGE ViewPatterns, LambdaCase #-}

-- 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 Euler
import Data.Attoparsec.Text
import Data.Maybe
import Data.Monoid

import qualified Data.Text    as T
import qualified Data.Text.IO as T

type Rank = Int
type Suit = Char
data Card = Card { cardRank :: Rank, cardSuit :: Suit } deriving (Eq,Show)

data HandRank = HighCard | Pair | TwoPair | Triple | Straight | Flush
              | FullHouse | Quad | StraightFlush | RoyalFlush
              deriving (Eq,Ord,Enum,Bounded,Show)

handRank (sortBy (compare `on` cardRank) -> cards)
   | same suits, ranks == [10 .. 14]         = (RoyalFlush, 14)
   | same suits, consecutive ranks           = (StraightFlush, maximum ranks)
   | Just a <- nSame 4 ranks                 = (Quad, a)
   | Just a <- nSame 3 ranks,
     Just b <- nSame 2 (filter (/= a) ranks) = (FullHouse, a)
   | same suits                              = (Flush, maximum ranks)
   | consecutive ranks                       = (Straight, maximum ranks)
   | Just a <- nSame 3 ranks                 = (Triple, a)
   | Just a <- nSame 2 ranks,
     Just b <- nSame 2 (filter (/= a) ranks) = (TwoPair, max a b)
   | Just a <- nSame 2 ranks                 = (Pair, a)
   | otherwise                               = (HighCard, maximum ranks)
   where
      ranks = map cardRank cards
      suits = map cardSuit cards

same :: Eq a => [a] -> Bool
same xs = and $ zipWith (==) xs (tail xs)

nSame :: Eq a => Int -> [a] -> Maybe a
nSame n cs = listToMaybe $ do
   c <- nub cs
   guard $ length (filter (== c) cs) >= n
   return c

consecutive :: (Eq a, Enum a) => [a] -> Bool
consecutive xs = and $ zipWith (\a b -> succ a == b) xs (tail xs)

rankP = flip fmap (satisfy (`elem` "23456789TJQKA")) $ \case
   'T' -> 10; 'J' -> 11; 'Q' -> 12; 'K' -> 13; 'A' -> 14; c -> read [c]
suitP = satisfy (`elem` "CDHS")

cardP = Card <$ skipSpace <*> rankP <*> suitP
handP = sequenceA $ replicate 5 cardP
lineP = (,) <$> handP <*> handP
fileP = (lineP `sepBy` endOfLine) <* optional endOfLine <* endOfInput

compareHands :: [Card] -> [Card] -> Ordering
compareHands xs ys = (handRank  xs `compare` handRank  ys)
                  <> (descRanks xs `compare` descRanks ys)
   where descRanks = sortBy (flip compare) . map cardRank

main = do
   hands <- either error id . parseOnly fileP <$> T.readFile "p054_poker.txt"
   print $ length $ filter (== GT) $ map (uncurry compareHands) hands