{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use bimap" #-}
{-# HLINT ignore "Use first" #-}
-- | Game calculations and its processing functions

module Game.Calc(PlayerInput(..), LineResult, LineType(..), PlayerCalculations(..), comparePlayers, calcGame) where
import CardParts.Cards (Card(..))
import Game.Combination
    ( Combination,
      CombinationName(..),
      Combination(RankCombination),
      Combination(..) )
import CardParts.Values (Value(..))
import CardParts.Suits (Suit(..))
import GHC.Generics (Generic)
import Data.Aeson (FromJSON, ToJSON)
import Data.List (find)

-- Type for player input values

data PlayerInput = PlayerInput {
    PlayerInput -> String
username :: String,
    PlayerInput -> [Combination]
board :: [Combination],
    PlayerInput -> Bool
scoop :: Bool,
    PlayerInput -> Bool
withFantasy :: Bool
} deriving (Int -> PlayerInput -> ShowS
[PlayerInput] -> ShowS
PlayerInput -> String
(Int -> PlayerInput -> ShowS)
-> (PlayerInput -> String)
-> ([PlayerInput] -> ShowS)
-> Show PlayerInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlayerInput] -> ShowS
$cshowList :: [PlayerInput] -> ShowS
show :: PlayerInput -> String
$cshow :: PlayerInput -> String
showsPrec :: Int -> PlayerInput -> ShowS
$cshowsPrec :: Int -> PlayerInput -> ShowS
Show, (forall x. PlayerInput -> Rep PlayerInput x)
-> (forall x. Rep PlayerInput x -> PlayerInput)
-> Generic PlayerInput
forall x. Rep PlayerInput x -> PlayerInput
forall x. PlayerInput -> Rep PlayerInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlayerInput x -> PlayerInput
$cfrom :: forall x. PlayerInput -> Rep PlayerInput x
Generic)

instance FromJSON PlayerInput
instance ToJSON PlayerInput


-- Enum for lines types

data LineType = Top | Middle | Bottom deriving (Int -> LineType -> ShowS
[LineType] -> ShowS
LineType -> String
(Int -> LineType -> ShowS)
-> (LineType -> String) -> ([LineType] -> ShowS) -> Show LineType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineType] -> ShowS
$cshowList :: [LineType] -> ShowS
show :: LineType -> String
$cshow :: LineType -> String
showsPrec :: Int -> LineType -> ShowS
$cshowsPrec :: Int -> LineType -> ShowS
Show, (forall x. LineType -> Rep LineType x)
-> (forall x. Rep LineType x -> LineType) -> Generic LineType
forall x. Rep LineType x -> LineType
forall x. LineType -> Rep LineType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineType x -> LineType
$cfrom :: forall x. LineType -> Rep LineType x
Generic)

instance FromJSON LineType
instance ToJSON LineType


-- Utility type to represent a pair of values

type IntPair = (Int, Int)

{- | Data container for lines comparison result.

First tuple element - list of strings.
Contains usernames of users, which are being compared.

Second tuple element - int.
Represents summ of combination points for first player.
No need to store the value for second user, as it would be the same, just negated (* -1).

Third tuple element - int.
Represents summ of bonuses for first player.
No need to store the value for second user, as it would be the same, just negated (* -1).

Fourth tuple element - list of (int, int) tuples.
This is used mainly for debug and contains each line comparison result.

-}
type LineCompareResult = ([String], Int, Int, [IntPair])


