diff --git a/Handler/EditSubmission.hs b/Handler/EditSubmission.hs
index d4715ef..92df7e6 100644
--- a/Handler/EditSubmission.hs
+++ b/Handler/EditSubmission.hs
@@ -17,7 +17,7 @@ getEditSubmissionR submissionId = do
tags <- runDB $ getTags submissionId
let mTagsAsText = case tags of
[] -> Nothing
- _ -> Just $ T.intercalate ", " $ Import.map (tagName . entityVal) tags
+ _ -> Just $ T.intercalate ", " $ Import.map (tagName . entityVal . fst) tags
(formWidget, formEnctype) <- generateFormPost $ editSubmissionForm (submissionDescription submission) mTagsAsText
doEditSubmission formWidget formEnctype submissionId
diff --git a/Handler/SubmissionView.hs b/Handler/SubmissionView.hs
index 6649fac..6942201 100644
--- a/Handler/SubmissionView.hs
+++ b/Handler/SubmissionView.hs
@@ -38,4 +38,5 @@ getTags submissionId = do
sts <- selectList [SubmissionTagSubmission ==. submissionId] []
let tagIds = Import.map (submissionTagTag . entityVal) sts
tags <- mapM get404 $ tagIds
- return $ Import.map (\(k, v) -> Entity k v) $ Import.zip tagIds tags
+ let tagEnts = Import.map (\(k, v) -> Entity k v) $ Import.zip tagIds tags
+ return $ zip tagEnts sts
diff --git a/Handler/Tables.hs b/Handler/Tables.hs
index f858b95..bb61631 100644
--- a/Handler/Tables.hs
+++ b/Handler/Tables.hs
@@ -29,10 +29,10 @@ data LeaderboardEntry = LeaderboardEntry {
leaderboardBestSubmissionId :: SubmissionId,
leaderboardEvaluation :: Evaluation,
leaderboardNumberOfSubmissions :: Int,
- leaderboardTags :: [Entity Tag]
+ leaderboardTags :: [(Entity Tag, Entity SubmissionTag)]
}
-submissionsTable :: Maybe UserId -> Text -> [Entity Test] -> Table App (Entity Submission, Entity User, Map (Key Test) Evaluation, [Entity Tag])
+submissionsTable :: Maybe UserId -> Text -> [Entity Test] -> Table App (Entity Submission, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])
submissionsTable mauthId challengeName tests = mempty
++ Table.text "submitter" (formatSubmitter . (\(_, Entity _ submitter, _, _) -> submitter))
++ timestampCell "when" (submissionStamp . (\(Entity _ s, _, _, _) -> s))
@@ -41,9 +41,9 @@ submissionsTable mauthId challengeName tests = mempty
++ statusCell challengeName (\(Entity submissionId submission, Entity userId _, _, _) -> (submissionId, submission, userId, mauthId))
descriptionCell = Table.widget "description" (
- \(Entity _ s, _, _ ,tagEnts) -> fragmentWithTags (submissionDescription s) tagEnts)
+ \(Entity _ s, _, _ ,tagEnts) -> fragmentWithSubmissionTags (submissionDescription s) tagEnts)
-extractScore :: Key Test -> (Entity Submission, Entity User, Map (Key Test) Evaluation, [Entity Tag]) -> Maybe Evaluation
+extractScore :: Key Test -> (Entity Submission, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)]) -> Maybe Evaluation
extractScore k (_, _, m, _) = lookup k m
leaderboardTable :: Maybe UserId -> Text -> Test -> Table App (Int, LeaderboardEntry)
@@ -60,7 +60,7 @@ leaderboardTable mauthId challengeName test = mempty
mauthId))
leaderboardDescriptionCell = Table.widget "description" (
- \(_,entry) -> fragmentWithTags (submissionDescription $ leaderboardBestSubmission entry) (leaderboardTags entry))
+ \(_,entry) -> fragmentWithSubmissionTags (submissionDescription $ leaderboardBestSubmission entry) (leaderboardTags entry))
@@ -112,7 +112,7 @@ getAuxSubmissions testId evaluationMaps = map (processEvaluationMap testId) eval
Nothing -> []))
-getAuxSubmissionEnts :: Key Test -> [(Entity Submission, Entity User, Map (Key Test) Evaluation, [Entity Tag])] -> [(Key User, (User, [((Entity Submission), Evaluation)]))]
+getAuxSubmissionEnts :: Key Test -> [(Entity Submission, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])] -> [(Key User, (User, [((Entity Submission), Evaluation)]))]
getAuxSubmissionEnts testId evaluationMaps = map (processEvaluationMap testId) evaluationMaps
where processEvaluationMap testId (s, (Entity ui u), m, _) = (ui, (u, case Map.lookup testId m of
Just e -> [(s, e)]
@@ -160,7 +160,7 @@ compareFun :: MetricOrdering -> Double -> Double -> Ordering
compareFun TheLowerTheBetter = flip compare
compareFun TheHigherTheBetter = compare
-getChallengeSubmissionInfos :: ((Entity Submission) -> Bool) -> Key Challenge -> Handler ([(Entity Submission, Entity User, Map (Key Test) Evaluation, [Entity Tag])], [Entity Test])
+getChallengeSubmissionInfos :: ((Entity Submission) -> Bool) -> Key Challenge -> Handler ([(Entity Submission, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])], [Entity Test])
getChallengeSubmissionInfos condition challengeId = do
allSubmissions <- runDB $ selectList [SubmissionChallenge ==. challengeId] [Desc SubmissionStamp]
let submissions = filter condition allSubmissions
@@ -168,7 +168,7 @@ getChallengeSubmissionInfos condition challengeId = do
evaluationMaps <- mapM getEvaluationMap submissions
return (evaluationMaps, tests)
-getEvaluationMap :: Entity Submission -> Handler (Entity Submission, Entity User, Map (Key Test) Evaluation, [Entity Tag])
+getEvaluationMap :: Entity Submission -> Handler (Entity Submission, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])
getEvaluationMap s@(Entity submissionId submission) = do
outs <- runDB $ selectList [OutSubmission ==. submissionId] []
user <- runDB $ get404 $ submissionSubmitter submission
diff --git a/Handler/TagUtils.hs b/Handler/TagUtils.hs
index 780a750..41bc2ff 100644
--- a/Handler/TagUtils.hs
+++ b/Handler/TagUtils.hs
@@ -27,3 +27,15 @@ fragmentWithTags t tagEnts = [whamlet|
$forall (Entity _ v) <- tagEnts
\ #{tagName v}
|]
+
+fragmentWithSubmissionTags t tagEnts = [whamlet|
+#{t}
+
+$forall ((Entity _ v), (Entity _ s)) <- tagEnts
+ \ #{tagName v}
+|]
+
+tagClass :: Maybe Bool -> Text
+tagClass (Just True) = "label-success"
+tagClass (Just False) = "label-default"
+tagClass Nothing = "label-primary"