--------------------------------------------------------------------------------

module Codeforces.Virtual.Types where

import           Codeforces.Types.Common
import           Codeforces.Types.Party

import           Data.List
import qualified Data.Map                      as M

--------------------------------------------------------------------------------

virtualHandle :: Handle
virtualHandle :: Handle
virtualHandle = Text -> Handle
Handle Text
"VIRTUAL_USER"

-- | A 'Party' representing the user's virtual participation.
virtualParty :: Party
virtualParty :: Party
virtualParty = Party :: Maybe ContestId
-> [Member]
-> ParticipantType
-> Maybe Int
-> Maybe Text
-> Bool
-> Maybe Int
-> Maybe UTCTime
-> Party
Party { partyContestId :: Maybe ContestId
partyContestId       = Maybe ContestId
forall a. Maybe a
Nothing
                     , partyMembers :: [Member]
partyMembers         = [Handle -> Member
Member Handle
virtualHandle]
                     , partyParticipantType :: ParticipantType
partyParticipantType = ParticipantType
Virtual
                     , partyTeamId :: Maybe Int
partyTeamId          = Maybe Int
forall a. Maybe a
Nothing
                     , partyTeamName :: Maybe Text
partyTeamName        = Maybe Text
forall a. Maybe a
Nothing
                     , partyIsGhost :: Bool
partyIsGhost         = Bool
False
                     , partyRoom :: Maybe Int
partyRoom            = Maybe Int
forall a. Maybe a
Nothing
                     , partyStartTime :: Maybe UTCTime
partyStartTime       = Maybe UTCTime
forall a. Maybe a
Nothing
                     }

-- | Represents the virtual participation of the user in this contest.
data VirtualUser = VirtualUser
    { VirtualUser -> Points
vuPoints  :: Points   -- ^ Points scored in the virtual contest.
    , VirtualUser -> Int
vuPenalty :: Int      -- ^ User's penalty in the virtual contest.
    , VirtualUser -> Int
vuRating  :: Rating   -- ^ Current rating of the user.
    }
    deriving Int -> VirtualUser -> ShowS
[VirtualUser] -> ShowS
VirtualUser -> String
(Int -> VirtualUser -> ShowS)
-> (VirtualUser -> String)
-> ([VirtualUser] -> ShowS)
-> Show VirtualUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VirtualUser] -> ShowS
$cshowList :: [VirtualUser] -> ShowS
show :: VirtualUser -> String
$cshow :: VirtualUser -> String
showsPrec :: Int -> VirtualUser -> ShowS
$cshowsPrec :: Int -> VirtualUser -> ShowS
Show

--------------------------------------------------------------------------------

-- | Difference in rating between a user's current rating, and their rating
-- following this contest.
type Delta = Int

-- | The seed is the expected ranking for each participant before the contest
-- begins.
--
-- A contestant's rating increases should they perform better than their seed,
-- and decreases should they perform worse.
--
type Seed = Float

-- | The participation of a user in a contest.
data Contestant = Contestant
    { Contestant -> Party
contestantParty  :: Party
    , Contestant -> Int
contestantRank   :: Int
    , Contestant -> Points
contestantPoints :: Points
    , Contestant -> Int
contestantRating :: Rating
    }
    deriving (Contestant -> Contestant -> Bool
(Contestant -> Contestant -> Bool)
-> (Contestant -> Contestant -> Bool) -> Eq Contestant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contestant -> Contestant -> Bool
$c/= :: Contestant -> Contestant -> Bool
== :: Contestant -> Contestant -> Bool
$c== :: Contestant -> Contestant -> Bool
Eq, Int -> Contestant -> ShowS
[Contestant] -> ShowS
Contestant -> String
(Int -> Contestant -> ShowS)
-> (Contestant -> String)
-> ([Contestant] -> ShowS)
-> Show Contestant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contestant] -> ShowS
$cshowList :: [Contestant] -> ShowS
show :: Contestant -> String
$cshow :: Contestant -> String
showsPrec :: Int -> Contestant -> ShowS
$cshowsPrec :: Int -> Contestant -> ShowS
Show)

-- | Finds a single contestant from the given 'Party', or @Nothing@ if none
-- found.
findContestant :: Party -> [Contestant] -> Maybe Contestant
findContestant :: Party -> [Contestant] -> Maybe Contestant
findContestant Party
p = (Contestant -> Bool) -> [Contestant] -> Maybe Contestant
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Party
p Party -> Party -> Bool
forall a. Eq a => a -> a -> Bool
==) (Party -> Bool) -> (Contestant -> Party) -> Contestant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contestant -> Party
contestantParty)

data ContestResults = ContestResults
    { ContestResults -> [Contestant]
crContestants :: [Contestant]
    , ContestResults -> Map Party Int
crDeltas      :: M.Map Party Delta
    , ContestResults -> Map Int Points
crSeeds       :: M.Map Rating Seed
    }
    deriving Int -> ContestResults -> ShowS
[ContestResults] -> ShowS
ContestResults -> String
(Int -> ContestResults -> ShowS)
-> (ContestResults -> String)
-> ([ContestResults] -> ShowS)
-> Show ContestResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContestResults] -> ShowS
$cshowList :: [ContestResults] -> ShowS
show :: ContestResults -> String
$cshow :: ContestResults -> String
showsPrec :: Int -> ContestResults -> ShowS
$cshowsPrec :: Int -> ContestResults -> ShowS
Show

-- | A virtual participation result
data VirtualResult = VirtualResult
    { VirtualResult -> Int
virtualRank  :: Int
    , VirtualResult -> Int
virtualDelta :: Delta
    , VirtualResult -> Points
virtualSeed  :: Seed
    }
    deriving Int -> VirtualResult -> ShowS
[VirtualResult] -> ShowS
VirtualResult -> String
(Int -> VirtualResult -> ShowS)
-> (VirtualResult -> String)
-> ([VirtualResult] -> ShowS)
-> Show VirtualResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VirtualResult] -> ShowS
$cshowList :: [VirtualResult] -> ShowS
show :: VirtualResult -> String
$cshow :: VirtualResult -> String
showsPrec :: Int -> VirtualResult -> ShowS
$cshowsPrec :: Int -> VirtualResult -> ShowS
Show

--------------------------------------------------------------------------------