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

-- | User-related commands.
module Codeforces.App.Commands.UserCmds
    ( userInfo
    , userRatings
    , userStatus
    , userFriends
    ) 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.Extra
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except

import           Data.Text                      ( Text )
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T
import           Data.Time

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

userInfo :: Handle -> IO ()
userInfo :: Handle -> IO ()
userInfo Handle
h = 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
    User
u <- IO (Either ResponseError User) -> ExceptT CodeforcesError IO User
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError User) -> ExceptT CodeforcesError IO User)
-> IO (Either ResponseError User)
-> ExceptT CodeforcesError IO User
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Either ResponseError User)
getUser Handle
h

    let rank :: Rank
rank = Rating -> Rank
getRank (User -> Rating
userRating User
u)

    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
$ do
        String -> IO ()
putStrLn String
""
        Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ RankColor -> Text -> Text
rankColored (Rank -> RankColor
rankColor Rank
rank) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
            [Text
indent, Rank -> Text
rankName Rank
rank, Text
" ", Handle -> Text
unHandle (Handle -> Text) -> Handle -> Text
forall a b. (a -> b) -> a -> b
$ User -> Handle
userHandle User
u]
        Maybe [Text] -> ([Text] -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust ([Maybe Text] -> Maybe [Text]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [User -> Maybe Text
userFirstName User
u, User -> Maybe Text
userLastName User
u])
            (([Text] -> IO ()) -> IO ()) -> ([Text] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Text]
ns -> Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
ns

        User -> IO ()
printRatings User
u
        User -> IO ()
printPlace User
u
        String -> IO ()
putStrLn String
""

printRatings :: User -> IO ()
printRatings :: User -> IO ()
printRatings User {Rating
Maybe Text
Handle
userFriendOfCount :: User -> Rating
userOrganization :: User -> Maybe Text
userCountry :: User -> Maybe Text
userCity :: User -> Maybe Text
userMaxRating :: User -> Rating
userFriendOfCount :: Rating
userOrganization :: Maybe Text
userCountry :: Maybe Text
userCity :: Maybe Text
userMaxRating :: Rating
userRating :: Rating
userLastName :: Maybe Text
userFirstName :: Maybe Text
userHandle :: Handle
userLastName :: User -> Maybe Text
userFirstName :: User -> Maybe Text
userHandle :: User -> Handle
userRating :: User -> Rating
..} = do
    String -> IO ()
putStrLn String
""
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
        [ Text
indent
        , Text
"Rating:       "
        , RankColor -> Text -> Text
rankColored (Rank -> RankColor
rankColor (Rating -> Rank
getRank Rating
userRating)) (Rating -> Text
forall a. Show a => a -> Text
showText Rating
userRating)
        ]
    let maxRank :: Rank
maxRank = Rating -> Rank
getRank Rating
userRating
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
        [ Text
indent
        , Text
"              (max: "
        , RankColor -> Text -> Text
rankColored
            (Rank -> RankColor
rankColor Rank
maxRank)
            ([Text] -> Text
T.concat [Rank -> Text
rankName Rank
maxRank, Text
", ", Rating -> Text
forall a. Show a => a -> Text
showText Rating
userMaxRating])
        , Text
")"
        ]

printPlace :: User -> IO ()
printPlace :: User -> IO ()
printPlace User {Rating
Maybe Text
Handle
userFriendOfCount :: Rating
userOrganization :: Maybe Text
userCountry :: Maybe Text
userCity :: Maybe Text
userMaxRating :: Rating
userRating :: Rating
userLastName :: Maybe Text
userFirstName :: Maybe Text
userHandle :: Handle
userFriendOfCount :: User -> Rating
userOrganization :: User -> Maybe Text
userCountry :: User -> Maybe Text
userCity :: User -> Maybe Text
userMaxRating :: User -> Rating
userLastName :: User -> Maybe Text
userFirstName :: User -> Maybe Text
userHandle :: User -> Handle
userRating :: User -> Rating
..} = do
    Maybe [Text] -> ([Text] -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust ([Maybe Text] -> Maybe [Text]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Maybe Text
userCity, Maybe Text
userCountry]) (([Text] -> IO ()) -> IO ()) -> ([Text] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Text]
xs ->
        Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"City:         " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
xs
    Maybe Text -> (Text -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Text
userOrganization
        ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
o -> Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Organisation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o

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

userRatings :: Handle -> IO ()
userRatings :: Handle -> IO ()
userRatings Handle
h = 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
    [RatingChange]
rcs <- IO (Either ResponseError [RatingChange])
-> ExceptT CodeforcesError IO [RatingChange]
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError [RatingChange])
 -> ExceptT CodeforcesError IO [RatingChange])
-> IO (Either ResponseError [RatingChange])
-> ExceptT CodeforcesError IO [RatingChange]
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Either ResponseError [RatingChange])
getUserRatingHistory Handle
h

    let headers :: [(Text, Rating)]
headers =
            [ (Text
"#"      , Rating
3)
            , (Text
"Contest", Rating
50)
            , (Text
"Rank"   , Rating
5)
            , (Text
"Change" , Rating
6)
            , (Text
"Rating" , Rating
6)
            ]
        rows :: [[Cell]]
