{-# LANGUAGE DeriveGeneric #-}
-- | Poker combination and its processing functions

module Game.Combination(
    Combination(..),
    getOccurrences,
    parseSequence,
    parsePartHand,
    parseCombination,
    CombinationName(..)) where

import CardParts.Cards (Card (..))
import CardParts.Values (Value(..))
import CardParts.Suits (Suit(..))
import Data.List ( (\\), sort, sortBy )
import GHC.Generics (Generic)
import Data.Aeson (FromJSON, ToJSON)

-- | Names of combinations enum

data CombinationName = Kicker
    | Pair
    | TwoPairs
    | Set
    | Straight
    | Flush
    | FullHouse
    | FourOfAKind
    | StraightFlush
    | RoyalFlush deriving (Int -> CombinationName -> ShowS
[CombinationName] -> ShowS
CombinationName -> String
(Int -> CombinationName -> ShowS)
-> (CombinationName -> String)
-> ([CombinationName] -> ShowS)
-> Show CombinationName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CombinationName] -> ShowS
$cshowList :: [CombinationName] -> ShowS
show :: CombinationName -> String
$cshow :: CombinationName -> String
showsPrec :: Int -> CombinationName -> ShowS
$cshowsPrec :: Int -> CombinationName -> ShowS
Show, CombinationName -> CombinationName -> Bool
(CombinationName -> CombinationName -> Bool)
-> (CombinationName -> CombinationName -> Bool)
-> Eq CombinationName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CombinationName -> CombinationName -> Bool
$c/= :: CombinationName -> CombinationName -> Bool
== :: CombinationName -> CombinationName -> Bool
$c== :: CombinationName -> CombinationName -> Bool
Eq, Eq CombinationName
Eq CombinationName
-> (CombinationName -> CombinationName -> Ordering)
-> (CombinationName -> CombinationName -> Bool)
-> (CombinationName -> CombinationName -> Bool)
-> (CombinationName -> CombinationName -> Bool)
-> (CombinationName -> CombinationName -> Bool)
-> (CombinationName -> CombinationName -> CombinationName)
-> (CombinationName -> CombinationName -> CombinationName)
-> Ord CombinationName
CombinationName -> CombinationName -> Bool
CombinationName -> CombinationName -> Ordering
CombinationName -> CombinationName -> CombinationName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CombinationName -> CombinationName -> CombinationName
$cmin :: CombinationName -> CombinationName -> CombinationName
max :: CombinationName -> CombinationName -> CombinationName
$cmax :: CombinationName -> CombinationName -> CombinationName
>= :: CombinationName -> CombinationName -> Bool
$c>= :: CombinationName -> CombinationName -> Bool
> :: CombinationName -> CombinationName -> Bool
$c> :: CombinationName -> CombinationName -> Bool
<= :: CombinationName -> CombinationName -> Bool
$c<= :: CombinationName -> CombinationName -> Bool
< :: CombinationName -> CombinationName -> Bool
$c< :: CombinationName -> CombinationName -> Bool
compare :: CombinationName -> CombinationName -> Ordering
$ccompare :: CombinationName -> CombinationName -> Ordering
$cp1Ord :: Eq CombinationName
Ord, CombinationName
CombinationName -> CombinationName -> Bounded CombinationName
forall a. a -> a -> Bounded a
maxBound :: CombinationName
$cmaxBound :: CombinationName
minBound :: CombinationName
$cminBound :: CombinationName
Bounded, Int -> CombinationName
CombinationName -> Int
CombinationName -> [CombinationName]
CombinationName -> CombinationName
CombinationName -> CombinationName -> [CombinationName]
CombinationName
-> CombinationName -> CombinationName -> [CombinationName]
(CombinationName -> CombinationName)
-> (CombinationName -> CombinationName)
-> (Int -> CombinationName)
-> (CombinationName -> Int)
-> (CombinationName -> [CombinationName])
-> (CombinationName -> CombinationName -> [CombinationName])
-> (CombinationName -> CombinationName -> [CombinationName])
-> (CombinationName
    -> CombinationName -> CombinationName -> [CombinationName])
-> Enum CombinationName
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CombinationName
-> CombinationName -> CombinationName -> [CombinationName]
$cenumFromThenTo :: CombinationName
-> CombinationName -> CombinationName -> [CombinationName]
enumFromTo :: CombinationName -> CombinationName -> [CombinationName]
$cenumFromTo :: CombinationName -> CombinationName -> [CombinationName]
enumFromThen :: CombinationName -> CombinationName -> [CombinationName]
$cenumFromThen :: CombinationName -> CombinationName -> [CombinationName]
enumFrom :: CombinationName -> [CombinationName]
$cenumFrom :: CombinationName -> [CombinationName]
fromEnum :: CombinationName -> Int
$cfromEnum :: CombinationName -> Int
toEnum :: Int -> CombinationName
$ctoEnum :: Int -> CombinationName
pred :: CombinationName -> CombinationName
$cpred :: CombinationName -> CombinationName
succ :: CombinationName -> CombinationName
$csucc :: CombinationName -> CombinationName
Enum, (forall x. CombinationName -> Rep CombinationName x)
-> (forall x. Rep CombinationName x -> CombinationName)
-> Generic CombinationName
forall x. Rep CombinationName x -> CombinationName
forall x. CombinationName -> Rep CombinationName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CombinationName x -> CombinationName
$cfrom :: forall x. CombinationName -> Rep CombinationName x
Generic)

