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

-- | Contest-related commands.
module Codeforces.App.Commands.ContestCmds
    ( contestList
    , contestInfo
    , openContest
    ) where

import           Codeforces.API
import           Codeforces.App.Format
import           Codeforces.App.Options
import           Codeforces.App.Table
import           Codeforces.App.Watcher
import           Codeforces.Error

import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except

import qualified Data.Map                      as M
import           Data.Maybe
import           Data.Text                      ( Text )
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T
import           Data.Time

import           Web.Browser

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

contestList :: ContestOpts -> IO ()
contestList :: ContestOpts -> IO ()
contestList ContestOpts {Bool
optIsUpcoming :: ContestOpts -> Bool
optIsPast :: ContestOpts -> Bool
optIsGym :: ContestOpts -> Bool
optIsUpcoming :: Bool
optIsPast :: Bool
optIsGym :: Bool
..} = IO (Either CodeforcesError ()) -> IO ()
forall a. IO (Either CodeforcesError a) -> IO ()
handleE (IO (Either CodeforcesError ()) -> IO ())
-> IO (Either CodeforcesError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ExceptT CodeforcesError IO () -> IO (Either CodeforcesError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CodeforcesError IO () -> IO (Either CodeforcesError ()))
-> ExceptT CodeforcesError IO () -> IO (Either CodeforcesError ())
forall a b. (a -> b) -> a -> b
$ do
    [Contest]
contests <- IO (Either ResponseError [Contest])
-> ExceptT CodeforcesError IO [Contest]
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError [Contest])
 -> ExceptT CodeforcesError IO [Contest])
-> IO (Either ResponseError [Contest])
-> ExceptT CodeforcesError IO [Contest]
forall a b. (a -> b) -> a -> b
$ Bool -> IO (Either ResponseError [Contest])
getContests Bool
optIsGym
    UTCTime
now      <- IO UTCTime -> ExceptT CodeforcesError IO UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO UTCTime
getCurrentTime

    let headers :: [(Text, Int)]
headers = [(Text
"#", Int
4), (Text
"Name", Int
50), (Text
"Date", Int
16), (Text
"Duration", Int
10)]
        rows :: [[Cell]]
rows    = (Contest -> [Cell]) -> [Contest] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map
            (\Contest {Bool
Maybe UTCTime
Text
DiffTime
ContestId
ContestPhase
ScoringType
contestStartTime :: Contest -> Maybe UTCTime
contestDuration :: Contest -> DiffTime
contestFrozen :: Contest -> Bool
contestPhase :: Contest -> ContestPhase
contestType :: Contest -> ScoringType
contestName :: Contest -> Text
contestId :: Contest -> ContestId
contestStartTime :: Maybe UTCTime
contestDuration :: DiffTime
contestFrozen :: Bool
contestPhase :: ContestPhase
contestType :: ScoringType
contestName :: Text
contestId :: ContestId
..} ->
                Text -> Cell
plainCell
                    (Text -> Cell) -> [Text] -> [Cell]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Int -> Text
forall a. Show a => a -> Text
showText (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ ContestId -> Int
unContestId ContestId
contestId
                        , Text
contestName
                        , Maybe UTCTime -> Text
fmtStartTime Maybe UTCTime
contestStartTime
                        , DiffTime -> Text
fmtDuration DiffTime
contestDuration
                        ]
            )
            (Bool -> Bool -> UTCTime -> [Contest] -> [Contest]
filterContests Bool
optIsPast Bool
optIsUpcoming UTCTime
now [Contest]
contests)

    IO () -> ExceptT CodeforcesError IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT CodeforcesError IO ())
-> IO () -> ExceptT CodeforcesError IO ()
forall a b. (a -> b) -> a -> b
$ (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
T.putStrLn ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Text, Int)] -> [[Cell]] -> [Text]
makeTable [(Text, Int)]
headers [[Cell]]
rows

