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

module Codeforces.App.Options
    ( Command(..)
    , ContestOpts(..)
    , InfoOpts(..)
    , ProblemOpts(..)
    , StandingOpts(..)
    , StatusOpts(..)
    , parseCommands
    ) where

import           Codeforces.Types
import           Paths_codeforces_cli           ( version )

import           Data.Version                   ( showVersion )

import           Options.Applicative

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

data Command
    = AgendaCmd
    | ContestsCmd ContestOpts
    | FriendsCmd
    | InfoCmd ContestId InfoOpts
    | OpenCmd ContestId
    | ProblemsCmd ProblemOpts
    | RatingsCmd Handle
    | SetupCmd
    | StandingsCmd ContestId StandingOpts
    | StatusCmd Handle StatusOpts
    | UserCmd Handle
    | VirtualCmd ContestId Handle Points Int
    deriving Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq

data ContestOpts = ContestOpts
    { ContestOpts -> Bool
optIsGym      :: Bool
    , ContestOpts -> Bool
optIsPast     :: Bool
    , ContestOpts -> Bool
optIsUpcoming :: Bool
    }
    deriving ContestOpts -> ContestOpts -> Bool
(ContestOpts -> ContestOpts -> Bool)
-> (ContestOpts -> ContestOpts -> Bool) -> Eq ContestOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContestOpts -> ContestOpts -> Bool
$c/= :: ContestOpts -> ContestOpts -> Bool
== :: ContestOpts -> ContestOpts -> Bool
$c== :: ContestOpts -> ContestOpts -> Bool
Eq

data InfoOpts = InfoOpts
    { InfoOpts -> Maybe Handle
optHandle    :: Maybe Handle
    , InfoOpts -> Bool
optInfoWatch :: Bool
    }
    deriving InfoOpts -> InfoOpts -> Bool
(InfoOpts -> InfoOpts -> Bool)
-> (InfoOpts -> InfoOpts -> Bool) -> Eq InfoOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfoOpts -> InfoOpts -> Bool
$c/= :: InfoOpts -> InfoOpts -> Bool
== :: InfoOpts -> InfoOpts -> Bool
$c== :: InfoOpts -> InfoOpts -> Bool
Eq

data ProblemOpts = ProblemOpts
    { ProblemOpts -> Rating
optMinRating :: Rating
    , ProblemOpts -> Rating
optMaxRating :: Rating
    }
    deriving ProblemOpts -> ProblemOpts -> Bool
(ProblemOpts -> ProblemOpts -> Bool)
-> (ProblemOpts -> ProblemOpts -> Bool) -> Eq ProblemOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProblemOpts -> ProblemOpts -> Bool
$c/= :: ProblemOpts -> ProblemOpts -> Bool
== :: ProblemOpts -> ProblemOpts -> Bool
$c== :: ProblemOpts -> ProblemOpts -> Bool
Eq

data StandingOpts = StandingOpts
    { StandingOpts -> Bool
optShowUnofficial :: Bool
    , StandingOpts -> Rating
optFromIndex      :: Int
    , StandingOpts -> Rating
optRowCount       :: Int
    , StandingOpts -> Maybe Rating
optRoom           :: Maybe Int
    , StandingOpts -> Bool
optFriends        :: Bool
    , StandingOpts -> Bool
optStandWatch     :: Bool
    }
    deriving StandingOpts -> StandingOpts -> Bool
(StandingOpts -> StandingOpts -> Bool)
-> (StandingOpts -> StandingOpts -> Bool) -> Eq StandingOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StandingOpts -> StandingOpts -> Bool
$c/= :: StandingOpts -> StandingOpts -> Bool
== :: StandingOpts -> StandingOpts -> Bool
$c== :: StandingOpts -> StandingOpts -> Bool
Eq

data StatusOpts = StatusOpts
    { StatusOpts -> Rating
optStatusFrom  :: Int
    , StatusOpts -> Rating
optStatusCount :: Int
    , StatusOpts -> Bool
optStatusWatch :: Bool
    }
    deriving StatusOpts -> StatusOpts -> Bool
(StatusOpts -> StatusOpts -> Bool)
-> (StatusOpts -> StatusOpts -> Bool) -> Eq StatusOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusOpts -> StatusOpts -> Bool
$c/= :: StatusOpts -> StatusOpts -> Bool
== :: StatusOpts -> StatusOpts -> Bool
$c== :: StatusOpts -> StatusOpts -> Bool
Eq

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

