variants are used within within outs - transition completed
This commit is contained in:
parent
03bf552bac
commit
9b445d6e9c
|
|
@ -31,6 +31,7 @@ getApiTxtScoreR sha1Prefix = do
|
|||
[] -> return "NONE"
|
||||
_ -> return "AMBIGUOUS ARGUMENT"
|
||||
|
||||
doGetScore :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, PersistUniqueRead (YesodPersistBackend site), BackendCompatible SqlBackend (YesodPersistBackend site), YesodPersist site, PersistQueryRead (YesodPersistBackend site)) => Entity Submission -> HandlerFor site Text
|
||||
doGetScore submission = do
|
||||
let challengeId = submissionChallenge $ entityVal submission
|
||||
tests <- runDB $ selectList [TestChallenge ==. challengeId] []
|
||||
|
|
@ -39,8 +40,9 @@ doGetScore submission = do
|
|||
let submissionId = entityKey submission
|
||||
|
||||
evals <- runDB $ E.select
|
||||
$ E.from $ \(out, evaluation) -> do
|
||||
E.where_ (out ^. OutSubmission E.==. E.val submissionId
|
||||
$ E.from $ \(out, evaluation, variant) -> do
|
||||
E.where_ (variant ^. VariantSubmission E.==. E.val submissionId
|
||||
E.&&. out ^. OutVariant E.==. variant ^. VariantId
|
||||
E.&&. out ^. OutTest E.==. E.val mainTestId
|
||||
E.&&. evaluation ^. EvaluationTest E.==. E.val mainTestId
|
||||
E.&&. out ^. OutChecksum E.==. evaluation ^. EvaluationChecksum)
|
||||
|
|
|
|||
|
|
@ -305,7 +305,6 @@ outForTest repoDir submissionId variantId (Entity testId test) = do
|
|||
(Just outF) <- liftIO $ findOutFile repoDir test
|
||||
checksum <- liftIO $ gatherSHA1ForCollectionOfFiles [outF]
|
||||
return Out {
|
||||
outSubmission=submissionId,
|
||||
outVariant=variantId,
|
||||
outTest=testId,
|
||||
outChecksum=SHA1 checksum }
|
||||
|
|
@ -319,7 +318,7 @@ getVariant submissionId name = runDB $ do
|
|||
|
||||
checkOrInsertOut :: Out -> Handler ()
|
||||
checkOrInsertOut out = do
|
||||
maybeOut <- runDB $ getBy $ UniqueOutSubmissionTestChecksum (outSubmission out) (outTest out) (outChecksum out)
|
||||
maybeOut <- runDB $ getBy $ UniqueOutVariantTestChecksum (outVariant out) (outTest out) (outChecksum out)
|
||||
case maybeOut of
|
||||
Just _ -> return ()
|
||||
Nothing -> (runDB $ insert out) >> return ()
|
||||
|
|
|
|||
|
|
@ -31,20 +31,20 @@ data LeaderboardEntry = LeaderboardEntry {
|
|||
leaderboardTags :: [(Entity Tag, Entity SubmissionTag)]
|
||||
}
|
||||
|
||||
submissionsTable :: Maybe UserId -> Text -> RepoScheme -> Repo -> [Entity Test] -> Table App (Entity Submission, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])
|
||||
submissionsTable :: Maybe UserId -> Text -> RepoScheme -> Repo -> [Entity Test] -> Table App (Entity Submission, Entity Variant, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])
|
||||
submissionsTable mauthId challengeName repoScheme challengeRepo tests = mempty
|
||||
++ Table.text "submitter" (formatSubmitter . (\(_, Entity _ submitter, _, _) -> submitter))
|
||||
++ timestampCell "when" (submissionStamp . (\(Entity _ s, _, _, _) -> s))
|
||||
++ Table.text "submitter" (formatSubmitter . (\(_, _, Entity _ submitter, _, _) -> submitter))
|
||||
++ timestampCell "when" (submissionStamp . (\(Entity _ s, _, _, _, _) -> s))
|
||||
++ descriptionCell
|
||||
++ mconcat (map (\(Entity k t) -> resultCell t (extractScore k)) tests)
|
||||
++ statusCell challengeName repoScheme challengeRepo (\(Entity submissionId submission, Entity userId _, _, _) -> (submissionId, submission, userId, mauthId))
|
||||
++ statusCell challengeName repoScheme challengeRepo (\(Entity submissionId submission, _, Entity userId _, _, _) -> (submissionId, submission, userId, mauthId))
|
||||
|
||||
descriptionCell :: Foldable t => Table site (Entity Submission, b, c, t (Entity Tag, Entity SubmissionTag))
|
||||
descriptionCell :: Foldable t => Table site (Entity Submission, v, b, c, t (Entity Tag, Entity SubmissionTag))
|
||||
descriptionCell = Table.widget "description" (
|
||||
\(Entity _ s, _, _ ,tagEnts) -> fragmentWithSubmissionTags (submissionDescription s) tagEnts)
|
||||
\(Entity _ s, _, _, _ ,tagEnts) -> fragmentWithSubmissionTags (submissionDescription s) tagEnts)
|
||||
|
||||
extractScore :: Key Test -> (Entity Submission, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)]) -> Maybe Evaluation
|
||||
extractScore k (_, _, m, _) = lookup k m
|
||||
extractScore :: Key Test -> (Entity Submission, Entity Variant, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)]) -> Maybe Evaluation
|
||||
extractScore k (_, _, _, m, _) = lookup k m
|
||||
|
||||
leaderboardTable :: Maybe UserId -> Text -> RepoScheme -> Repo -> Test -> Table App (Int, LeaderboardEntry)
|
||||
leaderboardTable mauthId challengeName repoScheme challengeRepo test = mempty
|
||||
|
|
@ -99,9 +99,9 @@ getAuxSubmissions testId evaluationMaps = map processEvaluationMap evaluationMap
|
|||
Nothing -> []))
|
||||
|
||||
|
||||
getAuxSubmissionEnts :: Key Test -> [(Entity Submission, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])] -> [(Key User, (User, [((Entity Submission), Evaluation)]))]
|
||||
getAuxSubmissionEnts :: Key Test -> [(Entity Submission, Entity Variant, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])] -> [(Key User, (User, [((Entity Submission), Evaluation)]))]
|
||||
getAuxSubmissionEnts testId evaluationMaps = map processEvaluationMap evaluationMaps
|
||||
where processEvaluationMap (s, (Entity ui u), m, _) = (ui, (u, case Map.lookup testId m of
|
||||
where processEvaluationMap (s, v, (Entity ui u), m, _) = (ui, (u, case Map.lookup testId m of
|
||||
Just e -> [(s, e)]
|
||||
Nothing -> []))
|
||||
|
||||
|
|
@ -150,20 +150,25 @@ 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 SubmissionTag)])], [Entity Test])
|
||||
getChallengeSubmissionInfos :: ((Entity Submission) -> Bool) -> Key Challenge -> Handler ([(Entity Submission,Entity Variant, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])], [Entity Test])
|
||||
getChallengeSubmissionInfos condition challengeId = do
|
||||
allSubmissions <- runDB $ selectList [SubmissionChallenge ==. challengeId, SubmissionIsHidden !=. Just True] [Desc SubmissionStamp]
|
||||
let submissions = filter condition allSubmissions
|
||||
tests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] []
|
||||
evaluationMaps <- mapM getEvaluationMap submissions
|
||||
return (evaluationMaps, tests)
|
||||
evaluationMaps <- mapM getEvaluationMapForSubmission submissions
|
||||
return (concat evaluationMaps, tests)
|
||||
|
||||
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] []
|
||||
getEvaluationMapForSubmission :: Entity Submission -> Handler [(Entity Submission, Entity Variant, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])]
|
||||
getEvaluationMapForSubmission s@(Entity submissionId submission)= do
|
||||
variants <- runDB $ selectList [VariantSubmission ==. submissionId] []
|
||||
mapM (getEvaluationMap s) variants
|
||||
|
||||
getEvaluationMap :: Entity Submission -> Entity Variant -> Handler (Entity Submission, Entity Variant, Entity User, Map (Key Test) Evaluation, [(Entity Tag, Entity SubmissionTag)])
|
||||
getEvaluationMap s@(Entity submissionId submission) v@(Entity variantId variant) = do
|
||||
outs <- runDB $ selectList [OutVariant ==. variantId] []
|
||||
user <- runDB $ get404 $ submissionSubmitter submission
|
||||
maybeEvaluations <- runDB $ mapM (\(Entity _ o) -> getBy $ UniqueEvaluationTestChecksum (outTest o) (outChecksum o)) outs
|
||||
let evaluations = catMaybes maybeEvaluations
|
||||
let m = Map.fromList $ map (\(Entity _ e) -> (evaluationTest e, e)) evaluations
|
||||
tagEnts <- runDB $ getTags submissionId
|
||||
return (s, Entity (submissionSubmitter submission) user, m, tagEnts)
|
||||
return (s, v, Entity (submissionSubmitter submission) user, m, tagEnts)
|
||||
|
|
|
|||
|
|
@ -85,11 +85,9 @@ Comment
|
|||
posted UTCTime default=now()
|
||||
text Textarea
|
||||
Out
|
||||
submission SubmissionId
|
||||
variant VariantId
|
||||
test TestId
|
||||
checksum SHA1
|
||||
UniqueOutSubmissionTestChecksum submission test checksum
|
||||
UniqueOutVariantTestChecksum variant test checksum
|
||||
Tag
|
||||
name Text
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
ALTER TABLE "out" DROP COLUMN "submission";
|
||||
Loading…
Reference in New Issue