-- | 'filterContests' @onlyPast onlyUpcoming currentTime@ filters and orders a
-- list of contests depending on whether past or upcoming (or both/all) contests
-- should be shown.
filterContests :: Bool -> Bool -> UTCTime -> [Contest] -> [Contest]
filterContests :: Bool -> Bool -> UTCTime -> [Contest] -> [Contest]
filterContests Bool
False Bool
False UTCTime
_   = [Contest] -> [Contest]
forall a. a -> a
id
filterContests Bool
False Bool
True  UTCTime
now = [Contest] -> [Contest]
forall a. [a] -> [a]
reverse ([Contest] -> [Contest])
-> ([Contest] -> [Contest]) -> [Contest] -> [Contest]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Contest -> Bool) -> [Contest] -> [Contest]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Contest -> Bool) -> Contest -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Contest -> Bool
isContestPast UTCTime
now)
filterContests Bool
True  Bool
False UTCTime
now = (Contest -> Bool) -> [Contest] -> [Contest]
forall a. (a -> Bool) -> [a] -> [a]
filter (UTCTime -> Contest -> Bool
isContestPast UTCTime
now)
filterContests Bool
True  Bool
True  UTCTime
_   = [Contest] -> [Contest]
forall a. a -> a
id

-- | Whether the contest is in the past relative to the given time.
isContestPast :: UTCTime -> Contest -> Bool
isContestPast :: UTCTime -> Contest -> Bool
isContestPast UTCTime
now Contest
c = Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
now) (Contest -> Maybe UTCTime
contestStartTime Contest
c)

fmtStartTime :: Maybe UTCTime -> Text
fmtStartTime :: Maybe UTCTime -> Text
fmtStartTime =
    Text -> (UTCTime -> Text) -> Maybe UTCTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M  %d-%b-%y")

fmtDuration :: DiffTime -> Text
fmtDuration :: DiffTime -> Text
fmtDuration = String -> Text
T.pack (String -> Text) -> (DiffTime -> String) -> DiffTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> DiffTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%h:%0M hrs"

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

contestInfo :: ContestId -> UserConfig -> InfoOpts -> IO ()
contestInfo :: ContestId -> UserConfig -> InfoOpts -> IO ()
contestInfo ContestId
cId UserConfig
cfg InfoOpts
opts =
    Bool -> IO (Either CodeforcesError [Text]) -> IO ()
handleWatch (InfoOpts -> Bool
optInfoWatch InfoOpts
opts) (ContestId
-> UserConfig -> InfoOpts -> IO (Either CodeforcesError [Text])
contestInfoTable ContestId
cId UserConfig
cfg InfoOpts
opts)

-- | 'contestInfoTable' @problems submissions statistics@ fetches data about the
-- contest and constructs a table of its problems.
--
-- The table includes problem statistics, and if the user has made a submission,
-- their submission verdict for the problem.
--
contestInfoTable
    :: ContestId -> UserConfig -> InfoOpts -> IO (Either CodeforcesError Table)
contestInfoTable :: ContestId
-> UserConfig -> InfoOpts -> IO (Either CodeforcesError [Text])
contestInfoTable ContestId
cId UserConfig
cfg InfoOpts
opts = ExceptT CodeforcesError IO [Text]
-> IO (Either CodeforcesError [Text])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CodeforcesError IO [Text]
 -> IO (Either CodeforcesError [Text]))
-> ExceptT CodeforcesError IO [Text]
-> IO (Either CodeforcesError [Text])
forall a b. (a -> b) -> a -> b
$ do
    let handle :: Handle
handle = Handle -> Maybe Handle -> Handle
forall a. a -> Maybe a -> a
fromMaybe (UserConfig -> Handle
cfgHandle UserConfig
cfg) (InfoOpts -> Maybe Handle
optHandle InfoOpts
opts)

    [Problem]
ps      <- IO (Either ResponseError [Problem])
-> ExceptT CodeforcesError IO [Problem]
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError [Problem])
 -> ExceptT CodeforcesError IO [Problem])
-> IO (Either ResponseError [Problem])
-> ExceptT CodeforcesError IO [Problem]
forall a b. (a -> b) -> a -> b
$ ContestId -> IO (Either ResponseError [Problem])
getContestProblems ContestId
cId
    Map Text ProblemStats
statMap <- IO (Either ResponseError (Map Text ProblemStats))
-> ExceptT CodeforcesError IO (Map Text ProblemStats)
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError (Map Text ProblemStats))
 -> ExceptT CodeforcesError IO (Map Text ProblemStats))
-> IO (Either ResponseError (Map Text ProblemStats))
-> ExceptT CodeforcesError IO (Map Text ProblemStats)
forall a b. (a -> b) -> a -> b
$ ([ProblemStats] -> Map Text ProblemStats)
-> Either ResponseError [ProblemStats]
-> Either ResponseError (Map Text ProblemStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ProblemStats] -> Map Text ProblemStats
problemStatsMap (Either ResponseError [ProblemStats]
 -> Either ResponseError (Map Text ProblemStats))
