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

module Codeforces.API
    ( module Codeforces.Types
    , ResponseError(..)
    , handleAPI

    -- * Contests
    , getContests
    , getContestStandings
    , getContestStandings'
    , StandingsParams(..)

    -- * Problems
    , getAllProblemData
    , getProblems
    , getProblemStats
    , getContestProblems

    -- * Ratings and ranks
    , getContestRatingChanges
    , getUserRatingHistory

    -- * Problem submissions
    , getContestSubmissions
    , getUserStatus

    -- * User details
    , getUser
    , getUsers
    , getFriends

    -- * Virtual rating calculation
    , calculateVirtualResult
    , Delta
    , Seed
    , VirtualResult(..)

    -- * Configuration options
    , UserConfig(..)
    ) where

import           Codeforces.Config
import           Codeforces.Error
import           Codeforces.Response
import           Codeforces.Types
import           Codeforces.Virtual

import           Control.Arrow                  ( left )
import           Control.Monad.Trans.Except

import qualified Data.ByteString.Char8         as BC
import qualified Data.Map                      as M
import qualified Data.Text                     as T
import qualified Data.Text.Encoding            as T

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

handleAPI :: IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI :: IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI IO (Either ResponseError a)
m = IO (Either CodeforcesError a) -> ExceptT CodeforcesError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either CodeforcesError a) -> ExceptT CodeforcesError IO a)
-> IO (Either CodeforcesError a) -> ExceptT CodeforcesError IO a
forall a b. (a -> b) -> a -> b
$ (ResponseError -> CodeforcesError)
-> Either ResponseError a -> Either CodeforcesError a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ResponseError -> CodeforcesError
ResponseError (Either ResponseError a -> Either CodeforcesError a)
-> IO (Either ResponseError a) -> IO (Either CodeforcesError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either ResponseError a)
m

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

-- | Query parameters for retrieving contest standings.
data StandingsParams = StandingsParams
    {
    -- | ID of the contest
      StandingsParams -> ContestId
paramContestId  :: ContestId
    -- | The starting index of the ranklist (1-based)
    , StandingsParams -> Maybe Int
paramFrom       :: Maybe Int
    -- | The number of standing rows to return
    , StandingsParams -> Maybe Int
paramRowCount   :: Maybe Int
    -- | If specified, only standings of this room are returned
    , StandingsParams -> Maybe Int
paramRoom       :: Maybe Int
    -- | If true, all participations are included. Otherwise only 'Contestant'
    -- participations are included.
    , StandingsParams -> Bool
paramUnofficial :: Bool
    -- | If specified, the standings includes only these users.
    , StandingsParams -> Maybe [Handle]
paramHandles    :: Maybe [Handle]
    }
    deriving Int -> StandingsParams -> ShowS
[StandingsParams] -> ShowS
StandingsParams -> String
(Int -> StandingsParams -> ShowS)
-> (StandingsParams -> String)
-> ([StandingsParams] -> ShowS)
-> Show StandingsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StandingsParams] -> ShowS
$cshowList :: [StandingsParams] -> ShowS
show :: StandingsParams -> String
$cshow :: StandingsParams -> String
showsPrec :: Int -> StandingsParams -> ShowS
$cshowsPrec :: Int -> StandingsParams -> ShowS
Show

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

-- | 'getContests' @isGym@ returns a list of contests that may or may not be gym
-- contests.
getContests :: Bool -> IO (Either ResponseError [Contest])
getContests :: Bool -> IO (Either ResponseError [Contest])
getContests Bool
isGym = String -> Query -> IO (Either ResponseError [Contest])
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData String
"/contest.list" [(ByteString
"gym", Bool -> Maybe ByteString
argBool Bool
isGym)]

-- | 'getContestStandings' @standingsParams@ returns information about the
-- contest and a part of the standings list.
getContestStandings :: StandingsParams -> IO (Either ResponseError Standings)
getContestStandings :: StandingsParams -> IO (Either ResponseError Standings)
getContestStandings StandingsParams {Bool
Maybe Int
Maybe [Handle]
ContestId
paramHandles :: Maybe [Handle]
paramUnofficial :: Bool
paramRoom :: Maybe Int
paramRowCount :: Maybe Int
paramFrom :: Maybe Int
paramContestId :: ContestId
paramHandles :: StandingsParams -> Maybe [Handle]
paramUnofficial :: StandingsParams -> Bool
paramRoom :: StandingsParams -> Maybe Int
paramRowCount :: StandingsParams -> Maybe Int
paramFrom :: StandingsParams -> Maybe Int
paramContestId :: StandingsParams -> ContestId
..} = String -> Query -> IO (Either ResponseError Standings)
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData
    String