instance FromJSON CombinationName
instance ToJSON CombinationName

-- | This type represents a poker combination.

-- | It is divided by two constructors: for simple combinations (pair, set etc.)

-- | and for combinations with multiple items (two pairs, full house)

data Combination =
    RankCombination {
        Combination -> CombinationName
name :: CombinationName,
        Combination -> Card
rank :: Card
    } | PartCombination {
        name :: CombinationName,
        Combination -> Card
part1 :: Card,
        Combination -> Card
part2 :: Card
    } deriving (Int -> Combination -> ShowS
[Combination] -> ShowS
Combination -> String
(Int -> Combination -> ShowS)
-> (Combination -> String)
-> ([Combination] -> ShowS)
-> Show Combination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Combination] -> ShowS
$cshowList :: [Combination] -> ShowS
show :: Combination -> String
$cshow :: Combination -> String
showsPrec :: Int -> Combination -> ShowS
$cshowsPrec :: Int -> Combination -> ShowS
Show, (forall x. Combination -> Rep Combination x)
-> (forall x. Rep Combination x -> Combination)
-> Generic Combination
forall x. Rep Combination x -> Combination
forall x. Combination -> Rep Combination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Combination x -> Combination
$cfrom :: forall x. Combination -> Rep Combination x
Generic)

instance FromJSON Combination
instance ToJSON Combination

{- | Description of 'Eq' class for 'Combination'.

In case if simple `RankCombination` - equality by name and rank;
In case of complex `PartCombination` - by name, first part and second part;

__Examples:__

@
('RankCombination' 'Pair' $ 'Card' 'Three' 'Spades') == ('RankCombination' 'Pair' $ 'Card' 'Three' 'Heart') = 'True'
('RankCombination' 'Set' $ 'Card' 'Three' 'Spades') == ('RankCombination' 'Pair' $ 'Card' 'Three' 'Heart') = 'False'
('RankCombination' 'Set' $ 'Card' 'Three' 'Spades') == ('RankCombination' 'Straight' $ 'Card' 'Three' 'Heart') = 'False'
@
-}
instance Eq Combination where
    c1 :: Combination
c1@RankCombination {} == :: Combination -> Combination -> Bool
== c2 :: Combination
c2@RankCombination {} =
        Combination -> CombinationName