-> IO (Either ResponseError [ProblemStats])
-> IO (Either ResponseError (Map Text ProblemStats))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> IO (Either ResponseError [ProblemStats])
getProblemStats []
    Map Text Submission
subMap  <-
        IO (Either ResponseError (Map Text Submission))
-> ExceptT CodeforcesError IO (Map Text Submission)
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError (Map Text Submission))
 -> ExceptT CodeforcesError IO (Map Text Submission))
-> IO (Either ResponseError (Map Text Submission))
-> ExceptT CodeforcesError IO (Map Text Submission)
forall a b. (a -> b) -> a -> b
$ ([Submission] -> Map Text Submission)
-> Either ResponseError [Submission]
-> Either ResponseError (Map Text Submission)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Submission] -> Map Text Submission
submissionsMap (Either ResponseError [Submission]
 -> Either ResponseError (Map Text Submission))
-> IO (Either ResponseError [Submission])
-> IO (Either ResponseError (Map Text Submission))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContestId -> Handle -> IO (Either ResponseError [Submission])
getContestSubmissions ContestId
cId Handle
handle

    let headers :: [(Text, Int)]
headers =
            [ (Text
"#"      , Int
2)
            , (Text
"Problem", Int
30)
            , (Text
"Verdict", Int
35)
            , (Text
"Time"   , Int
7)
            , (Text
"Memory" , Int
8)
            , (Text
"Solved" , Int
7)
            ]
        rows :: [[Cell]]
rows = (Problem -> [Cell]) -> [Problem] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map
            (\Problem {[Text]
Maybe Points
Maybe Int
Maybe Text
Maybe ContestId
Text
ProblemType
problemTags :: Problem -> [Text]
problemRating :: Problem -> Maybe Int
problemPoints :: Problem -> Maybe Points
problemType :: Problem -> ProblemType
problemName :: Problem -> Text
problemIndex :: Problem -> Text
problemSetName :: Problem -> Maybe Text
problemContestId :: Problem -> Maybe ContestId
problemTags :: [Text]
problemRating :: Maybe Int
problemPoints :: Maybe Points
problemType :: ProblemType
problemName :: Text
problemIndex :: Text
problemSetName :: Maybe Text
problemContestId :: Maybe ContestId
..} ->
                let mSub :: Maybe Submission
mSub   = Text -> Map Text Submission -> Maybe Submission
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
problemIndex Map Text Submission
subMap
                    mStats :: Maybe ProblemStats
mStats = Text -> Map Text ProblemStats -> Maybe ProblemStats
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
problemIndex Map Text ProblemStats
statMap
                in  [ Text -> Cell
plainCell Text
problemIndex
                    , Text -> Cell
plainCell Text
problemName
                    , Maybe Submission -> Cell
contestSubmissionCell Maybe Submission
mSub
                    , Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Submission -> Text
maybeTimeTaken Maybe Submission
mSub
                    , Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Submission -> Text
maybeMemTaken Maybe Submission
mSub
                    , Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe ProblemStats -> Text
maybeSolved Maybe ProblemStats
mStats
                    ]
            )
            [Problem]
ps

    [Text] -> ExceptT CodeforcesError IO [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> ExceptT CodeforcesError IO [Text])
-> [Text] -> ExceptT CodeforcesError IO [Text]
forall a b. (a -> b) -> a -> b
$ [(Text, Int)] -> [[Cell]] -> [Text]
makeTable [(Text, Int)]
headers [[Cell]]
rows
  where
    maybeTimeTaken :: Maybe Submission -> Text
maybeTimeTaken = Text -> (Submission -> Text) -> Maybe Submission -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"-" (Int -> Text
fmtTimeConsumed (Int -> Text) -> (Submission -> Int) -> Submission -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Submission -> Int
submissionTimeConsumed)
    maybeMemTaken :: Maybe Submission -> Text
maybeMemTaken  = Text -> (Submission -> Text) -> Maybe Submission -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"-" (Int -> Text
fmtMemoryConsumed (Int -> Text) -> (Submission -> Int) -> Submission -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Submission -> Int
submissionMemoryConsumed)
    maybeSolved :: Maybe ProblemStats -> Text
maybeSolved    = Text -> (ProblemStats -> Text) -> Maybe ProblemStats -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (ProblemStats -> Text) -> ProblemStats -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Show a => a -> Text
showText (Int -> Text) -> (ProblemStats -> Int) -> ProblemStats -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProblemStats -> Int
pStatSolvedCount)

