refactor generating tables

Handler/ShowChallenge.hs

@@ -49,7 +49,6 @@ getChallengeReadmeR name = do
 
 showChallengeWidget muserId challenge test repo leaderboard = $(widgetFile "show-challenge")
   where leaderboardWithRanks = zip [1..] leaderboard
-        leaderboardWithRanksAndCurrentUser = map (\e -> (e, muserId)) leaderboardWithRanks
         maybeRepoLink = getRepoLink repo
 
 
@@ -265,7 +264,6 @@ getChallengeSubmissions condition name = do
   challengeLayout True challenge (challengeAllSubmissionsWidget muserId challenge evaluationMaps tests)
 
 challengeAllSubmissionsWidget muserId challenge submissions tests = $(widgetFile "challenge-all-submissions")
-    where submissionsWithCurrentUser = map (\e -> (e, muserId)) submissions
 
 challengeLayout withHeader challenge widget = do
   bc <- widgetToPageContent widget

Handler/Tables.hs

@@ -32,27 +32,26 @@ data LeaderboardEntry = LeaderboardEntry {
   leaderboardNumberOfSubmissions :: Int
 }
 
-submissionsTable :: Text -> [Entity Test] -> Table App ((Entity Submission, Entity User, Map (Key Test) Evaluation), Maybe UserId)
+submissionsTable :: Maybe UserId -> Text -> [Entity Test] -> Table App (Entity Submission, Entity User, Map (Key Test) Evaluation)
-submissionsTable challengeName tests = mempty
+submissionsTable mauthId challengeName tests = mempty
-  ++ Table.text "submitter" (formatSubmitter . (\(_, Entity _ submitter, _) -> submitter) . fst)
+  ++ Table.text "submitter" (formatSubmitter . (\(_, Entity _ submitter, _) -> submitter))
-  ++ timestampCell "when" (submissionStamp . (\(Entity _ s, _, _) -> s) . fst)
+  ++ timestampCell "when" (submissionStamp . (\(Entity _ s, _, _) -> s))
-  ++ Table.text "description" (submissionDescription . (\(Entity _ s, _,  _) -> s) . fst)
+  ++ Table.text "description" (submissionDescription . (\(Entity _ s, _,  _) -> s))
---  ++ mconcat (map (\(Entity k t) -> Table.string (testName t) ((submissionScore k t) . fst)) tests)
+  ++ mconcat (map (\(Entity k t) -> resultCell t (extractScore k)) tests)
-  ++ mconcat (map (\(Entity k t) -> resultCell t ((extractScore k) . fst)) tests)
+  ++ statusCell challengeName (\(Entity submissionId submission, Entity userId _, _) -> (submissionId, submission, userId, mauthId))
-  ++ statusCell challengeName (\((Entity submissionId submission, Entity userId _, _), mauthId) -> (submissionId, submission, userId, mauthId))
 
 extractScore :: Key Test -> (Entity Submission, Entity User, Map (Key Test) Evaluation) -> Maybe Evaluation
 extractScore k (_, _, m) = lookup k m
 
-leaderboardTable :: Text -> Test -> Table App ((Int, LeaderboardEntry), Maybe UserId)
+leaderboardTable :: Maybe UserId -> Text -> Test -> Table App (Int, LeaderboardEntry)
-leaderboardTable challengeName test = mempty
+leaderboardTable mauthId challengeName test = mempty
-  ++ Table.int "#" (fst . fst)
+  ++ Table.int "#" fst
-  ++ Table.text "submitter" (formatSubmitter . leaderboardUser . snd . fst)
+  ++ Table.text "submitter" (formatSubmitter . leaderboardUser . snd)
-  ++ timestampCell "when" (submissionStamp . leaderboardBestSubmission . snd . fst)
+  ++ timestampCell "when" (submissionStamp . leaderboardBestSubmission . snd)
-  ++ Table.text "description" (submissionDescription . leaderboardBestSubmission . snd . fst)
+  ++ Table.text "description" (submissionDescription . leaderboardBestSubmission . snd)
-  ++ resultCell test ((\e -> Just e) . leaderboardEvaluation . snd . fst)
+  ++ resultCell test ((\e -> Just e) . leaderboardEvaluation . snd)
-  ++ Table.int "×" (leaderboardNumberOfSubmissions . snd . fst)
+  ++ Table.int "×" (leaderboardNumberOfSubmissions . snd)
-  ++ statusCell challengeName (\((_, e), mauthId) -> (leaderboardBestSubmissionId e,
+  ++ statusCell challengeName (\(_, e) -> (leaderboardBestSubmissionId e,
                                        leaderboardBestSubmission e,
                                        leaderboardUserId e,
                                        mauthId))
@@ -171,9 +170,3 @@ formatSubmitter user = if userIsAnonymous user
                             case userName user of
                               Just name -> name
                               Nothing -> "[name not given]"
-
-submissionScore :: Key Test -> Test -> (Entity Submission, Entity User, Map (Key Test) Evaluation) -> String
-submissionScore k t (_, _, m) = fromMaybe "N/A" (presentScore t <$> lookup k m)
-
-presentScore :: Test -> Evaluation -> String
-presentScore test evaluation = fromMaybe "???" (show <$> evaluationScore evaluation)

templates/challenge-all-submissions.hamlet

@@ -1,7 +1,7 @@
 <div class="alert alert-info" role="alert">
             <p>This is a long list of all submissions, if you want to see only the best, click <a href="@{ShowChallengeR (challengeName challenge)}">leaderboard</a>.
 
-^{Table.buildBootstrap (submissionsTable (challengeName challenge) tests) submissionsWithCurrentUser}
+^{Table.buildBootstrap (submissionsTable muserId (challengeName challenge) tests) submissions}
 
 <div id="graph-container">
 

templates/show-challenge.hamlet

@@ -5,7 +5,7 @@ $nothing
 
 <h2>Leaderboard
 
-^{Table.buildBootstrap (leaderboardTable (challengeName challenge) test) leaderboardWithRanksAndCurrentUser}
+^{Table.buildBootstrap (leaderboardTable muserId (challengeName challenge) test) leaderboardWithRanks}
 
 <div id="graph-container">