"/contest.standings"
    [ (ByteString
"contestId"     , ContestId -> Maybe ByteString
argContestId ContestId
paramContestId)
    , (ByteString
"from"          , Int -> Maybe ByteString
argInt (Int -> Maybe ByteString) -> Maybe Int -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
paramFrom)
    , (ByteString
"count"         , Int -> Maybe ByteString
argInt (Int -> Maybe ByteString) -> Maybe Int -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
paramRowCount)
    , (ByteString
"room"          , Int -> Maybe ByteString
argInt (Int -> Maybe ByteString) -> Maybe Int -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
paramRoom)
    , (ByteString
"showUnofficial", Bool -> Maybe ByteString
argBool Bool
paramUnofficial)
    , (ByteString
"handles"       , [Handle] -> Maybe ByteString
argHandles ([Handle] -> Maybe ByteString)
-> Maybe [Handle] -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [Handle]
paramHandles)
    ]

-- | Like 'getContestStandings' but returns the standings and the
-- 'RatingChange's for each user participating.
getContestStandings'
    :: StandingsParams
    -> IO (Either ResponseError (Standings, M.Map Handle RatingChange))
getContestStandings' :: StandingsParams
-> IO (Either ResponseError (Standings, Map Handle RatingChange))
getContestStandings' StandingsParams
params = ExceptT ResponseError IO (Standings, Map Handle RatingChange)
-> IO (Either ResponseError (Standings, Map Handle RatingChange))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ResponseError IO (Standings, Map Handle RatingChange)
 -> IO (Either ResponseError (Standings, Map Handle RatingChange)))
-> ExceptT ResponseError IO (Standings, Map Handle RatingChange)
-> IO (Either ResponseError (Standings, Map Handle RatingChange))
forall a b. (a -> b) -> a -> b
$ do
    Standings
ss  <- IO (Either ResponseError Standings)
-> ExceptT ResponseError IO Standings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResponseError Standings)
 -> ExceptT ResponseError IO Standings)
-> IO (Either ResponseError Standings)
-> ExceptT ResponseError IO Standings
forall a b. (a -> b) -> a -> b
$ StandingsParams -> IO (Either ResponseError Standings)
getContestStandings StandingsParams
params
    [RatingChange]
rcs <- IO (Either ResponseError [RatingChange])
-> ExceptT ResponseError IO [RatingChange]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResponseError [RatingChange])
 -> ExceptT ResponseError IO [RatingChange])
-> IO (Either ResponseError [RatingChange])
-> ExceptT ResponseError IO [RatingChange]
forall a b. (a -> b) -> a -> b
$ ContestId -> IO (Either ResponseError [RatingChange])
getContestRatingChanges (StandingsParams -> ContestId
paramContestId StandingsParams
params)

    let rcsMap :: Map Handle RatingChange
rcsMap = [(Handle, RatingChange)] -> Map Handle RatingChange
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Handle, RatingChange)] -> Map Handle RatingChange)
-> [(Handle, RatingChange)] -> Map Handle RatingChange
forall a b. (a -> b) -> a -> b
$ (RatingChange -> (Handle, RatingChange))
-> [RatingChange] -> [(Handle, RatingChange)]
forall a b. (a -> b) -> [a] -> [b]
map (RatingChange -> Handle
rcHandle (RatingChange -> Handle)
-> (Handle -> RatingChange -> (Handle, RatingChange))
-> RatingChange
-> (Handle, RatingChange)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (,)) [RatingChange]
rcs

    (Standings, Map Handle RatingChange)
-> ExceptT ResponseError IO (Standings, Map Handle RatingChange)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Standings
ss, Map Handle RatingChange
rcsMap)

-- | 'getContestSubmissions' @contestId handle@ returns the submissions made by
-- the user in the contest given by @contestId@
getContestSubmissions
    :: ContestId -> Handle -> IO (Either ResponseError [Submission])
getContestSubmissions :: ContestId -> Handle -> IO (Either ResponseError [Submission])
getContestSubmissions ContestId
cId Handle
h = String -> Query -> IO (Either ResponseError [Submission])
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData
    String
"/contest.status"
    [(ByteString
"contestId", ContestId -> Maybe ByteString
argContestId ContestId
cId), (ByteString
"handle", Handle -> Maybe ByteString
argHandle Handle
h)]

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

