filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

Show submission version

Browse Source
This commit is contained in:
Filip Gralinski 2019-08-29 10:01:36 +02:00
parent 1255577259
commit 14b78e7cdd
1 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
Handler/Tables.hs
View File

@ -52,16 +52,21 @@ data TableEntry = TableEntry {
tableEntryMapping :: Map TestReference Evaluation, tableEntryMapping :: Map TestReference Evaluation,
tableEntryTagsInfo :: [(Entity Tag, Entity SubmissionTag)], tableEntryTagsInfo :: [(Entity Tag, Entity SubmissionTag)],
tableEntryParams :: [Entity Parameter], tableEntryParams :: [Entity Parameter],
tableEntryRank :: Int } tableEntryRank :: Int,
tableEntryVersion :: (Int, Int, Int) }
tableEntryStamp :: TableEntry -> UTCTime tableEntryStamp :: TableEntry -> UTCTime
tableEntryStamp = submissionStamp . entityVal . tableEntrySubmission tableEntryStamp = submissionStamp . entityVal . tableEntrySubmission
formatVersion :: (Int, Int, Int) -> Text
formatVersion (major, minor, patch) = (Data.Text.pack $ show major) <> "." <> (Data.Text.pack $ show minor) <> "." <> (Data.Text.pack $ show patch)
submissionsTable :: Maybe UserId -> Text -> RepoScheme -> Repo -> [Entity Test] -> Table App TableEntry submissionsTable :: Maybe UserId -> Text -> RepoScheme -> Repo -> [Entity Test] -> Table App TableEntry
submissionsTable mauthId challengeName repoScheme challengeRepo tests = mempty submissionsTable mauthId challengeName repoScheme challengeRepo tests = mempty
++ Table.int "#" tableEntryRank ++ Table.int "#" tableEntryRank
++ Table.text "submitter" (formatSubmitter . entityVal . tableEntrySubmitter) ++ Table.text "submitter" (formatSubmitter . entityVal . tableEntrySubmitter)
++ timestampCell "when" tableEntryStamp ++ timestampCell "when" tableEntryStamp
++ Table.text "ver." (formatVersion . tableEntryVersion)
++ descriptionCell mauthId ++ descriptionCell mauthId
++ mconcat (map (\e@(Entity _ t) -> resultCell t (extractScore $ getTestReference e)) tests) ++ mconcat (map (\e@(Entity _ t) -> resultCell t (extractScore $ getTestReference e)) tests)
++ statusCell challengeName repoScheme challengeRepo (\tableEntry -> (entityKey $ tableEntrySubmission tableEntry, ++ statusCell challengeName repoScheme challengeRepo (\tableEntry -> (entityKey $ tableEntrySubmission tableEntry,
@ -88,7 +93,7 @@ paramExtractor paramName = Table.text paramName (\entry ->
descriptionCell :: Maybe UserId -> Table App TableEntry descriptionCell :: Maybe UserId -> Table App TableEntry
descriptionCell mauthId = Table.widget "description" ( descriptionCell mauthId = Table.widget "description" (
\(TableEntry (Entity _ s) (Entity _ v) (Entity u _) _ tagEnts paramEnts _) -> fragmentWithSubmissionTags \(TableEntry (Entity _ s) (Entity _ v) (Entity u _) _ tagEnts paramEnts _ _) -> fragmentWithSubmissionTags
(descriptionToBeShown s v (map entityVal paramEnts)) (descriptionToBeShown s v (map entityVal paramEnts))
(getInfoLink s u mauthId) (getInfoLink s u mauthId)
tagEnts) tagEnts)
@ -178,7 +183,7 @@ checkWhetherVisible submission userId mauthId = isPublic || isOwner
getAuxSubmissionEnts :: TestReference -> [TableEntry] -> [(Key User, (User, [(Entity Submission, Entity Variant, Evaluation)]))] getAuxSubmissionEnts :: TestReference -> [TableEntry] -> [(Key User, (User, [(Entity Submission, Entity Variant, Evaluation)]))]
getAuxSubmissionEnts testId evaluationMaps = map processEvaluationMap evaluationMaps getAuxSubmissionEnts testId evaluationMaps = map processEvaluationMap evaluationMaps
where processEvaluationMap (TableEntry s v (Entity ui u) m _ _ _) = (ui, (u, case Map.lookup testId m of where processEvaluationMap (TableEntry s v (Entity ui u) m _ _ _ _) = (ui, (u, case Map.lookup testId m of
Just e -> [(s, v, e)] Just e -> [(s, v, e)]
Nothing -> [])) Nothing -> []))
@ -211,7 +216,7 @@ getLeaderboardEntriesByCriterion challengeId condition selector = do
toLeaderboardEntry :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, PersistQueryRead (YesodPersistBackend site), YesodPersist site, Foldable t) => Key Challenge -> [Entity Test] -> t TableEntry -> HandlerFor site LeaderboardEntry toLeaderboardEntry :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, PersistQueryRead (YesodPersistBackend site), YesodPersist site, Foldable t) => Key Challenge -> [Entity Test] -> t TableEntry -> HandlerFor site LeaderboardEntry
toLeaderboardEntry challengeId tests ss = do toLeaderboardEntry challengeId tests ss = do
let bestOne = DL.maximumBy submissionComparator ss let bestOne = DL.maximumBy submissionComparator ss
let (TableEntry bestSubmission bestVariant user evals _ _ _) = bestOne let (TableEntry bestSubmission bestVariant user evals _ _ _ _) = bestOne
let submissionId = entityKey bestSubmission let submissionId = entityKey bestSubmission
tagEnts <- runDB $ getTags submissionId tagEnts <- runDB $ getTags submissionId
@ -235,7 +240,7 @@ toLeaderboardEntry challengeId tests ss = do
} }
where mainTestEnt@(Entity _ mainTest) = getMainTest tests where mainTestEnt@(Entity _ mainTest) = getMainTest tests
mainTestRef = getTestReference mainTestEnt mainTestRef = getTestReference mainTestEnt
submissionComparator (TableEntry _ _ _ em1 _ _ _) (TableEntry _ _ _ em2 _ _ _) = submissionComparator (TableEntry _ _ _ em1 _ _ _ _) (TableEntry _ _ _ em2 _ _ _ _) =
(compareResult mainTest) (evaluationScore (em1 Map.! mainTestRef)) (compareResult mainTest) (evaluationScore (em1 Map.! mainTestRef))
(evaluationScore (em2 Map.! mainTestRef)) (evaluationScore (em2 Map.! mainTestRef))
@ -313,4 +318,9 @@ getEvaluationMap (rank, (s@(Entity submissionId submission), v@(Entity variantId
parameters <- selectList [ParameterVariant ==. variantId] [Asc ParameterName] parameters <- selectList [ParameterVariant ==. variantId] [Asc ParameterName]
return $ TableEntry s v (Entity (submissionSubmitter submission) user) m tagEnts parameters rank (Entity _ version) <- getBy404 $ UniqueVersionByCommit $ submissionVersion submission
let major = versionMajor version
let minor = versionMinor version
let patch = versionPatch version
return $ TableEntry s v (Entity (submissionSubmitter submission) user) m tagEnts parameters rank (major, minor, patch)