From acedcef793d069d77187e07925dbbd8b978af791 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Thu, 15 Oct 2020 22:27:16 +0200
Subject: [PATCH] Add leaderboard JSON

---
 Foundation.hs             |  1 +
 Handler/ListChallenges.hs |  4 +++-
 Handler/ShowChallenge.hs  | 27 +++++++++++++++++++++++++++
 config/routes             |  1 +
 4 files changed, 32 insertions(+), 1 deletion(-)

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