-- | 'getAllProblemData' @tags@ returns a 'ProblemsResponse' filtered by the
-- @tags@, if supplied.
getAllProblemData :: [ProblemTag] -> IO (Either ResponseError ProblemsResponse)
getAllProblemData :: [ProblemTag] -> IO (Either ResponseError ProblemsResponse)
getAllProblemData [ProblemTag]
ts = String -> Query -> IO (Either ResponseError ProblemsResponse)
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData String
"/problemset.problems" [(ByteString
"tags", [ProblemTag] -> Maybe ByteString
argTags [ProblemTag]
ts)]

-- | 'getProblems' @tags@ returns a list of 'Problem's containing the @tags@, if
-- provided.
getProblems :: [ProblemTag] -> IO (Either ResponseError [Problem])
getProblems :: [ProblemTag] -> IO (Either ResponseError [Problem])
getProblems [ProblemTag]
ts = (ProblemsResponse -> [Problem])
-> Either ResponseError ProblemsResponse
-> Either ResponseError [Problem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProblemsResponse -> [Problem]
prProblems (Either ResponseError ProblemsResponse
 -> Either ResponseError [Problem])
-> IO (Either ResponseError ProblemsResponse)
-> IO (Either ResponseError [Problem])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProblemTag] -> IO (Either ResponseError ProblemsResponse)
getAllProblemData [ProblemTag]
ts

-- | Like 'getProblems' but returns a list of 'ProblemStats'.
getProblemStats :: [ProblemTag] -> IO (Either ResponseError [ProblemStats])
getProblemStats :: [ProblemTag] -> IO (Either ResponseError [ProblemStats])
getProblemStats [ProblemTag]
ts = (ProblemsResponse -> [ProblemStats])
-> Either ResponseError ProblemsResponse
-> Either ResponseError [ProblemStats]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProblemsResponse -> [ProblemStats]
prStats (Either ResponseError ProblemsResponse
 -> Either ResponseError [ProblemStats])
-> IO (Either ResponseError ProblemsResponse)
-> IO (Either ResponseError [ProblemStats])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProblemTag] -> IO (Either ResponseError ProblemsResponse)
getAllProblemData [ProblemTag]
ts

-- | 'getContestProblems' @contestId@ returns the list of problems for the given
-- contest.
--
-- This should be used instead of filtering results from 'getProblems' for two
-- main reasons:
--
--     (1) 'problemContestId' can only refer to one contest, so problems
--         appearing in multiple contests may not be filtered correctly.
--     (2) 'getProblems' returns larger output potentially affecting performance
--
getContestProblems :: ContestId -> IO (Either ResponseError [Problem])
getContestProblems :: ContestId -> IO (Either ResponseError [Problem])
getContestProblems ContestId
cId = (Standings -> [Problem])
-> Either ResponseError Standings -> Either ResponseError [Problem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Standings -> [Problem]
standingsProblems (Either ResponseError Standings -> Either ResponseError [Problem])
-> IO (Either ResponseError Standings)
-> IO (Either ResponseError [Problem])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StandingsParams -> IO (Either ResponseError Standings)
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
1
                    , paramRowCount :: Maybe Int
paramRowCount   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
                    , paramRoom :: Maybe Int
paramRoom       = Maybe Int
forall a. Maybe a
Nothing
                    , paramUnofficial :: Bool
paramUnofficial = Bool
False
                    , paramHandles :: Maybe [Handle]
paramHandles    = Maybe [Handle]
forall a. Maybe a
Nothing
                    }

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

-- | 'getContestRatingChanges' @contestId@ returns a list of 'RatingChange's
-- for the contest.
getContestRatingChanges
    :: ContestId -> IO (Either ResponseError [RatingChange])
getContestRatingChanges :: ContestId -> IO (Either ResponseError [RatingChange])
getContestRatingChanges ContestId
cId =
    String -> Query -> IO (Either ResponseError [RatingChange])
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData String
"/contest.ratingChanges" [(ByteString
"contestId", ContestId -> Maybe ByteString
argContestId ContestId
cId)]

-- | 'getUserRatingHistory' @handle@ returns a list of 'RatingChange's for the
-- requested user
getUserRatingHistory :: Handle -> IO (Either ResponseError [RatingChange])
getUserRatingHistory :: Handle -> IO (Either ResponseError [RatingChange])
getUserRatingHistory Handle
h = String -> Query -> IO (Either ResponseError [RatingChange])
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData String
"/user.rating" [(ByteString
"handle", Handle -> Maybe ByteString
argHandle Handle
h)]

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

