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

Fix queries for updated challenges

Browse Source
This commit is contained in:
Filip Gralinski 2021-11-13 12:16:07 +01:00
parent 35b274b216
commit 48018b9377
1 changed files with 20 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
Handler/Query.hs
View File

@ -209,19 +209,27 @@ doGetScore mMetricName submission = do
let submissionId = entityKey submission let submissionId = entityKey submission
evals <- runDB $ E.select evals <- runDB $ E.select
$ E.from $ \(out, evaluation, variant) -> do $ E.from $ \(out, evaluation, variant, ver) -> do
E.where_ (variant ^. VariantSubmission E.==. E.val submissionId E.where_ (variant ^. VariantSubmission E.==. E.val submissionId
E.&&. out ^. OutVariant E.==. variant ^. VariantId E.&&. out ^. OutVariant E.==. variant ^. VariantId
E.&&. out ^. OutTest E.==. E.val theTestId E.&&. out ^. OutTest E.==. E.val theTestId
E.&&. evaluation ^. EvaluationTest E.==. E.val theTestId E.&&. evaluation ^. EvaluationTest E.==. E.val theTestId
E.&&. out ^. OutChecksum E.==. evaluation ^. EvaluationChecksum) E.&&. out ^. OutChecksum E.==. evaluation ^. EvaluationChecksum
E.orderBy [] E.&&. evaluation ^. EvaluationVersion E.==. ver ^. VersionCommit)
return (evaluation) E.orderBy [E.desc (ver ^. VersionStamp)]
return (evaluation, ver)
case evals of case onlyWithHeadVersions evals of
[eval] -> return $ formatTruncatedScore (getTestFormattingOpts $ entityVal testEnt) (Just $ entityVal eval) [eval] -> return $ formatTruncatedScore (getTestFormattingOpts $ entityVal testEnt) (Just $ entityVal eval)
_ -> return "NONE" _ -> return "NONE"
Nothing -> return "NONE" Nothing -> return "NONE"
where onlyWithHeadVersions [] = []
onlyWithHeadVersions ((he,hv):t) = he:(onlyWithHeadVersions' hv t)
onlyWithHeadVersions' _ [] = []
onlyWithHeadVersions' v ((he,hv):t)
| entityKey hv == entityKey v = (he:(onlyWithHeadVersions' v t))
| otherwise = []
doGetScoreForOut :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, PersistUniqueRead (YesodPersistBackend site), BackendCompatible SqlBackend (YesodPersistBackend site), YesodPersist site, PersistQueryRead (YesodPersistBackend site)) => Maybe Text -> Entity Submission -> SHA1 -> HandlerFor site Text doGetScoreForOut :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, PersistUniqueRead (YesodPersistBackend site), BackendCompatible SqlBackend (YesodPersistBackend site), YesodPersist site, PersistQueryRead (YesodPersistBackend site)) => Maybe Text -> Entity Submission -> SHA1 -> HandlerFor site Text
doGetScoreForOut mMetricName submission sha1code = do doGetScoreForOut mMetricName submission sha1code = do
@ -399,11 +407,13 @@ data ViewVariantData = ViewVariantData {
realSubmissionVersion :: Entity Submission -> Handler SHA1 realSubmissionVersion :: Entity Submission -> Handler SHA1
realSubmissionVersion (Entity submissionId _) = do realSubmissionVersion (Entity submissionId _) = do
testOutputs <- runDB $ E.select testOutputs <- runDB $ E.select
$ E.from $ \(variant, out, test) -> do $ E.from $ \(variant, out, test, evaluation, ver) -> do
E.where_ (variant ^. VariantSubmission E.==. E.val submissionId E.where_ (variant ^. VariantSubmission E.==. E.val submissionId
E.&&. out ^. OutVariant E.==. variant ^. VariantId E.&&. out ^. OutVariant E.==. variant ^. VariantId
E.&&. out ^. OutTest E.==. test ^. TestId) E.&&. out ^. OutTest E.==. test ^. TestId
E.orderBy [] E.&&. out ^. OutChecksum E.==. evaluation ^. EvaluationChecksum
E.&&. evaluation ^. EvaluationVersion E.==. ver ^. VersionCommit)
E.orderBy [E.desc (ver ^. VersionStamp)]
return test return test
let (t:_) = testOutputs let (t:_) = testOutputs
return $ testCommit $ entityVal t return $ testCommit $ entityVal t
@ -447,7 +457,6 @@ fetchViewVariantData variantId = do
else else
error "Cannot access this submission variant" error "Cannot access this submission variant"
instance Diffable SHA1 where instance Diffable SHA1 where
type DiffSettings SHA1 = () type DiffSettings SHA1 = ()
type DiffResult SHA1 = Diff SHA1 type DiffResult SHA1 = Diff SHA1
@ -628,11 +637,11 @@ viewOutputWithNonDefaultTestSelected entry tests mainTest (outputHash, testSet)
let mainMetric = testMetric $ entityVal mainTest let mainMetric = testMetric $ entityVal mainTest
let testLabels = map (formatTestEvaluationScheme . entityVal) tests' let testLabels = map (formatTestEvaluationScheme . entityVal) tests'
let mapping = LM.fromList $ map (\test -> (formatTestEvaluationScheme $ entityVal test, let theMapping = LM.fromList $ map (\test -> (formatTestEvaluationScheme $ entityVal test,
(test, (test,
(formatTruncatedScore (getTestFormattingOpts $ entityVal test) (formatTruncatedScore (getTestFormattingOpts $ entityVal test)
<$> extractScore (getTestReference test) <$> entry)))) tests' <$> extractScore (getTestReference test) <$> entry)))) tests'
let crossTables = splitIntoTablesWithValues "Metric" "Score" mapping testLabels let crossTables = splitIntoTablesWithValues "Metric" "Score" theMapping testLabels
mResult <- mResult <-
if shouldBeShown if shouldBeShown