{- | Data container for line result for the user.

Contains data about type of line (position - top/middle/bottom),
about points for the combination,
total values for combo/bonus points after comparison with others.

-}
data LineResult = LineResult {
    LineResult -> LineType
lineType :: LineType,
    LineResult -> Maybe Combination
combination :: Maybe Combination,
    LineResult -> Int
points :: Int,
    LineResult -> Int
totalCombination :: Int,
    LineResult -> Int
totalBonus :: Int
} deriving (Int -> LineResult -> ShowS
[LineResult] -> ShowS
LineResult -> String
(Int -> LineResult -> ShowS)
-> (LineResult -> String)
-> ([LineResult] -> ShowS)
-> Show LineResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineResult] -> ShowS
$cshowList :: [LineResult] -> ShowS
show :: LineResult -> String
$cshow :: LineResult -> String
showsPrec :: Int -> LineResult -> ShowS
$cshowsPrec :: Int -> LineResult -> ShowS
Show, (forall x. LineResult -> Rep LineResult x)
-> (forall x. Rep LineResult x -> LineResult) -> Generic LineResult
forall x. Rep LineResult x -> LineResult
forall x. LineResult -> Rep LineResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineResult x -> LineResult
$cfrom :: forall x. LineResult -> Rep LineResult x
Generic)

instance FromJSON LineResult
instance ToJSON LineResult


{- | Container for result of calculations for each player.

Contains data about given player input,
description of each line in form of 'LineResult',
some utility bool values, such as 'isScoop', 'isNextFantasy'.
Also has total sum of points for user after comparison.
And a debug detailed version of the total (totalDetailed field).

-}
data PlayerCalculations = PlayerCalculations {
    PlayerCalculations -> PlayerInput
player :: PlayerInput,
    PlayerCalculations -> LineResult
top :: LineResult,
    PlayerCalculations -> LineResult
middle :: LineResult,
    PlayerCalculations -> LineResult
bottom :: LineResult,
    PlayerCalculations -> Bool
isScoop :: Bool,
    PlayerCalculations -> Bool
isNextFantasy :: Bool,
    PlayerCalculations -> (String, [LineCompareResult])
totalDetailed :: (String, [LineCompareResult]),
    PlayerCalculations -> Int
total :: Int
} deriving ((forall x. PlayerCalculations -> Rep PlayerCalculations x)
-> (forall x. Rep PlayerCalculations x -> PlayerCalculations)
-> Generic PlayerCalculations
forall x. Rep PlayerCalculations x -> PlayerCalculations
forall x. PlayerCalculations -> Rep PlayerCalculations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlayerCalculations x -> PlayerCalculations
$cfrom :: forall x. PlayerCalculations -> Rep PlayerCalculations x
Generic)

instance FromJSON PlayerCalculations
instance ToJSON PlayerCalculations


{- | Main function for game calculation.

Takes a list of 'PlayerInput;, which length should be 3.
Return a list of 'PlayerCalculations'.

First of all, function receives all players comparison using 'collectLinesResults'.
Then it checks for input conditions:
length of input and length of comparison results should be equal and should equal 3.

Then for each of player input function creates 'PlayerCalculations' record.
-}
calcGame :: [PlayerInput] -> [PlayerCalculations]
calcGame :: [PlayerInput] -> [PlayerCalculations]
calcGame [PlayerInput]
playerInputs
  | [PlayerInput] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PlayerInput]
playerInputs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
3 = String -> [PlayerCalculations]
forall a. HasCallStack => String -> a
error String
"Invalid number of players"
  | [(String, [LineCompareResult])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, [LineCompareResult])]
linesResults Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
3 = String -> [PlayerCalculations]
forall a. HasCallStack => String -> a
error String
"Invalid number of linesResults"
  | Bool
otherwise = (Int -> PlayerCalculations) -> [Int] -> [PlayerCalculations]
forall a b. (a -> b) -> [a] -> [b]
map Int -> PlayerCalculations
mapLinesResults [Int
0..Int
2]
  where
    -- Value which holds result of lines comparison for all inputs

    linesResults :: [(String, [LineCompareResult])]
    linesResults :: [(String, [LineCompareResult])]
linesResults = [LineCompareResult]
-> [PlayerInput]
-> [PlayerInput]
-> [(String, [LineCompareResult])]
collectLinesResults [] [PlayerInput]
playerInputs [PlayerInput]
playerInputs

    {-| Mapping function for each given 'PlayerInput'.
        Given int argument - index of player.
    -}
    mapLinesResults :: Int -> PlayerCalculations
    mapLinesResults :: Int -> PlayerCalculations