-- | 'getUser' @handle@ returns the 'User' with the given @handle@
getUser :: Handle -> IO (Either ResponseError User)
getUser :: Handle -> IO (Either ResponseError User)
getUser Handle
h = ([User] -> User)
-> Either ResponseError [User] -> Either ResponseError User
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [User] -> User
forall a. [a] -> a
head (Either ResponseError [User] -> Either ResponseError User)
-> IO (Either ResponseError [User])
-> IO (Either ResponseError User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Handle] -> IO (Either ResponseError [User])
getUsers [Handle
h]

-- | 'getUsers' @handles@ returns a list of 'User's with the given @handles@
getUsers :: [Handle] -> IO (Either ResponseError [User])
getUsers :: [Handle] -> IO (Either ResponseError [User])
getUsers [] = Either ResponseError [User] -> IO (Either ResponseError [User])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError [User] -> IO (Either ResponseError [User]))
-> Either ResponseError [User] -> IO (Either ResponseError [User])
forall a b. (a -> b) -> a -> b
$ [User] -> Either ResponseError [User]
forall a b. b -> Either a b
Right []
getUsers [Handle]
hs = String -> Query -> IO (Either ResponseError [User])
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData String
"/user.info" [(ByteString
"handles", [Handle] -> Maybe ByteString
argHandles [Handle]
hs)]

-- 'getFriends' @config@ returns the handles of the friends of the currently
-- authenticated user.
getFriends :: UserConfig -> IO (Either ResponseError [Handle])
getFriends :: UserConfig -> IO (Either ResponseError [Handle])
getFriends UserConfig
cfg = UserConfig -> String -> Query -> IO (Either ResponseError [Handle])
forall a.
FromJSON a =>
UserConfig -> String -> Query -> IO (Either ResponseError a)
getAuthorizedData UserConfig
cfg String
"/user.friends" []

-- | 'getUserStatus' @handle from count@ returns the @count@ most recent
-- submissions by the user, starting from the @from@-th one.
getUserStatus :: Handle -> Int -> Int -> IO (Either ResponseError [Submission])
getUserStatus :: Handle -> Int -> Int -> IO (Either ResponseError [Submission])
getUserStatus Handle
h Int
f Int
n = String -> Query -> IO (Either ResponseError [Submission])
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData
    String
"/user.status"
    [(ByteString
"handle", Handle -> Maybe ByteString
argHandle Handle
h), (ByteString
"from", Int -> Maybe ByteString
argInt Int
f), (ByteString
"count", Int -> Maybe ByteString
argInt Int
n)]

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

-- | 'calculateVirtualResult' @contestId handle points penalty@ computes the
-- rating change the user would gain had they competed in the contest live, and
-- their expected ranking for the contest.
--
calculateVirtualResult
    :: ContestId
    -> Handle
    -> Points
    -> Int
    -> IO (Either ResponseError (User, Maybe VirtualResult))
calculateVirtualResult :: ContestId
-> Handle
-> Points
-> Int
-> IO (Either ResponseError (User, Maybe VirtualResult))
calculateVirtualResult ContestId
cId Handle
handle Points
points Int
penalty = ExceptT ResponseError IO (User, Maybe VirtualResult)
-> IO (Either ResponseError (User, Maybe VirtualResult))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ResponseError IO (User, Maybe VirtualResult)
 -> IO (Either ResponseError (User, Maybe VirtualResult)))
-> ExceptT ResponseError IO (User, Maybe VirtualResult)
-> IO (Either ResponseError (User, Maybe VirtualResult))
forall a b. (a -> b) -> a -> b
$ do
    [RatingChange]
rcs       <- IO (Either ResponseError [RatingChange])
-> ExceptT ResponseError IO [RatingChange]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResponseError [RatingChange])
 -> ExceptT ResponseError IO [RatingChange])
-> IO (Either ResponseError [RatingChange])
-> ExceptT ResponseError IO [RatingChange]
forall a b. (a -> b) -> a -> b
$ ContestId -> IO (Either ResponseError [RatingChange])
getContestRatingChanges ContestId
cId

    Standings
standings <- IO (Either ResponseError Standings)
-> ExceptT ResponseError IO Standings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResponseError Standings)
 -> ExceptT ResponseError IO Standings)