parseCommands :: IO Command
parseCommands :: IO Command
parseCommands = ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
execParser ParserInfo Command
opts

opts :: ParserInfo Command
opts :: ParserInfo Command
opts = Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Command
commandP Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
helper) (InfoMod Command
appHeader InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> InfoMod Command
forall a. InfoMod a
fullDesc)

-- | CLI name and version number.
appHeader :: InfoMod Command
appHeader :: InfoMod Command
appHeader = String -> InfoMod Command
forall a. String -> InfoMod a
header (String -> InfoMod Command) -> String -> InfoMod Command
forall a b. (a -> b) -> a -> b
$ String
"Codeforces CLI v" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
appVersion

-- | Version number of the CLI.
appVersion :: String
appVersion :: String
appVersion = Version -> String
showVersion Version
version

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

commandP :: Parser Command
commandP :: Parser Command
commandP =
    Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
        (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$  String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command
               String
"agenda"
               (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
                   Parser Command
agendaP
                   (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Upcoming contests. Alias for contests --upcoming")
               )
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"contests" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
contestsP (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"List of contests"))
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command
               String
"info"
               (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
                   Parser Command
contestInfoP
                   (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc
                       String
"Show the problems and your problem results of a contest"
                   )
               )
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command
               String
"friends"
               (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
friendsP
                     (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"List your friends (must be authenticated)")
               )
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"open"
                   (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
openP (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Open a contest in the browser"))
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command
               String
"problems"
               (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
problemsP (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"View and filter problem sets"))
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"ratings"
                   (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
ratingsP (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Rating changes of a user"))
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"setup"
                   (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
setupP (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Setup your configuration file"))
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command
               String
"standings"
               (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
standingsP (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Standings table of a contest"))
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"status"
                   (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
statusP (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Recent submissions of a user"))
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"user" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
userP (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Information about a user"))
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command
               String
"virtual"
               (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
                   Parser Command
virtualP
                   (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc
                       String
"Calculate your rating after a virtual contest,\
                           \ to find what it would be if you competed live"
                   )
               )

agendaP :: Parser Command
agendaP :: Parser Command
agendaP = Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
AgendaCmd

contestsP :: Parser Command
contestsP :: Parser Command
contestsP =
    (ContestOpts -> Command) -> Parser ContestOpts -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ContestOpts -> Command
ContestsCmd
        (Parser ContestOpts -> Parser Command)
-> Parser ContestOpts -> Parser Command
forall a b. (a -> b) -> a -> b
$   Bool -> Bool -> Bool -> ContestOpts
ContestOpts
        (Bool -> Bool -> Bool -> ContestOpts)
-> Parser Bool -> Parser (Bool -> Bool -> ContestOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
                (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"gym"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'g'
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help
                       String
"If true then gym contests are returned,\
                       \ otherwise, just regular contests are shown."
                )
        Parser (Bool -> Bool -> ContestOpts)
-> Parser Bool -> Parser (Bool -> ContestOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"past" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Show only past contests.")
        Parser (Bool -> ContestOpts) -> Parser Bool -> Parser ContestOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
                (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"upcoming"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help
                       String
"Show only upcoming contests.\
                           \ This can also be done with the `agenda` command."
                )


contestInfoP :: Parser Command
contestInfoP :: Parser Command
contestInfoP = ContestId -> InfoOpts -> Command
InfoCmd (ContestId -> InfoOpts -> Command)
-> Parser ContestId -> Parser (InfoOpts -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ContestId
contestIdArg Parser (InfoOpts -> Command) -> Parser InfoOpts -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InfoOpts
contestInfoOpts

contestInfoOpts :: Parser InfoOpts
contestInfoOpts :: Parser InfoOpts
contestInfoOpts =
    Maybe Handle -> Bool -> InfoOpts
InfoOpts
        (Maybe Handle -> Bool -> InfoOpts)
-> Parser (Maybe Handle) -> Parser (Bool -> InfoOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Handle -> Parser (Maybe Handle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
                (Text -> Handle
Handle (Text -> Handle) -> Parser Text -> Parser Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                    (  String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"user"
                    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
                    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help
                           String
"Codeforces user handle. If specified, it shows the\
                           \ contest details of another user. If not specified,\
                           \ your contest details will be shown."
                    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HANDLE"
                    )
                )
        Parser (Bool -> InfoOpts) -> Parser Bool -> Parser InfoOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
watchOpt

friendsP :: Parser Command
friendsP :: Parser Command
friendsP = Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
FriendsCmd

openP :: Parser Command
openP :: Parser Command
openP = ContestId -> Command
OpenCmd (ContestId -> Command) -> Parser ContestId -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ContestId
contestIdArg

problemsP :: Parser Command
problemsP :: Parser Command
problemsP =
    (ProblemOpts -> Command) -> Parser ProblemOpts -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProblemOpts -> Command
ProblemsCmd
        (Parser ProblemOpts -> Parser Command)
-> Parser ProblemOpts -> Parser Command
forall a b. (a -> b) -> a -> b
$   Rating -> Rating -> ProblemOpts
ProblemOpts
        (Rating -> Rating -> ProblemOpts)
-> Parser Rating -> Parser (Rating -> ProblemOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rating -> Mod OptionFields Rating -> Parser Rating
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
                ReadM Rating
forall a. Read a => ReadM a
auto
                (  String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"minRating"
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. String -> Mod f a
help String
"Filter problems by minimum rating."
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Rating
forall a (f :: * -> *). Show a => Mod f a
showDefault
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Rating -> Mod OptionFields Rating
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Rating
0
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
                )
        Parser (Rating -> ProblemOpts)
-> Parser Rating -> Parser ProblemOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Rating -> Mod OptionFields Rating -> Parser Rating
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
                ReadM Rating
forall a. Read a => ReadM a
auto
                (  String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"maxRating"
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'R'
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. String -> Mod f a
help String
"Filter problems by maximum rating."
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Rating
forall a (f :: * -> *). Show a => Mod f a
showDefault
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Rating -> Mod OptionFields Rating
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Rating
3500
                Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
                )

ratingsP :: Parser Command
ratingsP :: Parser Command
ratingsP = Handle -> Command
RatingsCmd (Handle -> Command) -> Parser Handle -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Handle
handleArg

setupP :: Parser Command
setupP :: Parser Command
setupP = Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
SetupCmd

standingsP :: Parser Command
standingsP :: Parser Command
standingsP = ContestId -> StandingOpts -> Command
StandingsCmd (ContestId -> StandingOpts -> Command)
-> Parser ContestId -> Parser (StandingOpts -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ContestId
contestIdArg Parser (StandingOpts -> Command)
-> Parser StandingOpts -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StandingOpts
standingOpts

standingOpts :: Parser StandingOpts
standingOpts :: Parser StandingOpts
standingOpts =
    Bool
-> Rating -> Rating -> Maybe Rating -> Bool -> Bool -> StandingOpts
StandingOpts
        (Bool
 -> Rating
 -> Rating
 -> Maybe Rating
 -> Bool
 -> Bool
 -> StandingOpts)
-> Parser Bool
-> Parser
     (Rating -> Rating -> Maybe Rating -> Bool -> Bool -> StandingOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
                (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"unofficial"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help
                       String
"If true then all participants (virtual, out of\
                       \ competition) are shown. Otherwise, only official\
                       \ contestants are shown."
                )
        Parser
  (Rating -> Rating -> Maybe Rating -> Bool -> Bool -> StandingOpts)
-> Parser Rating
-> Parser (Rating -> Maybe Rating -> Bool -> Bool -> StandingOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rating
fromOpt
        Parser (Rating -> Maybe Rating -> Bool -> Bool -> StandingOpts)
-> Parser Rating
-> Parser (Maybe Rating -> Bool -> Bool -> StandingOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rating
countOpt
        Parser (Maybe Rating -> Bool -> Bool -> StandingOpts)
-> Parser (Maybe Rating) -> Parser (Bool -> Bool -> StandingOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rating -> Parser (Maybe Rating)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
                (ReadM Rating -> Mod OptionFields Rating -> Parser Rating
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
                    ReadM Rating
forall a. Read a => ReadM a
auto
                    (  String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"room"
                    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
                    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. String -> Mod f a
help
                           String
"If specified, then only participants from this room\
                           \ are shown. Otherwise, all participants are shown."
                    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
                    )
                )
        Parser (Bool -> Bool -> StandingOpts)
-> Parser Bool -> Parser (Bool -> StandingOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
                (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"friends"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help
                       String
"If true then only you and your friends will be shown\
                           \ in the standings."
                )
        Parser (Bool -> StandingOpts) -> Parser Bool -> Parser StandingOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
watchOpt

statusP :: Parser Command
statusP :: Parser Command
statusP = Handle -> StatusOpts -> Command
StatusCmd (Handle -> StatusOpts -> Command)
-> Parser Handle -> Parser (StatusOpts -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Handle
handleArg Parser (StatusOpts -> Command)
-> Parser StatusOpts -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StatusOpts
statusOpts

statusOpts :: Parser StatusOpts
statusOpts :: Parser StatusOpts
statusOpts = Rating -> Rating -> Bool -> StatusOpts
StatusOpts (Rating -> Rating -> Bool -> StatusOpts)
-> Parser Rating -> Parser (Rating -> Bool -> StatusOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Rating
fromOpt Parser (Rating -> Bool -> StatusOpts)
-> Parser Rating -> Parser (Bool -> StatusOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rating
countOpt Parser (Bool -> StatusOpts) -> Parser Bool -> Parser StatusOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
watchOpt

userP :: Parser Command
userP :: Parser Command
userP = Handle -> Command
UserCmd (Handle -> Command) -> Parser Handle -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Handle
handleArg

virtualP :: Parser Command
virtualP :: Parser Command
virtualP =
    ContestId -> Handle -> Points -> Rating -> Command
VirtualCmd
        (ContestId -> Handle -> Points -> Rating -> Command)
-> Parser ContestId
-> Parser (Handle -> Points -> Rating -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ContestId
contestIdArg
        Parser (Handle -> Points -> Rating -> Command)
-> Parser Handle -> Parser (Points -> Rating -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Handle
handleArg
        Parser (Points -> Rating -> Command)
-> Parser Points -> Parser (Rating -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Points -> Mod ArgumentFields Points -> Parser Points
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Points
forall a. Read a => ReadM a
auto (String -> Mod ArgumentFields Points
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"POINTS" Mod ArgumentFields Points
-> Mod ArgumentFields Points -> Mod ArgumentFields Points
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Points
forall (f :: * -> *) a. String -> Mod f a
help String
"Total points")
        Parser (Rating -> Command) -> Parser Rating -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Rating -> Mod ArgumentFields Rating -> Parser Rating
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Rating
forall a. Read a => ReadM a
auto (String -> Mod ArgumentFields Rating
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PENALTY" Mod ArgumentFields Rating
-> Mod ArgumentFields Rating -> Mod ArgumentFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Rating
forall (f :: * -> *) a. String -> Mod f a
help String
"Total penalty")

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

handleArg :: Parser Handle
handleArg :: Parser Handle
handleArg =
    Text -> Handle
Handle (Text -> Handle) -> Parser Text -> Parser Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HANDLE" Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Codeforces user handle.")

contestIdArg :: Parser ContestId
contestIdArg :: Parser ContestId
contestIdArg = Rating -> ContestId
ContestId
    (Rating -> ContestId) -> Parser Rating -> Parser ContestId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rating -> Mod ArgumentFields Rating -> Parser Rating
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Rating
forall a. Read a => ReadM a
auto (String -> Mod ArgumentFields Rating
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"CONTEST_ID" Mod ArgumentFields Rating
-> Mod ArgumentFields Rating -> Mod ArgumentFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Rating
forall (f :: * -> *) a. String -> Mod f a
help String
"ID of the contest")

fromOpt :: Parser Int
fromOpt :: Parser Rating
fromOpt = ReadM Rating -> Mod OptionFields Rating -> Parser Rating
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM Rating
forall a. Read a => ReadM a
auto
    (  String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"from"
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i'
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. String -> Mod f a
help String
"1-based index of the row to start from."
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Rating
forall a (f :: * -> *). Show a => Mod f a
showDefault
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Rating -> Mod OptionFields Rating
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Rating
1
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
    )

countOpt :: Parser Int
countOpt :: Parser Rating
countOpt = ReadM Rating -> Mod OptionFields Rating -> Parser Rating
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM Rating
forall a. Read a => ReadM a
auto
    (  String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"count"
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Rating
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n'
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of rows to return."
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Rating
forall a (f :: * -> *). Show a => Mod f a
showDefault
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> Rating -> Mod OptionFields Rating
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Rating
40
    Mod OptionFields Rating
-> Mod OptionFields Rating -> Mod OptionFields Rating
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rating
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
    )

watchOpt :: Parser Bool
watchOpt :: Parser Bool
watchOpt = Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"watch" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'w' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help
    String
"Watch this command and update output whenever it changes."

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