name Combination
c1 CombinationName -> CombinationName -> Bool
forall a. Eq a => a -> a -> Bool
== Combination -> CombinationName
name Combination
c2 Bool -> Bool -> Bool
&& Combination -> Card
rank Combination
c1 Card -> Card -> Bool
forall a. Eq a => a -> a -> Bool
== Combination -> Card
rank Combination
c2
    c1 :: Combination
c1@PartCombination {} == c2 :: Combination
c2@PartCombination {} =
        Combination -> CombinationName
name Combination
c1 CombinationName -> CombinationName -> Bool
forall a. Eq a => a -> a -> Bool
== Combination -> CombinationName
name Combination
c2 Bool -> Bool -> Bool
&& Combination -> Card
part1 Combination
c1 Card -> Card -> Bool
forall a. Eq a => a -> a -> Bool
== Combination -> Card
part1 Combination
c2 Bool -> Bool -> Bool
&& Combination -> Card
part2 Combination
c1 Card -> Card -> Bool
forall a. Eq a => a -> a -> Bool
== Combination -> Card
part2 Combination
c2
    Combination
c1 == Combination
c2 = Combination -> CombinationName
name Combination
c1 CombinationName -> CombinationName -> Bool
forall a. Eq a => a -> a -> Bool
== Combination -> CombinationName
name Combination
c2

{- | Description of 'Ord' class for 'Combination'.

In case if simple `RankCombination` - compare by name and rank;
In case of complex `PartCombination` - by name, first part and second part;

__Examples:__

@
('RankCombination' 'Pair' $ 'Card' 'Three' 'Spades') `compare` ('RankCombination' 'Pair' $ 'Card' 'Three' 'Heart') = 'EQ'
('RankCombination' 'Set' $ 'Card' 'Three' 'Spades') `compare` ('RankCombination' 'Pair' $ 'Card' 'Three' 'Heart') = 'GT'
('RankCombination' 'Set' $ 'Card' 'Three' 'Spades') `compare` ('RankCombination' 'Straight' $ 'Card' 'Three' 'Heart') = 'LT'
@
-}
instance Ord Combination where
    c1 :: Combination
c1@RankCombination{}  compare :: Combination -> Combination -> Ordering
`compare` c2 :: Combination
c2@RankCombination{}
        | Combination -> CombinationName
name Combination
c1 CombinationName -> CombinationName -> Bool
forall a. Eq a => a -> a -> Bool
== Combination -> CombinationName
name Combination
c2 = Combination -> Card
rank Combination
c1 Card -> Card -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Combination -> Card
rank Combination
c2
        | Bool
otherwise = Combination -> CombinationName
name Combination
c1 CombinationName -> CombinationName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Combination -> CombinationName
name Combination
c2
    c1 :: Combination
c1@PartCombination{}  `compare` c2 :: Combination
c2@PartCombination{}
        | Combination -> CombinationName
name Combination
c1 CombinationName -> CombinationName -> Bool
forall a. Eq a => a -> a -> Bool
/= Combination -> CombinationName
name Combination
c2 = Combination -> CombinationName
name Combination
c1 CombinationName -> CombinationName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Combination -> CombinationName
name Combination
c2
        | Combination -> Card
part1 Combination
c1 Card -> Card -> Bool
forall a. Eq a => a -> a -> Bool
== Combination -> Card
part1 Combination
c2 = Combination -> Card
part2 Combination
c1 Card -> Card -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Combination -> Card
part2 Combination
c2
        | Bool
otherwise = Combination -> Card
part1 Combination
c1 Card -> Card -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Combination -> Card
part1 Combination
c2
    Combination
c1 `compare` Combination
c2 = Combination -> CombinationName
name Combination
c1 CombinationName -> CombinationName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Combination -> CombinationName
name Combination
c2


