-------------------------------------------------------------------------------- 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 m = ExceptT $ left ResponseError <$> m -------------------------------------------------------------------------------- -- | Query parameters for retrieving contest standings. data StandingsParams = StandingsParams { -- | ID of the contest paramContestId :: ContestId -- | The starting index of the ranklist (1-based) , paramFrom :: Maybe Int -- | The number of standing rows to return , paramRowCount :: Maybe Int -- | If specified, only standings of this room are returned , paramRoom :: Maybe Int -- | If true, all participations are included. Otherwise only 'Contestant' -- participations are included. , paramUnofficial :: Bool -- | If specified, the standings includes only these users. , paramHandles :: Maybe [Handle] } deriving Show -------------------------------------------------------------------------------- -- | 'getContests' @isGym@ returns a list of contests that may or may not be gym -- contests. getContests :: Bool -> IO (Either ResponseError [Contest]) getContests isGym = getData "/contest.list" [("gym", argBool isGym)] -- | 'getContestStandings' @standingsParams@ returns information about the -- contest and a part of the standings list. getContestStandings :: StandingsParams -> IO (Either ResponseError Standings) getContestStandings StandingsParams {..} = getData "/contest.standings" [ ("contestId" , argContestId paramContestId) , ("from" , argInt =<< paramFrom) , ("count" , argInt =<< paramRowCount) , ("room" , argInt =<< paramRoom) , ("showUnofficial", argBool paramUnofficial) , ("handles" , argHandles =<< 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' params = runExceptT $ do ss <- ExceptT $ getContestStandings params rcs <- ExceptT $ getContestRatingChanges (paramContestId params) let rcsMap = M.fromList $ map (rcHandle >>= (,)) rcs pure (ss, 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 cId h = getData "/contest.status" [("contestId", argContestId cId), ("handle", argHandle h)] -------------------------------------------------------------------------------- -- | 'getAllProblemData' @tags@ returns a 'ProblemsResponse' filtered by the -- @tags@, if supplied. getAllProblemData :: [ProblemTag] -> IO (Either ResponseError ProblemsResponse) getAllProblemData ts = getData "/problemset.problems" [("tags", argTags ts)] -- | 'getProblems' @tags@ returns a list of 'Problem's containing the @tags@, if -- provided. getProblems :: [ProblemTag] -> IO (Either ResponseError [Problem]) getProblems ts = fmap prProblems <$> getAllProblemData ts -- | Like 'getProblems' but returns a list of 'ProblemStats'. getProblemStats :: [ProblemTag] -> IO (Either ResponseError [ProblemStats]) getProblemStats ts = fmap prStats <$> getAllProblemData 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 cId = fmap standingsProblems <$> getContestStandings StandingsParams { paramContestId = cId , paramFrom = Just 1 , paramRowCount = Just 1 , paramRoom = Nothing , paramUnofficial = False , paramHandles = Nothing } -------------------------------------------------------------------------------- -- | 'getContestRatingChanges' @contestId@ returns a list of 'RatingChange's -- for the contest. getContestRatingChanges :: ContestId -> IO (Either ResponseError [RatingChange]) getContestRatingChanges cId = getData "/contest.ratingChanges" [("contestId", argContestId cId)] -- | 'getUserRatingHistory' @handle@ returns a list of 'RatingChange's for the -- requested user getUserRatingHistory :: Handle -> IO (Either ResponseError [RatingChange]) getUserRatingHistory h = getData "/user.rating" [("handle", argHandle h)] -------------------------------------------------------------------------------- -- | 'getUser' @handle@ returns the 'User' with the given @handle@ getUser :: Handle -> IO (Either ResponseError User) getUser h = fmap head <$> getUsers [h] -- | 'getUsers' @handles@ returns a list of 'User's with the given @handles@ getUsers :: [Handle] -> IO (Either ResponseError [User]) getUsers [] = pure $ Right [] getUsers hs = getData "/user.info" [("handles", argHandles hs)] -- 'getFriends' @config@ returns the handles of the friends of the currently -- authenticated user. getFriends :: UserConfig -> IO (Either ResponseError [Handle]) getFriends cfg = getAuthorizedData cfg "/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 h f n = getData "/user.status" [("handle", argHandle h), ("from", argInt f), ("count", argInt 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 cId handle points penalty = runExceptT $ do rcs <- ExceptT $ getContestRatingChanges cId standings <- ExceptT $ getContestStandings $ StandingsParams { paramContestId = cId , paramFrom = Nothing , paramRowCount = Nothing , paramRoom = Nothing , paramUnofficial = False , paramHandles = Nothing } user <- ExceptT $ getUser handle let vUser = VirtualUser { vuPoints = points , vuPenalty = penalty , vuRating = userRating user } result = calculateResult vUser rcs (standingsRanklist standings) pure (user, result) -------------------------------------------------------------------------------- argBool :: Bool -> Maybe BC.ByteString argBool = Just . BC.pack . show argText :: T.Text -> Maybe BC.ByteString argText = Just . T.encodeUtf8 argTexts :: [T.Text] -> Maybe BC.ByteString argTexts xs | null xs = Nothing | otherwise = (Just . T.encodeUtf8 . T.intercalate ";") xs argInt :: Int -> Maybe BC.ByteString argInt = Just . BC.pack . show argContestId :: ContestId -> Maybe BC.ByteString argContestId = argInt . unContestId argHandle :: Handle -> Maybe BC.ByteString argHandle = argText . unHandle argHandles :: [Handle] -> Maybe BC.ByteString argHandles = argTexts . map unHandle argTags :: [ProblemTag] -> Maybe BC.ByteString argTags = argTexts --------------------------------------------------------------------------------