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

-- | Standings command.
module Codeforces.App.Commands.StandingsCmd
    ( standingsList
    ) where

import           Codeforces.API          hiding ( RankColor(..) )
import           Codeforces.App.Format
import           Codeforces.App.Options
import           Codeforces.App.Table
import           Codeforces.App.Watcher
import           Codeforces.Error

import           Control.Monad.Trans.Except

import qualified Data.Map                      as M
import           Data.Text                      ( Text )
import qualified Data.Text                     as T

import           System.Console.ANSI.Types

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

standingsList :: ContestId -> UserConfig -> StandingOpts -> IO ()
standingsList :: ContestId -> UserConfig -> StandingOpts -> IO ()
standingsList ContestId
cId UserConfig
cfg StandingOpts {Bool
Int
Maybe Int
optStandWatch :: StandingOpts -> Bool
optFriends :: StandingOpts -> Bool
optRoom :: StandingOpts -> Maybe Int
optRowCount :: StandingOpts -> Int
optFromIndex :: StandingOpts -> Int
optShowUnofficial :: StandingOpts -> Bool
optStandWatch :: Bool
optFriends :: Bool
optRoom :: Maybe Int
optRowCount :: Int
optFromIndex :: Int
optShowUnofficial :: Bool
..} =
    Bool -> IO (Either CodeforcesError Table) -> IO ()
handleWatch Bool
optStandWatch (IO (Either CodeforcesError Table) -> IO ())
-> IO (Either CodeforcesError Table) -> IO ()
forall a b. (a -> b) -> a -> b
$ ExceptT CodeforcesError IO Table
-> IO (Either CodeforcesError Table)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CodeforcesError IO Table
 -> IO (Either CodeforcesError Table))
-> ExceptT CodeforcesError IO Table
-> IO (Either CodeforcesError Table)
forall a b. (a -> b) -> a -> b
$ do
        [Handle]
friends <- IO (Either ResponseError [Handle])
-> ExceptT CodeforcesError IO [Handle]
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError [Handle])
 -> ExceptT CodeforcesError IO [Handle])
-> IO (Either ResponseError [Handle])
-> ExceptT CodeforcesError IO [Handle]
forall a b. (a -> b) -> a -> b
$ UserConfig -> IO (Either ResponseError [Handle])
getFriends UserConfig
cfg

        let mHs :: Maybe [Handle]
mHs = if Bool
optFriends
                then [Handle] -> Maybe [Handle]
forall a. a -> Maybe a
Just (UserConfig -> Handle
cfgHandle UserConfig
cfg Handle -> [Handle] -> [Handle]
forall a. a -> [a] -> [a]
: [Handle]
friends)
                else Maybe [Handle]
forall a. Maybe a
Nothing

        (Standings
standings, Map Handle RatingChange
rcs) <- IO (Either ResponseError (Standings, Map Handle RatingChange))
-> ExceptT CodeforcesError IO (Standings, Map Handle RatingChange)
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError (Standings, Map Handle RatingChange))
 -> ExceptT CodeforcesError IO (Standings, Map Handle RatingChange))
-> IO (Either ResponseError (Standings, Map Handle RatingChange))
-> ExceptT CodeforcesError IO (Standings, Map Handle RatingChange)
forall a b. (a -> b) -> a -> b
$ StandingsParams
-> IO (Either ResponseError (Standings, Map Handle RatingChange))
getContestStandings' StandingsParams :: ContestId
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Maybe [Handle]
-> StandingsParams
StandingsParams
            { paramContestId :: ContestId
paramContestId  = ContestId
cId
            , paramFrom :: Maybe Int
paramFrom       = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
optFromIndex
            , paramRowCount :: Maybe Int
paramRowCount   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
optRowCount
            , paramRoom :: Maybe Int
paramRoom       = Maybe Int
optRoom
            , paramUnofficial :: Bool
paramUnofficial = Bool
optShowUnofficial
            , paramHandles :: Maybe [Handle]
paramHandles    = Maybe [Handle]
mHs
            }

        if [RanklistRow] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Standings -> [RanklistRow]