parseCombination :: [Card] -> Either String Combination
parseCombination :: [Card] -> Either String Combination
parseCombination [Card]
cards
    | [Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
cards Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
3 Bool -> Bool -> Bool
&& [Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
cards Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
5 = String -> Either String Combination
forall a b. a -> Either a b
Left (String -> Either String Combination)
-> String -> Either String Combination
forall a b. (a -> b) -> a -> b
$ String
"Invalid line length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show([Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
cards)
    | [(Card, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Card, Int)]
pairs = [Card] -> Either String Combination
parseSequence [Card]
cards
    | Bool
otherwise = [(Card, Int)] -> Either String Combination
parsePartHand [(Card, Int)]
pairs
        where
            pairs :: [(Card, Int)]
pairs = [ (Card, Int)
occ | occ :: (Card, Int)
occ@(Card
card, Int
count) <- [Card] -> [(Card, Int)]
getOccurrences [Card]
cards, Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ]


-- | Type shorthand for occurrences counter wrapper

type OccurrencesCounter = [(Card, Int)]

{- | This function gets a list of cards and returns a list of tuples.
First element of which contains certain card, and second element contains number of occurences.

Function takes the head of the list and search for occurrences of its card in the tail.
Then, recursively calls itself for tail with that card removed from it.

__Examples:__

@
getOccurrences [
    'Card' {value = 'Ace', suit = 'Spades'},
    'Card' {value = 'Jack', suit = 'Clubs'},
    'Card' {value = 'Ace', suit = 'Hearts}
] = [(Card {value = Ace, suit = Spades},2),(Card {value = Jack, suit = Clubs},1)]
@
-}
getOccurrences :: [Card] -> OccurrencesCounter
getOccurrences :: [Card] -> [(Card, Int)]
getOccurrences [] = []
getOccurrences (Card
x:[Card]
xs) = (Card
x, [Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
xSameValue Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Card, Int) -> [(Card, Int)] -> [(Card, Int)]
forall a. a -> [a] -> [a]
: [Card] -> [(Card, Int)]
getOccurrences([Card]
xs [Card] -> [Card] -> [Card]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Card]
xSameValue)
    where
        xSameValue :: [Card]
xSameValue = (Card -> Bool) -> [Card] -> [Card]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Card
y -> Card -> Value
value Card
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Card -> Value
value Card
y) [Card]
xs

{- | This function parses occurences data and returns a combination, wrapped with 'Right',
or string err msg wrapped with 'Left'.
The input is list of tuples - [('Card', 'Int')], where first element is a card and seconds is number of its occurrences.
__Examples:__

@
parsePartHand [
     'Card' {value = 'Ace', suit = 'Spades'},
    'Card' {value = 'Jack', suit = 'Clubs'},
    'Card' {value = 'Ten', suit = 'Clubs'},
    'Card' {value = 'Queen', suit = 'Hearts},
    'Card' {value = 'King', suit = 'Hearts},
] = 'Right' 'RankCombination' 'Straight' 'Card' {value = 'Ace', suit = 'Spades'}
@
-}
parsePartHand :: OccurrencesCounter -> Either String Combination
parsePartHand :: [(Card, Int)] -> Either String Combination
parsePartHand [] = String -> Either String Combination
forall a b. a -> Either a b
Left String
"Can't process empty pairs array"
parsePartHand pairs :: [(Card, Int)]
pairs@((Card
yCard, Int
yCount):[(Card, Int)]
ys) = case [(Card, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Card, Int)]
pairs of
    Int
1 -> Either String Combination
singlePairHand
    Int
2 -> Either String Combination
multiplePairsHand
    Int
n -> String -> Either String Combination
forall a b. a -> Either a b
Left (String -> Either String Combination)
-> String -> Either String Combination
forall a b. (a -> b) -> a -> b
$ String
"Invalid number of pairs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
    where
        -- | In case if only one pair found (pair, set or four of a kind)

        singlePairHand :: Either String Combination
        singlePairHand :: Either String Combination
singlePairHand = case Int
yCount of
            Int
4 -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
FourOfAKind Card
yCard
            Int
3 -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
Set Card
yCard
            Int
2 -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
Pair Card
yCard
            Int
_ -> String -> Either String Combination
forall a b. a -> Either a b
Left (String -> Either String Combination)
-> String -> Either String Combination
forall a b. (a -> b) -> a -> b
$ String
"Single pair hand: found invalid number of pairs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
yCount

        -- | In case if multiple pairs found (two pairs or full house)

        multiplePairsHand :: Either String Combination
        multiplePairsHand :: Either String Combination
multiplePairsHand = case Int
multiplePairsSum of
            Int
4 -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Card -> Combination
PartCombination CombinationName
TwoPairs([Card] -> Card
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Card] -> Card) -> [Card] -> Card
forall a b. (a -> b) -> a -> b
$ ((Card, Int) -> Card) -> [(Card, Int)] -> [Card]
forall a b. (a -> b) -> [a] -> [b]
map (Card, Int) -> Card
forall a b. (a, b) -> a
fst [(Card, Int)]
pairs) ([Card] -> Card
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Card] -> Card) -> [Card] -> Card
forall a b. (a -> b) -> a -> b
$ ((Card, Int) -> Card) -> [(Card, Int)] -> [Card]
forall a b. (a -> b) -> [a] -> [b]
map (Card, Int) -> Card
forall a b. (a, b) -> a
fst [(Card, Int)]
pairs)
            Int
