diff --git a/Foundation.hs b/Foundation.hs index d1b3cf3..3e60e1d 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -153,6 +153,7 @@ instance Yesod App where isAuthorized (QueryResultsR _) _ = regularAuthorization isAuthorized ListChallengesR _ = regularAuthorization isAuthorized ListChallengesJsonR _ = regularAuthorization + isAuthorized (LeaderboardJsonR _) _ = regularAuthorization isAuthorized (ViewVariantR _ ) _ = regularAuthorization isAuthorized (ViewVariantTestR _ _) _ = regularAuthorization diff --git a/Handler/ListChallenges.hs b/Handler/ListChallenges.hs index 922a3cf..f6f87e6 100644 --- a/Handler/ListChallenges.hs +++ b/Handler/ListChallenges.hs @@ -16,9 +16,11 @@ getListArchivedChallengesR = generalListChallenges [ChallengeArchived ==. Just T instance ToJSON (Entity Challenge) where toJSON (Entity _ ch) = object - [ "link" .= ("/challenge/" <> (challengeName ch)) + [ "name" .= challengeName ch , "title" .= challengeTitle ch , "description" .= challengeDescription ch + , "starred" .= challengeStarred ch + , "archived" .= challengeArchived ch ] generalListChallengesJson :: [Filter Challenge] -> Handler Value diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index 77c9b64..2c78758 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -48,6 +48,33 @@ import Data.List (nub) import qualified Database.Esqueleto as E import Database.Esqueleto ((^.)) +instance ToJSON LeaderboardEntry where + toJSON entry = object + [ "submitter" .= (formatSubmitter $ leaderboardUser entry) + , "when" .= (submissionStamp $ leaderboardBestSubmission entry) + , "version" .= (formatVersion $ leaderboardVersion entry) + , "description" .= descriptionToBeShown (leaderboardBestSubmission entry) + (leaderboardBestVariant entry) + (leaderboardParams entry) + , "times" .= leaderboardNumberOfSubmissions entry + ] + +getLeaderboardJsonR :: Text -> Handler Value +getLeaderboardJsonR name = do + app <- getYesod + let leaderboardStyle = appLeaderboardStyle $ appSettings app + + Entity challengeId _ <- runDB $ getBy404 $ UniqueName name + (leaderboard, (_, tests)) <- getLeaderboardEntries 1 leaderboardStyle challengeId + return $ array $ map (leaderboardEntryJson tests) leaderboard + +leaderboardEntryJson tests entry = object [ + "metadata" .= entry, + "metrics" .= + map (\e@(Entity _ t) -> object [ + "metric" .= testName t, + "score" .= (formatTruncatedScore (getTestFormattingOpts t) $ extractScoreFromLeaderboardEntry (getTestReference e) entry)]) tests] + getShowChallengeR :: Text -> Handler Html getShowChallengeR name = do app <- getYesod diff --git a/config/routes b/config/routes index 3910c4a..da4b5c1 100644 --- a/config/routes +++ b/config/routes @@ -11,6 +11,7 @@ /open-view-progress/#Int OpenViewProgressR GET /list-challenges ListChallengesR GET /api/list-challenges ListChallengesJsonR GET +/api/leaderboard/#Text LeaderboardJsonR GET /list-archived-challenges ListArchivedChallengesR GET /challenge-image/#ChallengeId ChallengeImageR GET