standingsRanklist Standings
standings)
            then
                CodeforcesError -> ExceptT CodeforcesError IO Table
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
                    (if Bool
optFriends
                        then CodeforcesError
StandingsWithFriendsEmpty
                        else CodeforcesError
StandingsEmpty
                    )
            else Table -> ExceptT CodeforcesError IO Table
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Table -> ExceptT CodeforcesError IO Table)
-> Table -> ExceptT CodeforcesError IO Table
forall a b. (a -> b) -> a -> b
$ Standings -> Map Handle RatingChange -> Table
standingsTable Standings
standings Map Handle RatingChange
rcs

standingsTable :: Standings -> M.Map Handle RatingChange -> Table
standingsTable :: Standings -> Map Handle RatingChange -> Table
standingsTable Standings
s Map Handle RatingChange
rcs = [ColConfig] -> [Row] -> Table
makeTable [ColConfig]
headers [Row]
rows
  where
    headers :: [ColConfig]
headers = [(ProblemIndex
"#", Int
5), (ProblemIndex
"Who", Int
20), (ProblemIndex
"=", Int
totalPointsColW), (ProblemIndex
"*", Int
5)]
        [ColConfig] -> [ColConfig] -> [ColConfig]
forall a. [a] -> [a] -> [a]
++ (Problem -> ColConfig) -> [Problem] -> [ColConfig]
forall a b. (a -> b) -> [a] -> [b]
map (\Problem
p -> (Problem -> ProblemIndex
problemIndex Problem
p, Int
problemColW)) (Standings -> [Problem]
standingsProblems Standings
s)
    rows :: [Row]
