s464900/gonito
1
0
Fork 0
forked from filipg/gonito
Code Issues Pull Requests Projects Releases Wiki Activity

Optimize querying for evaluations

Browse Source
This commit is contained in:
Filip Gralinski 2021-02-27 13:39:48 +01:00
parent f600882dea
commit abed530d1f
1 changed files with 23 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
Handler/Tables.hs
View File

@ -500,28 +500,39 @@ getBasicSubmissionInfo (Entity submissionId submission) = do
basicSubmissionInfoTagEnts = tagEnts, basicSubmissionInfoTagEnts = tagEnts,
basicSubmissionInfoVersion = version }) basicSubmissionInfoVersion = version })
getEvaluationMap :: (MonadIO m, PersistQueryRead backend, PersistUniqueRead backend, BaseBackend backend ~ SqlBackend) getEvaluationMap :: (PersistUniqueRead backend,
=> Map.Map TestId TestReference PersistQueryRead backend,
-> Map.Map SubmissionId BasicSubmissionInfo BackendCompatible SqlBackend backend,
-> (Int, (Entity Submission, Entity Variant)) -> ReaderT backend m TableEntry MonadIO m,
BaseBackend backend ~ SqlBackend)
=> Map (Key Test) TestReference
-> Map (Key Submission) BasicSubmissionInfo
-> (Int, (Entity Submission, Entity Variant))
-> ReaderT backend m TableEntry
getEvaluationMap testsMap submissionsMap (rank, (s@(Entity submissionId submission), v@(Entity variantId _))) = do getEvaluationMap testsMap submissionsMap (rank, (s@(Entity submissionId submission), v@(Entity variantId _))) = do
let submissionInfo = submissionsMap Map.! submissionId let submissionInfo = submissionsMap Map.! submissionId
let user = basicSubmissionInfoUser submissionInfo let user = basicSubmissionInfoUser submissionInfo
let tagEnts = basicSubmissionInfoTagEnts submissionInfo let tagEnts = basicSubmissionInfoTagEnts submissionInfo
let version = basicSubmissionInfoVersion submissionInfo let theVersion = basicSubmissionInfoVersion submissionInfo
outs <- selectList [OutVariant ==. variantId] [Asc OutId]
let versionHash = submissionVersion submission let versionHash = submissionVersion submission
maybeEvaluations <- mapM (\(Entity _ o) -> fetchTheEvaluation o versionHash) outs
let evaluations = catMaybes maybeEvaluations evaluations <- E.select $ E.from $ \(evaluation, out) ->
do
E.where_ (out ^. OutVariant E.==. E.val variantId
E.&&. evaluation ^. EvaluationTest E.==. out ^. OutTest
E.&&. evaluation ^. EvaluationChecksum E.==. out ^. OutChecksum
E.&&. evaluation ^. EvaluationVersion E.==. E.val versionHash)
E.orderBy [E.asc (out ^. OutId)]
return evaluation
let pairs = map (\(Entity _ e) -> (evaluationTest e, e)) evaluations let pairs = map (\(Entity _ e) -> (evaluationTest e, e)) evaluations
let pairs' = map (\(testId, e) -> (testsMap Map.! testId, e)) pairs let pairs' = map (\(testId, e) -> (testsMap Map.! testId, e)) pairs
let m = Map.fromList pairs' let m = Map.fromList pairs'
parameters <- selectList [ParameterVariant ==. variantId] [Asc ParameterName] parameters <- selectList [ParameterVariant ==. variantId] [Asc ParameterName]
let major = versionMajor version let major = versionMajor theVersion
let minor = versionMinor version let minor = versionMinor theVersion
let patch = versionPatch version let patch = versionPatch theVersion
return $ TableEntry s v (Entity (submissionSubmitter submission) user) m tagEnts parameters rank (major, minor, patch) return $ TableEntry s v (Entity (submissionSubmitter submission) user) m tagEnts parameters rank (major, minor, patch)