refactor generating tables

This commit is contained in:
Filip Gralinski 2016-02-17 09:43:25 +01:00
parent c5a2b4e9c3
commit f14febf984
4 changed files with 18 additions and 27 deletions

View File

@ -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

View File

@ -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 challengeName tests = mempty
++ Table.text "submitter" (formatSubmitter . (\(_, Entity _ submitter, _) -> submitter) . fst)
++ timestampCell "when" (submissionStamp . (\(Entity _ s, _, _) -> s) . fst)
++ Table.text "description" (submissionDescription . (\(Entity _ s, _, _) -> s) . fst)
-- ++ mconcat (map (\(Entity k t) -> Table.string (testName t) ((submissionScore k t) . fst)) tests)
++ mconcat (map (\(Entity k t) -> resultCell t ((extractScore k) . fst)) tests)
++ statusCell challengeName (\((Entity submissionId submission, Entity userId _, _), mauthId) -> (submissionId, submission, userId, mauthId))
submissionsTable :: Maybe UserId -> Text -> [Entity Test] -> Table App (Entity Submission, Entity User, Map (Key Test) Evaluation)
submissionsTable mauthId challengeName tests = mempty
++ Table.text "submitter" (formatSubmitter . (\(_, Entity _ submitter, _) -> submitter))
++ timestampCell "when" (submissionStamp . (\(Entity _ s, _, _) -> s))
++ Table.text "description" (submissionDescription . (\(Entity _ s, _, _) -> s))
++ mconcat (map (\(Entity k t) -> resultCell t (extractScore k)) tests)
++ statusCell challengeName (\(Entity submissionId submission, Entity userId _, _) -> (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 challengeName test = mempty
++ Table.int "#" (fst . fst)
++ Table.text "submitter" (formatSubmitter . leaderboardUser . snd . fst)
++ timestampCell "when" (submissionStamp . leaderboardBestSubmission . snd . fst)
++ Table.text "description" (submissionDescription . leaderboardBestSubmission . snd . fst)
++ resultCell test ((\e -> Just e) . leaderboardEvaluation . snd . fst)
++ Table.int "×" (leaderboardNumberOfSubmissions . snd . fst)
++ statusCell challengeName (\((_, e), mauthId) -> (leaderboardBestSubmissionId e,
leaderboardTable :: Maybe UserId -> Text -> Test -> Table App (Int, LeaderboardEntry)
leaderboardTable mauthId challengeName test = mempty
++ Table.int "#" fst
++ Table.text "submitter" (formatSubmitter . leaderboardUser . snd)
++ timestampCell "when" (submissionStamp . leaderboardBestSubmission . snd)
++ Table.text "description" (submissionDescription . leaderboardBestSubmission . snd)
++ resultCell test ((\e -> Just e) . leaderboardEvaluation . snd)
++ Table.int "×" (leaderboardNumberOfSubmissions . snd)
++ 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)

View File

@ -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">

View File

@ -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">