-- | Shows the verdict of a contest submission.
contestSubmissionCell :: Maybe Submission -> Cell
contestSubmissionCell :: Maybe Submission -> Cell
contestSubmissionCell Maybe Submission
Nothing                = Text -> Cell
plainCell Text
"-"
contestSubmissionCell (Just Submission {Int
Maybe Points
Maybe ContestId
Maybe Verdict
Text
UTCTime
DiffTime
Party
Problem
Testset
submissionPoints :: Submission -> Maybe Points
submissionPassedTestCount :: Submission -> Int
submissionTestset :: Submission -> Testset
submissionVerdict :: Submission -> Maybe Verdict
submissionProgrammingLanguage :: Submission -> Text
submissionAuthor :: Submission -> Party
submissionProblem :: Submission -> Problem
submissionRelativeTime :: Submission -> DiffTime
submissionTime :: Submission -> UTCTime
submissionContestId :: Submission -> Maybe ContestId
submissionId :: Submission -> Int
submissionPoints :: Maybe Points
submissionMemoryConsumed :: Int
submissionTimeConsumed :: Int
submissionPassedTestCount :: Int
submissionTestset :: Testset
submissionVerdict :: Maybe Verdict
submissionProgrammingLanguage :: Text
submissionAuthor :: Party
submissionProblem :: Problem
submissionRelativeTime :: DiffTime
submissionTime :: UTCTime
submissionContestId :: Maybe ContestId
submissionId :: Int
submissionMemoryConsumed :: Submission -> Int
submissionTimeConsumed :: Submission -> Int
..}) = Testset -> Int -> Maybe Points -> Maybe Verdict -> Cell
verdictCell
    Testset
submissionTestset
    Int
submissionPassedTestCount
    Maybe Points
submissionPoints
    Maybe Verdict
submissionVerdict

-- | 'problemStatsMap' @stats@ computes a map of each problem's index to the
-- corresponding 'ProblemStats' for it.
problemStatsMap :: [ProblemStats] -> M.Map ProblemIndex ProblemStats
problemStatsMap :: [ProblemStats] -> Map Text ProblemStats
problemStatsMap = [(Text, ProblemStats)] -> Map Text ProblemStats
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, ProblemStats)] -> Map Text ProblemStats)
-> ([ProblemStats] -> [(Text, ProblemStats)])
-> [ProblemStats]
-> Map Text ProblemStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProblemStats -> (Text, ProblemStats))
-> [ProblemStats] -> [(Text, ProblemStats)]
forall a b. (a -> b) -> [a] -> [b]
map (ProblemStats -> Text
pStatProblemIndex (ProblemStats -> Text)
-> (Text -> ProblemStats -> (Text, ProblemStats))
-> ProblemStats
-> (Text, ProblemStats)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (,))

-- | 'submissionsMap' @submissions@ computes a map of each problem's index to
-- the most recent submission for it.
submissionsMap :: [Submission] -> M.Map ProblemIndex Submission
submissionsMap :: [Submission] -> Map Text Submission
submissionsMap =
    (Submission -> Submission -> Submission)
-> [(Text, Submission)] -> Map Text Submission
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith ((Submission -> Submission)
-> Submission -> Submission -> Submission
forall a b. a -> b -> a
const Submission -> Submission
forall a. a -> a
id) ([(Text, Submission)] -> Map Text Submission)
-> ([Submission] -> [(Text, Submission)])
-> [Submission]
-> Map Text Submission
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Submission -> (Text, Submission))
-> [Submission] -> [(Text, Submission)]
forall a b. (a -> b) -> [a] -> [b]
map (Problem -> Text
problemIndex (Problem -> Text) -> (Submission -> Problem) -> Submission -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Submission -> Problem
submissionProblem (Submission -> Text)
-> (Text -> Submission -> (Text, Submission))
-> Submission
-> (Text, Submission)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (,))

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

-- | 'openContest' @contestId@ opens the URL to the specified contest in the
-- user's preferred web browser.
openContest :: ContestId -> IO ()
openContest :: ContestId -> IO ()
openContest ContestId
cId =
    String -> IO Bool
openBrowser (String
"https://codeforces.com/contest/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ContestId -> String
forall a. Show a => a -> String
show ContestId
cId) IO Bool -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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