5 -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Card -> Combination
PartCombination CombinationName
FullHouse ((Card, Int) -> Card
forall a b. (a, b) -> a
fst ((Card, Int) -> Card)
-> ([(Card, Int)] -> (Card, Int)) -> [(Card, Int)] -> Card
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Card, Int)] -> (Card, Int)
forall a. [a] -> a
head ([(Card, Int)] -> Card) -> [(Card, Int)] -> Card
forall a b. (a -> b) -> a -> b
$ [(Card, Int)]
sortedPairsByCount) ((Card, Int) -> Card
forall a b. (a, b) -> a
fst ((Card, Int) -> Card)
-> ([(Card, Int)] -> (Card, Int)) -> [(Card, Int)] -> Card
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Card, Int)] -> (Card, Int)
forall a. [a] -> a
last ([(Card, Int)] -> Card) -> [(Card, Int)] -> Card
forall a b. (a -> b) -> a -> b
$ [(Card, Int)]
sortedPairsByCount)
            Int
_ -> String -> Either String Combination
forall a b. a -> Either a b
Left (String -> Either String Combination)
-> String -> Either String Combination
forall a b. (a -> b) -> a -> b
$ String
"Invalid multiple pairs sum: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
multiplePairsSum
            where
                -- | Sum counters to find out if it fits the valid combinations

                multiplePairsSum :: Int
                multiplePairsSum :: Int