-> IO (Either ResponseError Standings)
-> ExceptT ResponseError IO Standings
forall a b. (a -> b) -> a -> b
$ StandingsParams -> IO (Either ResponseError Standings)
getContestStandings (StandingsParams -> IO (Either ResponseError Standings))
-> StandingsParams -> IO (Either ResponseError Standings)
forall a b. (a -> b) -> a -> b
$ StandingsParams :: ContestId
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Maybe [Handle]
-> StandingsParams
StandingsParams
        { paramContestId :: ContestId
paramContestId  = ContestId
cId
        , paramFrom :: Maybe Int
paramFrom       = Maybe Int
forall a. Maybe a
Nothing
        , paramRowCount :: Maybe Int
paramRowCount   = Maybe Int
forall a. Maybe a
Nothing
        , paramRoom :: Maybe Int
paramRoom       = Maybe Int
forall a. Maybe a
Nothing
        , paramUnofficial :: Bool
paramUnofficial = Bool
False
        , paramHandles :: Maybe [Handle]
paramHandles    = Maybe [Handle]
forall a. Maybe a
Nothing
        }

    User
user <- IO (Either ResponseError User) -> ExceptT ResponseError IO User
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResponseError User) -> ExceptT ResponseError IO User)
-> IO (Either ResponseError User) -> ExceptT ResponseError IO User
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Either ResponseError User)
getUser Handle
handle
    let vUser :: VirtualUser
vUser = VirtualUser :: Points -> Int -> Int -> VirtualUser
VirtualUser { vuPoints :: Points
vuPoints  = Points
points
                            , vuPenalty :: Int
vuPenalty = Int
penalty
                            , vuRating :: Int
vuRating  = User -> Int
userRating User
user
                            }
        result :: Maybe VirtualResult
result = VirtualUser
-> [RatingChange] -> [RanklistRow] -> Maybe VirtualResult
calculateResult VirtualUser
vUser [RatingChange]
rcs (Standings -> [RanklistRow]
standingsRanklist Standings
standings)

    (User, Maybe VirtualResult)
-> ExceptT ResponseError IO (User, Maybe VirtualResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (User
user, Maybe VirtualResult
result)

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

argBool :: Bool -> Maybe BC.ByteString
argBool :: Bool -> Maybe ByteString
argBool = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Bool -> ByteString) -> Bool -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack (String -> ByteString) -> (Bool -> String) -> Bool -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show

argText :: T.Text -> Maybe BC.ByteString
argText :: ProblemTag -> Maybe ByteString
argText = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (ProblemTag -> ByteString) -> ProblemTag -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProblemTag -> ByteString
T.encodeUtf8

argTexts :: [T.Text] -> Maybe BC.ByteString
argTexts :: [ProblemTag] -> Maybe ByteString
argTexts [ProblemTag]
xs | [ProblemTag] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProblemTag]
xs   = Maybe ByteString
forall a. Maybe a
Nothing
            | Bool
otherwise = (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> ([ProblemTag] -> ByteString) -> [ProblemTag] -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProblemTag -> ByteString
T.encodeUtf8 (ProblemTag -> ByteString)
-> ([ProblemTag] -> ProblemTag) -> [ProblemTag] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProblemTag -> [ProblemTag] -> ProblemTag
T.intercalate ProblemTag
";") [ProblemTag]
xs

argInt :: Int -> Maybe BC.ByteString
argInt :: Int -> Maybe ByteString
argInt = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Int -> ByteString) -> Int -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

argContestId :: ContestId -> Maybe BC.ByteString
argContestId :: ContestId -> Maybe ByteString
argContestId = Int -> Maybe ByteString
argInt (Int -> Maybe ByteString)
-> (ContestId -> Int) -> ContestId -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContestId -> Int
unContestId

argHandle :: Handle -> Maybe BC.ByteString
argHandle :: Handle -> Maybe ByteString
argHandle = ProblemTag -> Maybe ByteString
argText (ProblemTag -> Maybe ByteString)
-> (Handle -> ProblemTag) -> Handle -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ProblemTag
unHandle

argHandles :: [Handle] -> Maybe BC.ByteString
argHandles :: [Handle] -> Maybe ByteString
argHandles = [ProblemTag] -> Maybe ByteString
argTexts ([ProblemTag] -> Maybe ByteString)
-> ([Handle] -> [ProblemTag]) -> [Handle] -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> ProblemTag) -> [Handle] -> [ProblemTag]
forall a b. (a -> b) -> [a] -> [b]
map Handle -> ProblemTag
unHandle

argTags :: [ProblemTag] -> Maybe BC.ByteString
argTags :: [ProblemTag] -> Maybe ByteString
argTags = [ProblemTag] -> Maybe ByteString
argTexts

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