mapLinesResults Int
index = PlayerCalculations :: PlayerInput
-> LineResult
-> LineResult
-> LineResult
-> Bool
-> Bool
-> (String, [LineCompareResult])
-> Int
-> PlayerCalculations
PlayerCalculations {
      -- player is simply copy of input, on which calc is based

      player :: PlayerInput
player = [PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index,

      -- isScoop is bool value to define whether the scoop for the user occurred

      isScoop :: Bool
isScoop = PlayerInput -> Bool
scoop (PlayerInput -> Bool) -> PlayerInput -> Bool
forall a b. (a -> b) -> a -> b
$ [PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index,

      -- isNextFantasy is bool value to determine thether the fantasy

      isNextFantasy :: Bool
isNextFantasy =
        Bool -> Bool
not (PlayerInput -> Bool
scoop ([PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index)) Bool -> Bool -> Bool
&& -- scoop should not occur for fantasy to be true

        Bool -> [Combination] -> Bool
nextIsFantasy -- call of function which calculates whether next hand is fantasy

        (PlayerInput -> Bool
withFantasy (PlayerInput -> Bool) -> PlayerInput -> Bool
forall a b. (a -> b) -> a -> b
$ [PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index) -- withFantasy getter to find out whether fantasy is on currently

        (PlayerInput -> [Combination]
board (PlayerInput -> [Combination]) -> PlayerInput -> [Combination]
forall a b. (a -> b) -> a -> b
$ [PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index),

      -- top line data

      top :: LineResult
top = LineResult :: LineType -> Maybe Combination -> Int -> Int -> Int -> LineResult
LineResult {
        combination :: Maybe Combination
combination = PlayerInput -> Int -> Maybe Combination
combinationByIndex ([PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index) Int
0, -- top line has index 0,

        lineType :: LineType
lineType = LineType
Top,
        points :: Int
points = LineType -> Maybe Combination -> Int
pointsCalc LineType
Top (PlayerInput -> Int -> Maybe Combination
combinationByIndex ([PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index) Int
0),
        totalCombination :: Int
totalCombination = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
getLinePoints Int
index Int
0,
        totalBonus :: Int
totalBonus = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
getLinePoints Int
index Int
0
      },

      -- middle line data

      middle :: LineResult
middle = LineResult :: LineType -> Maybe Combination -> Int -> Int -> Int -> LineResult
LineResult {
        combination :: Maybe Combination
combination = PlayerInput -> Int -> Maybe Combination
combinationByIndex ([PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index) Int
1, -- middle line has index 1,

        lineType :: LineType
lineType = LineType
Middle,
        points :: Int
points = LineType -> Maybe Combination -> Int
pointsCalc LineType
Middle (PlayerInput -> Int -> Maybe Combination
combinationByIndex ([PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index) Int
1),
        totalCombination :: Int
totalCombination = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
getLinePoints Int
index Int
1,
        totalBonus :: Int
totalBonus = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
getLinePoints Int
index Int
1
      },

      -- bottom line data

      bottom :: LineResult
bottom = LineResult :: LineType -> Maybe Combination -> Int -> Int -> Int -> LineResult
LineResult {
        combination :: Maybe Combination
combination = PlayerInput -> Int -> Maybe Combination
combinationByIndex ([PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index) Int
2, -- bottom line has index 2,

        lineType :: LineType
lineType = LineType
Bottom,
        points :: Int
points = LineType -> Maybe Combination -> Int
pointsCalc LineType
Bottom (PlayerInput -> Int -> Maybe Combination
combinationByIndex ([PlayerInput]
playerInputs [PlayerInput] -> Int -> PlayerInput
forall a. [a] -> Int -> a
!! Int
index) Int
2),
        totalCombination :: Int
totalCombination = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
getLinePoints Int
index Int
2,
        totalBonus :: Int
totalBonus = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
getLinePoints Int
index Int
2
      },

      -- debug value with detailed calc steps for total points

      totalDetailed :: (String, [LineCompareResult])
totalDetailed = [(String, [LineCompareResult])]
linesResults [(String, [LineCompareResult])]
-> Int -> (String, [LineCompareResult])
forall a. [a] -> Int -> a
!! Int
index,

      -- summ of all related to player totals in one number

      total :: Int
total = (String, [LineCompareResult]) -> Int
totalPoints ([(String, [LineCompareResult])]
linesResults [(String, [LineCompareResult])]
-> Int -> (String, [LineCompareResult])
forall a. [a] -> Int -> a
!! Int
index)
      }

    -- simple getter for combination by index of the board

    combinationByIndex :: PlayerInput -> Int -> Maybe Combination
    combinationByIndex :: PlayerInput -> Int -> Maybe Combination
combinationByIndex PlayerInput
playerInput Int
index
      | PlayerInput -> Bool
scoop PlayerInput
playerInput = Maybe Combination
forall a. Maybe a
Nothing
      | Bool
otherwise = Combination -> Maybe Combination
forall a. a -> Maybe a
Just (Combination -> Maybe Combination)
-> Combination -> Maybe Combination
forall a b. (a -> b) -> a -> b
$ PlayerInput -> [Combination]
board PlayerInput
playerInput [Combination] -> Int -> Combination
forall a. [a] -> Int -> a
!! Int
index

    -- simpe function to summ combination points of line comparison with its bonus points

    getTotal :: LineCompareResult -> Int
    getTotal :: LineCompareResult -> Int
getTotal ([String]
_, Int
combo, Int
bonus, [(Int, Int)]
_) = Int
combo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bonus

    -- function to summ all temp results into one total number

    totalPoints ::  (String, [LineCompareResult]) -> Int
    totalPoints :: (String, [LineCompareResult]) -> Int
totalPoints (String
_, [LineCompareResult]
compareResults) = (Int -> LineCompareResult -> Int)
-> Int -> [LineCompareResult] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc LineCompareResult
r -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LineCompareResult -> Int
getTotal LineCompareResult
r) Int
0 [LineCompareResult]
compareResults

    -- function to determine whether the next hand is fantasy

    nextIsFantasy :: Bool -> [Combination] -> Bool
    nextIsFantasy :: Bool -> [Combination] -> Bool
nextIsFantasy Bool
withFantasy [] = Bool
False
    nextIsFantasy Bool
withFantasy (Combination
top:Combination
middle:Combination
bottom:[Combination]
_)
      | Bool
withFantasy =
        Combination
top Combination -> Combination -> Bool
forall a. Ord a => a -> a -> Bool
>= CombinationName -> Card -> Combination
RankCombination CombinationName
Set (Value -> Suit -> Card
Card Value
Two Suit
Hearts)
        Bool -> Bool -> Bool
|| Combination
middle Combination -> Combination -> Bool
forall a. Ord a => a -> a -> Bool
>= CombinationName -> Card -> Card -> Combination
PartCombination CombinationName
FullHouse (Value -> Suit -> Card
Card Value
Two Suit
Hearts) (Value -> Suit -> Card
Card Value
Three Suit
Hearts)
        Bool -> Bool -> Bool
|| Combination
bottom Combination -> Combination -> Bool
forall a. Ord a => a -> a -> Bool
>= CombinationName -> Card -> Combination
RankCombination CombinationName
FourOfAKind (Value -> Suit -> Card
Card Value
Two Suit
Hearts)
      | Bool
otherwise =
        Combination
top Combination -> Combination -> Bool
forall a. Ord a => a -> a -> Bool
>= CombinationName -> Card -> Combination
RankCombination CombinationName
Pair (Value -> Suit -> Card
Card Value
Queen Suit
Hearts)
        Bool -> Bool -> Bool
|| Combination
middle Combination -> Combination -> Bool
forall a. Ord a => a -> a -> Bool
>= CombinationName -> Card -> Card -> Combination
PartCombination CombinationName
FullHouse (Value -> Suit -> Card
Card Value
Two Suit
Hearts) (Value -> Suit -> Card
Card Value
Three Suit
Hearts)
        Bool -> Bool -> Bool
|| Combination
bottom Combination -> Combination -> Bool
forall a. Ord a => a -> a -> Bool
>= CombinationName -> Card -> Combination
RankCombination CombinationName
StraightFlush (Value -> Suit -> Card
Card Value
Five Suit
Hearts)
    nextIsFantasy Bool
_ [Combination]
_ = Bool
False

    -- getter for points for each exact line compared

    getLinePoints :: Int -> Int -> IntPair
    getLinePoints :: Int -> Int -> (Int, Int)
getLinePoints Int
playerIndex Int
lineIndex
      = ((Int, Int) -> LineCompareResult -> (Int, Int))
-> (Int, Int) -> [LineCompareResult] -> (Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
        (\(Int
comboAcc, Int
bonusAcc) ([String]
_, Int
_, Int
_, [(Int, Int)]
debug) -> (Int
comboAcc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Int) -> Int
forall a b. (a, b) -> a
fst ([(Int, Int)]
debug [(Int, Int)] -> Int -> (Int, Int)
forall a. [a] -> Int -> a
!! Int
lineIndex), Int
bonusAcc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)]
debug [(Int, Int)] -> Int -> (Int, Int)
forall a. [a] -> Int -> a
!! Int
lineIndex)))
        (Int
0, Int
0)
        ((String, [LineCompareResult]) -> [LineCompareResult]
forall a b. (a, b) -> b
snd ([(String, [LineCompareResult])]
linesResults [(String, [LineCompareResult])]
-> Int -> (String, [LineCompareResult])
forall a. [a] -> Int -> a
!! Int
playerIndex))


{-| Function to collect all results of line comparison between all users.

Uses recustion and accumulator to avoid redundant calculations.
For example, if "user1" vs "user2" has been already compared -
no need to compare "user2" vs "user1" - we could just mirror the existing result instead.

Function takes initial acc (empty array by default),
list of player inputs in form of '[PlayerInput]',
and the same list so it could be passed further without mutating it through recursion.

Result is list of three items - one per 'PlayerInput'.
It contains info about username and each line comparison for the user vs other users.

-}
collectLinesResults :: [LineCompareResult] -> [PlayerInput] -> [PlayerInput] -> [(String, [LineCompareResult])]
collectLinesResults :: [LineCompareResult]
-> [PlayerInput]
-> [PlayerInput]
-> [(String, [LineCompareResult])]
collectLinesResults [LineCompareResult]
acc [PlayerInput]
full (PlayerInput
currPlayer:[PlayerInput]
players) =
  (PlayerInput -> String
username PlayerInput
currPlayer, (PlayerInput -> LineCompareResult)
-> [PlayerInput] -> [LineCompareResult]
forall a b. (a -> b) -> [a] -> [b]
map (PlayerInput -> PlayerInput -> LineCompareResult
getResult PlayerInput
currPlayer) [PlayerInput]
otherInputs) (String, [LineCompareResult])
-> [(String, [LineCompareResult])]
-> [(String, [LineCompareResult])]
forall a. a -> [a] -> [a]
: [LineCompareResult]
-> [PlayerInput]
-> [PlayerInput]
-> [(String, [LineCompareResult])]
collectLinesResults ([LineCompareResult]
acc [LineCompareResult] -> [LineCompareResult] -> [LineCompareResult]
forall a. [a] -> [a] -> [a]
++ (PlayerInput -> LineCompareResult)
-> [PlayerInput] -> [LineCompareResult]
forall a b. (a -> b) -> [a] -> [b]
map (PlayerInput -> PlayerInput -> LineCompareResult
getResult PlayerInput
currPlayer) [PlayerInput]
otherInputs) [PlayerInput]
full [PlayerInput]
players
    where
      -- Filter function to avoid self-comparison

      otherInputs :: [PlayerInput]
      otherInputs :: [PlayerInput]
otherInputs = (PlayerInput -> Bool) -> [PlayerInput] -> [PlayerInput]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PlayerInput
player -> PlayerInput -> String
username PlayerInput
player String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= PlayerInput -> String
username PlayerInput
currPlayer) [PlayerInput]
full

      -- Mirroring of comparison results to be able to make ("u1" vs "u2") into ("u2" vs "u1")

      negateTuple :: IntPair -> IntPair
      negateTuple :: (Int, Int) -> (Int, Int)
negateTuple (Int
a, Int
b) = (Int -> Int
forall a. Num a => a -> a
negate Int
a, Int -> Int
forall a. Num a => a -> a
negate Int
b)

      -- Function which tries to get existant result from the accumulator to avoid double calc

      getResult :: PlayerInput -> PlayerInput -> ([String], Int, Int, [IntPair])
      getResult :: PlayerInput -> PlayerInput -> LineCompareResult
getResult PlayerInput
player1 PlayerInput
player2 = case (LineCompareResult -> Bool)
-> [LineCompareResult] -> Maybe LineCompareResult
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\([String]
usernames, Int
_, Int
_, [(Int, Int)]
_) -> [String]
usernames [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [PlayerInput -> String
username PlayerInput
player2, PlayerInput -> String
username PlayerInput
player1] ) [LineCompareResult]
acc of
        Just ([String]
usernames, Int
combo, Int
bonus, [(Int, Int)]
debug) -> ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
usernames, Int -> Int
forall a. Num a => a -> a
negate Int
combo, Int -> Int
forall a. Num a => a -> a
negate Int
bonus, ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> (Int, Int)
negateTuple [(Int, Int)]
debug)
        Maybe LineCompareResult
_ -> PlayerInput -> PlayerInput -> LineCompareResult
comparePlayers PlayerInput
player1 PlayerInput
player2
collectLinesResults [LineCompareResult]
acc [PlayerInput]
_ [] = []


{-| Function to compare 'PlayerInput' records and retrieve calculated points.
    Takes two 'PlayerInput' as input. Returns calculated points in form of 'LineCompareResult'
 -}
comparePlayers :: PlayerInput -> PlayerInput -> LineCompareResult
comparePlayers :: PlayerInput -> PlayerInput -> LineCompareResult
comparePlayers
  p1 :: PlayerInput
p1@PlayerInput{ username :: PlayerInput -> String
username = String
p1name, board :: PlayerInput -> [Combination]
board = [Combination]
boardP1, scoop :: PlayerInput -> Bool
scoop = Bool
p1scoop }
  p2 :: PlayerInput
p2@PlayerInput{ username :: PlayerInput -> String
username = String
p2name, board :: PlayerInput -> [Combination]
board = [Combination]
boardP2, scoop :: PlayerInput -> Bool
scoop = Bool
p2scoop } = (
    -- List of usernames of compared players

    [String
p1name, String
p2name],

    -- Summ of all combo points from all lines compared

    [(Int, Int)] -> Int
foldPoints [(Int, Int)
topPoints, (Int, Int)
middlePoints, (Int, Int)
bottomPoints],

    -- Sum of all bonuses from all lines compared

    Int
bonusCalculated,

    -- Debug info by each line

    [
      ((Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) (Int, Int)
topPoints, Int
topBonus),
      ((Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) (Int, Int)
middlePoints, Int
middleBonus),
      ((Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) (Int, Int)
bottomPoints, Int
bottomBonus)
    ]
  ) where
    -- Top points getter with scoop considered

    topPoints :: IntPair
    topPoints :: (Int, Int)
topPoints = (
      if Bool
p1scoop then Int
0 else LineType -> Combination -> Int
getPoints LineType
Top ([Combination] -> Combination
forall a. [a] -> a
head [Combination]
boardP1),
      if Bool
p2scoop then Int
0 else LineType -> Combination -> Int
getPoints LineType
Top ([Combination] -> Combination
forall a. [a] -> a
head [Combination]
boardP2)
      )

    -- Middle points getter with scoop considered

    middlePoints :: IntPair
    middlePoints :: (Int, Int)
middlePoints = (
      if Bool
p1scoop then Int
0 else LineType -> Combination -> Int
getPoints LineType
Middle ([Combination] -> Combination
forall a. [a] -> a
head ([Combination] -> Combination) -> [Combination] -> Combination
forall a b. (a -> b) -> a -> b
$ [Combination] -> [Combination]
forall a. [a] -> [a]
tail [Combination]
boardP1),
      if Bool
p2scoop then Int
0 else LineType -> Combination -> Int
getPoints LineType
Middle ([Combination] -> Combination
forall a. [a] -> a
head ([Combination] -> Combination) -> [Combination] -> Combination
forall a b. (a -> b) -> a -> b
$ [Combination] -> [Combination]
forall a. [a] -> [a]
tail [Combination]
boardP2)
      )

    -- Bottom points getter with scoop considered

    bottomPoints :: IntPair
    bottomPoints :: (Int, Int)
bottomPoints = (
      if Bool
p1scoop then Int
0 else LineType -> Combination -> Int
getPoints LineType
Bottom ([Combination] -> Combination
forall a. [a] -> a
last [Combination]
boardP1),
      if Bool
p2scoop then Int
0 else LineType -> Combination -> Int
getPoints LineType
Bottom ([Combination] -> Combination
forall a. [a] -> a
last [Combination]
boardP2)
      )

    -- Create a tuple from number. First elem is the same number, and second one is the number mirrored

    mirrorPoints :: Int -> IntPair
    mirrorPoints :: Int -> (Int, Int)
mirrorPoints Int
p = (Int
p, Int -> Int
forall a. Num a => a -> a
negate Int
p)

    -- Value which hold info about whether scoop occurred

    anyScoop :: Bool
    anyScoop :: Bool
anyScoop = Bool
p1scoop Bool -> Bool -> Bool
|| Bool
p2scoop

    -- Bonus getter for case when no scoop occurred

    getDefaultBonus :: Combination -> Combination -> Int
    getDefaultBonus :: Combination -> Combination -> Int
getDefaultBonus Combination
c1 Combination
c2
      | Combination
c1 Combination -> Combination -> Bool
forall a. Ord a => a -> a -> Bool
> Combination
c2 = Int
1
      | Combination
c1 Combination -> Combination -> Bool
forall a. Eq a => a -> a -> Bool
== Combination
c2 = Int
0
      | Bool
otherwise = -Int
1

    -- Bonus getter for case when scoop occurred

    getScoopBonus :: Int
    getScoopBonus :: Int
getScoopBonus = case (Bool
p1scoop, Bool
p2scoop) of
      (Bool
True, Bool
True) -> Int
0
      (Bool
True, Bool
False) -> -Int
1
      (Bool
False, Bool
True) -> Int
1
      (Bool
False, Bool
False) -> String -> Int
forall a. HasCallStack => String -> a
error String
"getDefaultBonus shouldb be used for this case"

    -- Top line bonus calc with ability for scoop considered

    topBonus :: Int
    topBonus :: Int
topBonus
      | Bool
anyScoop = Int
getScoopBonus
      | Bool
otherwise = Combination -> Combination -> Int
getDefaultBonus ([Combination] -> Combination
forall a. [a] -> a
head [Combination]
boardP1) ([Combination] -> Combination
forall a. [a] -> a
head [Combination]
boardP2)

     -- Middle line bonus calc with ability for scoop considered

    middleBonus :: Int
    middleBonus :: Int
middleBonus
      | Bool
anyScoop = Int
getScoopBonus
      | Bool
otherwise = Combination -> Combination -> Int
getDefaultBonus ([Combination] -> Combination
forall a. [a] -> a
head ([Combination] -> Combination) -> [Combination] -> Combination
forall a b. (a -> b) -> a -> b
$ [Combination] -> [Combination]
forall a. [a] -> [a]
tail [Combination]
boardP1) ([Combination] -> Combination
forall a. [a] -> a
head ([Combination] -> Combination) -> [Combination] -> Combination
forall a b. (a -> b) -> a -> b
$ [Combination] -> [Combination]
forall a. [a] -> [a]
tail [Combination]
boardP2)

     -- Bottom line bonus calc with ability for scoop considered

    bottomBonus :: Int
    bottomBonus :: Int
bottomBonus
      | Bool
anyScoop = Int
getScoopBonus
      | Bool
otherwise = Combination -> Combination -> Int
getDefaultBonus ([Combination] -> Combination
forall a. [a] -> a
last [Combination]
boardP1) ([Combination] -> Combination
forall a. [a] -> a
last [Combination]
boardP2)

    -- Summ of all bonuses calculated

    summBonus :: Int
    summBonus :: Int
summBonus = Int
topBonus Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
middleBonus Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bottomBonus

    -- Extra points for all lines won calculation

    bonusCalculated :: Int
    bonusCalculated :: Int
bonusCalculated = case Int
topBonus Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
middleBonus Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bottomBonus of
      Int
3 -> Int
6
      (-3) -> -Int
6
      Int
b -> Int
b

-- Function to reduce all points represented as int pairs to a single number

foldPoints :: [IntPair] -> Int
foldPoints :: [(Int, Int)] -> Int
foldPoints [] = Int
0
foldPoints ((Int
r1, Int
r2):[(Int, Int)]
xs) = (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(Int, Int)] -> Int
foldPoints [(Int, Int)]
xs

-- Value which holds points data for middle line

middlePoints :: [Int]
middlePoints :: [Int]
middlePoints = [Int
0, Int
0, Int
0, Int
2, Int
4, Int
8, Int
12, Int
20, Int
30, Int
50]

-- Value which holds points data for bottom line, calculated based on 'middlePoints'

bottomPoints :: [Int]
bottomPoints :: [Int]
bottomPoints = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
p -> if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then Int
p Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 else Int
0) [Int]
middlePoints

-- Wrapper for 'getPoints' with ability of combination being 'Nothing' is case of scoop

pointsCalc :: LineType -> Maybe Combination -> Int
pointsCalc :: LineType -> Maybe Combination -> Int
pointsCalc LineType
lineType Maybe Combination
combo = case Maybe Combination
combo of
  Just Combination
c -> LineType -> Combination -> Int
getPoints LineType
lineType Combination
c
  Maybe Combination
Nothing -> Int
0

-- Combination points getter

getPoints :: LineType -> Combination -> Int
getPoints :: LineType -> Combination -> Int
getPoints LineType
Top (RankCombination CombinationName
Pair (Card Value
rank Suit
_)) =
    if Value -> Int
forall a. Enum a => a -> Int
fromEnum Value
rank Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then Int
0 else Value -> Int
forall a. Enum a => a -> Int
fromEnum Value
rank Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3
getPoints LineType
Top (RankCombination CombinationName
Set (Card Value
rank Suit
_)) = Value -> Int
forall a. Enum a => a -> Int
fromEnum Value
rank Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
getPoints LineType
Top Combination
_ = Int
0
getPoints LineType
Middle Combination
c = [Int]
middlePoints [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! CombinationName -> Int
forall a. Enum a => a -> Int
fromEnum (Combination -> CombinationName
name Combination
c)
getPoints LineType
Bottom Combination
c = [Int]
bottomPoints [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! CombinationName -> Int
forall a. Enum a => a -> Int
fromEnum (Combination -> CombinationName
name Combination
c)