Improve alternative leaderboard

This commit is contained in:
Filip Graliński 2019-12-16 16:51:52 +01:00
parent 9267bf7f32
commit e27766b0a6

View File

@ -135,7 +135,7 @@ leaderboardTable mauthId challengeName repoScheme challengeRepo tests = mempty
altLeaderboardTable :: Maybe UserId -> Text -> RepoScheme -> Repo -> [Entity Test] -> Table App (Int, LeaderboardEntry) altLeaderboardTable :: Maybe UserId -> Text -> RepoScheme -> Repo -> [Entity Test] -> Table App (Int, LeaderboardEntry)
altLeaderboardTable mauthId challengeName repoScheme challengeRepo tests = mempty altLeaderboardTable mauthId challengeName repoScheme challengeRepo tests = mempty
++ Table.int "#" fst ++ Table.int "#" fst
++ leaderboardDescriptionCell mauthId ++ leaderboardOnlyTagsCell mauthId
++ mconcat (map (\e@(Entity _ t) -> resultCell t (extractScoreFromLeaderboardEntry (getTestReference e) . snd)) tests) ++ mconcat (map (\e@(Entity _ t) -> resultCell t (extractScoreFromLeaderboardEntry (getTestReference e) . snd)) tests)
++ statusCell challengeName repoScheme challengeRepo (\(_, e) -> (leaderboardBestSubmissionId e, ++ statusCell challengeName repoScheme challengeRepo (\(_, e) -> (leaderboardBestSubmissionId e,
leaderboardBestSubmission e, leaderboardBestSubmission e,
@ -159,6 +159,14 @@ leaderboardDescriptionCell mauthId = Table.widget "description" (
(leaderboardTags entry) (leaderboardTags entry)
) )
leaderboardOnlyTagsCell :: Maybe UserId -> Table App (a, LeaderboardEntry)
leaderboardOnlyTagsCell mauthId = Table.widget "tags" (
\(_,entry) -> fragmentWithSubmissionTags ("" :: Text)
(getInfoLink (leaderboardBestSubmission entry)
(leaderboardUserId entry)
mauthId)
(leaderboardTags entry)
)
hoverTextCell :: Text -> (a -> Text) -> (a -> Text) -> Table site a hoverTextCell :: Text -> (a -> Text) -> (a -> Text) -> Table site a