multiplePairsSum = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Card, Int) -> Int) -> [(Card, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Card, Int) -> Int
forall a b. (a, b) -> b
snd [(Card, Int)]
pairs

                -- | Sort pairs to be able to get higher lower for combinations, where it matters

                sortedPairsByCount :: OccurrencesCounter
                sortedPairsByCount :: [(Card, Int)]
sortedPairsByCount = ((Card, Int) -> (Card, Int) -> Ordering)
-> [(Card, Int)] -> [(Card, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Card
_, Int
a) (Card
_, Int
b) -> Int
b Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
a) [(Card, Int)]
pairs

{- | This function parses sequences in cards line returns a combination, wrapped with 'Right',
or string err msg wrapped with 'Left'.
The input is list of cards - ['Card'].
__Examples:__

@
parseSequence [
    ('Card' {value = 'Ace', suit = 'Spades'}, 2),
    ('Card' {value = 'King', suit = 'Clubs'}, 2)
] = 'Right' 'PartCombination' 'TwoPairs' ('Card' {value = 'Ace', suit = 'Spades') ('Card' {value = 'King', suit = 'Clubs'})
@
-}
parseSequence :: [Card] -> Either String Combination
parseSequence :: [Card] -> Either String Combination
parseSequence [] = String -> Either String Combination
forall a b. a -> Either a b
Left String
"Can't process empty list"
parseSequence cards :: [Card]
cards@(Card
x:[Card]
xs) = case (Bool
isFlush, Bool
isSequence, Bool
isWheel) of
    ( Bool
False, Bool
True, Bool
False ) -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
Straight Card
maxCard
    ( Bool
False, Bool
False, Bool
True ) -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
Straight Card
maxCard
    ( Bool
True, Bool
False, Bool
False ) -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
Flush Card
maxCard
    ( Bool
True, Bool
True, Bool
False ) -> case Card -> Value
value Card
maxCard of
        Value
Ace -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
RoyalFlush Card
maxCard
        Value
_ -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
StraightFlush Card
maxCard
    ( Bool
True, Bool
False, Bool
True ) -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
StraightFlush Card
maxCard
    ( Bool
False, Bool
False, Bool
False ) -> Combination -> Either String Combination
forall a b. b -> Either a b
Right (Combination -> Either String Combination)
-> Combination -> Either String Combination
forall a b. (a -> b) -> a -> b
$ CombinationName -> Card -> Combination
RankCombination CombinationName
Kicker Card
maxCard
    (Bool, Bool, Bool)
_ -> String -> Either String Combination
forall a b. a -> Either a b
Left String
"Can't parse the combination"
    where
        -- | Simply sort cards

        sortedCards :: [Card]
        sortedCards :: [Card]
sortedCards = [Card] -> [Card]
forall a. Ord a => [a] -> [a]
sort [Card]
cards

        -- | Check if the line is a wheel (special variant of straight - A2345)

        isWheel :: Bool
        isWheel :: Bool
isWheel = (Card -> Value) -> [Card] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Card -> Value
value [Card]
sortedCards [Value] -> [Value] -> Bool
forall a. Eq a => a -> a -> Bool
== [Value
Two, Value
Three, Value
Four, Value
Five, Value
Ace]

        -- Check if the line is a flush (all suits are the same)

        isFlush :: Bool
        isFlush :: Bool
isFlush = [Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
cards Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5
            Bool -> Bool -> Bool
&& (Card -> Bool) -> [Card] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Suit -> Suit -> Bool
forall a. Eq a => a -> a -> Bool
== Card -> Suit
suit Card
x) (Suit -> Bool) -> (Card -> Suit) -> Card -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Card -> Suit
suit) [Card]
xs

        -- | Helper function for sequence checking

        getValueNum :: Int -> Int
        getValueNum :: Int -> Int
getValueNum Int
index = Value -> Int
forall a. Enum a => a -> Int
fromEnum (Value -> Int) -> (Card -> Value) -> Card -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Card -> Value
value (Card -> Int) -> Card -> Int
forall a b. (a -> b) -> a -> b
$ [Card]
sortedCards [Card] -> Int -> Card
forall a. [a] -> Int -> a
!! Int
index

        -- | Check whether sorted elements form a sequence

        isSequence :: Bool
        isSequence :: Bool
isSequence = [Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
cards Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5
            Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) [ Int -> Int
getValueNum Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
getValueNum (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) | Int
index <- [Int
1 .. [Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
sortedCards Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]

        -- | Get max card for the cards line

        maxCard :: Card
        maxCard :: Card
maxCard
            | Bool
isWheel = [Card] -> Card
forall a. [a] -> a
last ([Card] -> Card) -> [Card] -> Card
forall a b. (a -> b) -> a -> b
$ [Card] -> [Card]
forall a. [a] -> [a]
init [Card]
sortedCards
            | Bool
otherwise = [Card] -> Card
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Card]
cards