rows = (RanklistRow -> Row) -> [RanklistRow] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map
        (\RanklistRow {Points
Int
[ProblemResult]
Maybe DiffTime
Party
rrLastSubmissionTime :: RanklistRow -> Maybe DiffTime
rrProblemResults :: RanklistRow -> [ProblemResult]
rrUnsuccessfulHackCount :: RanklistRow -> Int
rrSuccessfulHackCount :: RanklistRow -> Int
rrPenalty :: RanklistRow -> Int
rrPoints :: RanklistRow -> Points
rrRank :: RanklistRow -> Int
rrParty :: RanklistRow -> Party
rrLastSubmissionTime :: Maybe DiffTime
rrProblemResults :: [ProblemResult]
rrUnsuccessfulHackCount :: Int
rrSuccessfulHackCount :: Int
rrPenalty :: Int
rrPoints :: Points
rrRank :: Int
rrParty :: Party
..} ->
            [ ProblemIndex -> Cell
plainCell (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ Int -> ProblemIndex
forall a. Show a => a -> ProblemIndex
showText Int
rrRank
                , Party -> Map Handle RatingChange -> Cell
partyCell Party
rrParty Map Handle RatingChange
rcs
                , Points -> Cell
totalPointsCell Points
rrPoints
                , ProblemIndex -> Cell
plainCell (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ Int -> ProblemIndex
forall a. Show a => a -> ProblemIndex
showText Int
rrPenalty
                ]
                Row -> Row -> Row
forall a. [a] -> [a] -> [a]
++ (ProblemResult -> Cell) -> [ProblemResult] -> Row
forall a b. (a -> b) -> [a] -> [b]
map (ScoringType -> ProblemResult -> Cell
problemResultCell ScoringType
scoringType) [ProblemResult]
rrProblemResults
        )
        (Standings -> [RanklistRow]
standingsRanklist Standings
s)

    scoringType :: ScoringType
scoringType     = Contest -> ScoringType
contestType (Contest -> ScoringType) -> Contest -> ScoringType
forall a b. (a -> b) -> a -> b
$ Standings -> Contest
standingsContest Standings
s

    -- Final score in ICPC contest is number of problems solved (single digit)
    totalPointsColW :: Int
totalPointsColW = if ScoringType
scoringType ScoringType -> ScoringType -> Bool
forall a. Eq a => a -> a -> Bool
== ScoringType
ScoringICPC then Int
2 else Int
5
    -- Problem score in ICPC contest is only 2-3 chars wide (e.g. "+5", "-2")
    problemColW :: Int
problemColW     = if ScoringType
scoringType ScoringType -> ScoringType -> Bool
forall a. Eq a => a -> a -> Bool
== ScoringType
ScoringICPC then Int
3 else Int
5

partyCell :: Party -> M.Map Handle RatingChange -> Cell
partyCell :: Party -> Map Handle RatingChange -> Cell
partyCell Party {Bool
[Member]
Maybe Int
Maybe ProblemIndex
Maybe UTCTime
Maybe ContestId
ParticipantType
partyStartTime :: Party -> Maybe UTCTime
partyRoom :: Party -> Maybe Int
partyIsGhost :: Party -> Bool
partyTeamName :: Party -> Maybe ProblemIndex
partyTeamId :: Party -> Maybe Int
partyParticipantType :: Party -> ParticipantType
partyMembers :: Party -> [Member]
partyContestId :: Party -> Maybe ContestId
partyStartTime :: Maybe UTCTime
partyRoom :: Maybe Int
partyIsGhost :: Bool
partyTeamName :: Maybe ProblemIndex
partyTeamId :: Maybe Int
partyParticipantType :: ParticipantType
partyMembers :: [Member]
partyContestId :: Maybe ContestId
..} Map Handle RatingChange
rcs = case [Member]
partyMembers of
    [Member {Handle
memberHandle :: Member -> Handle
memberHandle :: Handle
..}] -> case Handle -> Map Handle RatingChange -> Maybe RatingChange
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Handle
memberHandle Map Handle RatingChange
rcs of
        Maybe RatingChange
Nothing -> ProblemIndex -> Cell
plainCell (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ ProblemIndex -> ProblemIndex
participant (ProblemIndex -> ProblemIndex) -> ProblemIndex -> ProblemIndex
forall a b. (a -> b) -> a -> b
$ Handle -> ProblemIndex
unHandle Handle
memberHandle
        Just RatingChange
rc ->
            Color -> ProblemIndex -> Cell
coloredCell (RatingChange -> Color
userColor RatingChange
rc) (ProblemIndex -> ProblemIndex
participant (ProblemIndex -> ProblemIndex) -> ProblemIndex -> ProblemIndex
forall a b. (a -> b) -> a -> b
$ Handle -> ProblemIndex
unHandle Handle
memberHandle)

    [Member]
ms -> case Maybe ProblemIndex
partyTeamName of
        Maybe ProblemIndex
Nothing       -> ProblemIndex -> Cell
plainCell (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ ProblemIndex -> ProblemIndex
participant (ProblemIndex -> ProblemIndex) -> ProblemIndex -> ProblemIndex
forall a b. (a -> b) -> a -> b
$ [Member] -> ProblemIndex
memberList [Member]
ms
        Just ProblemIndex
teamName -> ProblemIndex -> Cell
plainCell (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ ProblemIndex -> ProblemIndex
participant ProblemIndex
teamName
  where
    participant :: ProblemIndex -> ProblemIndex
participant = ParticipantType -> ProblemIndex -> ProblemIndex
fmtParticipation ParticipantType
partyParticipantType
    memberList :: [Member] -> ProblemIndex
memberList  = ProblemIndex -> Table -> ProblemIndex
T.intercalate ProblemIndex
"," (Table -> ProblemIndex)
-> ([Member] -> Table) -> [Member] -> ProblemIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Member -> ProblemIndex) -> [Member] -> Table
forall a b. (a -> b) -> [a] -> [b]
map (Handle -> ProblemIndex
unHandle (Handle -> ProblemIndex)
-> (Member -> Handle) -> Member -> ProblemIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Member -> Handle
memberHandle)
    userColor :: RatingChange -> Color
userColor   = RankColor -> Color
convertRankColor (RankColor -> Color)
-> (RatingChange -> RankColor) -> RatingChange -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> RankColor
rankColor (Rank -> RankColor)
-> (RatingChange -> Rank) -> RatingChange -> RankColor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rank
getRank (Int -> Rank) -> (RatingChange -> Int) -> RatingChange -> Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatingChange -> Int
rcOldRating

-- | 'fmtParticipation' @participantType text@ returns the @text@ with either a
-- prefix/suffix/no changes, to indicate the type of contest participation.
fmtParticipation :: ParticipantType -> Text -> Text
fmtParticipation :: ParticipantType -> ProblemIndex -> ProblemIndex
fmtParticipation ParticipantType
Virtual    ProblemIndex
t = ProblemIndex
t ProblemIndex -> ProblemIndex -> ProblemIndex
forall a. Semigroup a => a -> a -> a
<> ProblemIndex
" #"
fmtParticipation ParticipantType
Contestant ProblemIndex
t = ProblemIndex
t
fmtParticipation ParticipantType
_          ProblemIndex
t = ProblemIndex
"* " ProblemIndex -> ProblemIndex -> ProblemIndex
forall a. Semigroup a => a -> a -> a
<> ProblemIndex
t

-- | 'showPoints' @points@ returns a textual representation of the points type.
-- If @points@ is an integer (e.g. @42.0@) then the integer without decimals
-- is returned (@42@), otherwise the decimals are shown.
showPoints :: Points -> Text
showPoints :: Points -> ProblemIndex
showPoints Points
x = if Points
x Points -> Points -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Points
forall a. Num a => Integer -> a
fromInteger Integer
r then Integer -> ProblemIndex
forall a. Show a => a -> ProblemIndex
showText Integer
r else Points -> ProblemIndex
forall a. Show a => a -> ProblemIndex
showText Points
x
    where r :: Integer
r = Points -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Points
x

-- | Cell showing the total points obtained by a user in the contest.
totalPointsCell :: Points -> Cell
totalPointsCell :: Points -> Cell
totalPointsCell = ProblemIndex -> Cell
plainCell (ProblemIndex -> Cell)
-> (Points -> ProblemIndex) -> Points -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Points -> ProblemIndex
showPoints

-- | Cell showing the points obtained for a problem submission.
problemResultCell :: ScoringType -> ProblemResult -> Cell
problemResultCell :: ScoringType -> ProblemResult -> Cell
problemResultCell ScoringType
st pr :: ProblemResult
pr@ProblemResult {Points
Int
Maybe Int
ResultType
prBestSubmissionTime :: ProblemResult -> Maybe Int
prType :: ProblemResult -> ResultType
prRejectedAttemptCount :: ProblemResult -> Int
prPenalty :: ProblemResult -> Maybe Int
prPoints :: ProblemResult -> Points
prBestSubmissionTime :: Maybe Int
prType :: ResultType
prRejectedAttemptCount :: Int
prPenalty :: Maybe Int
prPoints :: Points
..} = if ProblemResult -> Bool
prNotAttempted ProblemResult
pr
    then Cell
blankCell
    else case ScoringType
st of
        ScoringType
ScoringCF -> if Points
prPoints Points -> Points -> Bool
forall a. Eq a => a -> a -> Bool
== Points
0
            then Color -> ProblemIndex -> Cell
coloredCell Color
Red (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ ProblemIndex
"-" ProblemIndex -> ProblemIndex -> ProblemIndex
forall a. Semigroup a => a -> a -> a
<> Int -> ProblemIndex
forall a. Show a => a -> ProblemIndex
showText Int
prRejectedAttemptCount
            else Color -> ProblemIndex -> Cell
coloredCell Color
Green (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ Points -> ProblemIndex
showPoints Points
prPoints
        ScoringType
ScoringICPC -> if Points
prPoints Points -> Points -> Bool
forall a. Eq a => a -> a -> Bool
== Points
0
            then Color -> ProblemIndex -> Cell
coloredCell Color
Blue (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ ProblemIndex
"-" ProblemIndex -> ProblemIndex -> ProblemIndex
forall a. Semigroup a => a -> a -> a
<> Int -> ProblemIndex
forall a. Show a => a -> ProblemIndex
showText Int
prRejectedAttemptCount
            else Color -> ProblemIndex -> Cell
coloredCell Color
Green (ProblemIndex -> Cell) -> ProblemIndex -> Cell
forall a b. (a -> b) -> a -> b
$ if Int
prRejectedAttemptCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then ProblemIndex
"+"
                else ProblemIndex
"+" ProblemIndex -> ProblemIndex -> ProblemIndex
forall a. Semigroup a => a -> a -> a
<> Int -> ProblemIndex
forall a. Show a => a -> ProblemIndex
showText Int
prRejectedAttemptCount
        ScoringType
ScoringIOI -> case Points
prPoints of
            Points
0   -> Cell
blankCell
            Points
100 -> Color -> ProblemIndex -> Cell
coloredCell Color
Green ProblemIndex
"100"
            Points
x   -> ProblemIndex -> Cell
plainCell (Points -> ProblemIndex
showPoints Points
x)

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