Add leaderboard JSON

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
 

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

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

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