rows = [[Cell]] -> [[Cell]]
forall a. [a] -> [a]
reverse ([[Cell]] -> [[Cell]]) -> [[Cell]] -> [[Cell]]
forall a b. (a -> b) -> a -> b
$ (RatingChange -> Rating -> [Cell])
-> [RatingChange] -> [Rating] -> [[Cell]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
            (\RatingChange {Rating
Text
UTCTime
Handle
ContestId
rcNewRating :: RatingChange -> Rating
rcOldRating :: RatingChange -> Rating
rcRatingUpdateDate :: RatingChange -> UTCTime
rcRank :: RatingChange -> Rating
rcHandle :: RatingChange -> Handle
rcContestName :: RatingChange -> Text
rcContestId :: RatingChange -> ContestId
rcNewRating :: Rating
rcOldRating :: Rating
rcRatingUpdateDate :: UTCTime
rcRank :: Rating
rcHandle :: Handle
rcContestName :: Text
rcContestId :: ContestId
..} Rating
num ->
                [ Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Rating -> Text
forall a. Show a => a -> Text
showText Rating
num
                , Text -> Cell
plainCell Text
rcContestName
                , Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Rating -> Text
forall a. Show a => a -> Text
showText Rating
rcRank
                , Rating -> Cell
differenceCell (Rating
rcNewRating Rating -> Rating -> Rating
forall a. Num a => a -> a -> a
- Rating
rcOldRating)
                , Rating -> Cell
ratingCell Rating
rcNewRating
                ]
            )
            [RatingChange]
rcs
            ([Rating
1 ..] :: [Int])

    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, Rating)] -> [[Cell]] -> [Text]
makeTable [(Text, Rating)]
headers [[Cell]]
rows

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

userStatus :: Handle -> StatusOpts -> IO ()
userStatus :: Handle -> StatusOpts -> IO ()
userStatus Handle
h StatusOpts
opts = Bool -> IO (Either CodeforcesError [Text]) -> IO ()
handleWatch (StatusOpts -> Bool
optStatusWatch StatusOpts
opts) (Handle -> StatusOpts -> IO (Either CodeforcesError [Text])
userStatusTable Handle
h StatusOpts
opts)

userStatusTable :: Handle -> StatusOpts -> IO (Either CodeforcesError Table)
userStatusTable :: Handle -> StatusOpts -> IO (Either CodeforcesError [Text])
userStatusTable Handle
h StatusOpts {Bool
Rating
optStatusCount :: StatusOpts -> Rating
optStatusFrom :: StatusOpts -> Rating
optStatusWatch :: Bool
optStatusCount :: Rating
optStatusFrom :: Rating
optStatusWatch :: StatusOpts -> Bool
..} = 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
    [Submission]
ss <- IO (Either ResponseError [Submission])
-> ExceptT CodeforcesError IO [Submission]
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError [Submission])
 -> ExceptT CodeforcesError IO [Submission])
-> IO (Either ResponseError [Submission])
-> ExceptT CodeforcesError IO [Submission]
forall a b. (a -> b) -> a -> b
$ Handle
-> Rating -> Rating -> IO (Either ResponseError [Submission])
getUserStatus Handle
h Rating
optStatusFrom Rating
optStatusCount

    let headers :: [(Text, Rating)]
headers =
            [ (Text
"When"   , Rating
12)
            , (Text
"Problem", Rating
35)
            , (Text
"Lang"   , Rating
11)
            , (Text
"Verdict", Rating
35)
            , (Text
"Time"   , Rating
7)
            , (Text
"Memory" , Rating
8)
            ]
        rows :: [[Cell]]
rows = (Submission -> [Cell]) -> [Submission] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map
            (\Submission {Rating
Maybe Points
Maybe ContestId
Maybe Verdict
Text
UTCTime
DiffTime
Party
Problem
Testset
submissionPoints :: Submission -> Maybe Points
submissionMemoryConsumed :: Submission -> Rating
submissionTimeConsumed :: Submission -> Rating
submissionPassedTestCount :: Submission -> Rating
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 -> Rating
submissionPoints :: Maybe Points
submissionMemoryConsumed :: Rating
submissionTimeConsumed :: Rating
submissionPassedTestCount :: Rating
submissionTestset :: Testset
submissionVerdict :: Maybe Verdict
submissionProgrammingLanguage :: Text
submissionAuthor :: Party
submissionProblem :: Problem
submissionRelativeTime :: DiffTime
submissionTime :: UTCTime
submissionContestId :: Maybe ContestId
submissionId :: Rating
..} ->
                [ Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ UTCTime -> Text
fmtTime UTCTime
submissionTime
                , Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Problem -> Text
fmtProblem Problem
submissionProblem
                , Text -> Cell
plainCell Text
submissionProgrammingLanguage
                , Testset -> Rating -> Maybe Points -> Maybe Verdict -> Cell
verdictCell Testset
submissionTestset
                              Rating
submissionPassedTestCount
                              Maybe Points
submissionPoints
                              Maybe Verdict
submissionVerdict
                , Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Rating -> Text
fmtTimeConsumed Rating
submissionTimeConsumed
                , Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Rating -> Text
fmtMemoryConsumed Rating
submissionMemoryConsumed
                ]
            )
            [Submission]
ss

    [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, Rating)] -> [[Cell]] -> [Text]
makeTable [(Text, Rating)]
headers [[Cell]]
rows

fmtTime :: UTCTime -> Text
fmtTime :: UTCTime -> Text
fmtTime = 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
"%b/%d %H:%M"

fmtProblem :: Problem -> Text
fmtProblem :: Problem -> Text
fmtProblem Problem
p = [Text] -> Text
T.concat [Problem -> Text
problemIndex Problem
p, Text
" - ", Problem -> Text
problemName Problem
p]

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

userFriends :: UserConfig -> IO ()
userFriends :: UserConfig -> IO ()
userFriends UserConfig
cfg = 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
    [Handle]
fs <- 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
    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
$ (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
T.putStrLn (Text -> IO ()) -> (Handle -> Text) -> Handle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text
unHandle) [Handle]
fs

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