diff --git a/Handler/Graph.hs b/Handler/Graph.hs index ebccab5..0771998 100644 --- a/Handler/Graph.hs +++ b/Handler/Graph.hs @@ -4,7 +4,7 @@ import Import import Handler.Tables import Handler.Dashboard (indicatorToEntry, prettyIndicatorEntry, formatTarget, IndicatorEntry(..), TargetStatus(..), filterEntries, getTargetStatus) -import Handler.Shared (formatParameter, formatScore, getMainTest, compareFun) +import Handler.Shared (formatParameter, formatScore, fetchMainTest, compareFun) import Data.Maybe import Data.List ((!!)) import Database.Persist.Sql @@ -88,8 +88,8 @@ submissionsToJSON condition challengeName = do (\entry -> [entityKey $ tableEntrySubmission entry]) - tests <- runDB $ selectList [TestChallenge ==. challengeId] [] - let mainTestRef = getTestReference $ getMainTest tests + entMainTest <- runDB $ fetchMainTest challengeId + let mainTestRef = getTestReference entMainTest let naturalRange = getNaturalRange mainTestRef entries let submissionIds = map leaderboardBestSubmissionId entries diff --git a/Handler/Query.hs b/Handler/Query.hs index 2ee4129..3dc8ab2 100644 --- a/Handler/Query.hs +++ b/Handler/Query.hs @@ -45,8 +45,7 @@ getApiTxtScoreR sha1Prefix = do 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] [] - let mainTest = getMainTest tests + mainTest <- runDB $ fetchMainTest challengeId let mainTestId = entityKey mainTest let submissionId = entityKey submission diff --git a/Handler/Shared.hs b/Handler/Shared.hs index 07c1060..6c8caa4 100644 --- a/Handler/Shared.hs +++ b/Handler/Shared.hs @@ -362,6 +362,16 @@ thenCmp :: Ordering -> Ordering -> Ordering thenCmp EQ o2 = o2 thenCmp o1 _ = o1 +fetchMainTest :: (MonadIO m, PersistQueryRead backend, BaseBackend backend ~ SqlBackend) => Key Challenge -> ReaderT backend m (Entity Test) +fetchMainTest challengeId = do + challenge <- get404 challengeId + + activeTests <- selectList [TestChallenge ==. challengeId, + TestActive ==. True, + TestCommit ==. challengeVersion challenge] [] + + return $ getMainTest activeTests + -- get the test with the highest priority getMainTest :: [Entity Test] -> Entity Test getMainTest tests = DL.maximumBy testComparator tests diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index 8c7f2a3..35b64d8 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -278,21 +278,29 @@ doCreateSubmission' _ userId challengeId mDescription mTags repoSpec chan = do relevantIndicators <- getOngoingTargets challengeId - activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] [] - let (Entity mainTestId mainTest) = getMainTest activeTests + (Entity mainTestId mainTest) <- runDB $ fetchMainTest challengeId + + (Entity _ currentVersion) <- runDB $ getBy404 $ UniqueVersionByCommit $ challengeVersion challenge + let submittedMajorVersion = versionMajor currentVersion let orderDirection = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of TheHigherTheBetter -> E.desc TheLowerTheBetter -> E.asc - bestResultSoFar <- runDB $ E.select $ E.from $ \(evaluation, submission, variant, out) -> do + bestResultSoFar <- runDB $ E.select $ E.from $ \(evaluation, submission, variant, out, test, version) -> do E.where_ (submission ^. SubmissionChallenge E.==. E.val challengeId E.&&. submission ^. SubmissionIsHidden E.==. E.val False E.&&. variant ^. VariantSubmission E.==. submission ^. SubmissionId E.&&. evaluation ^. EvaluationChecksum E.==. out ^. OutChecksum E.&&. (E.not_ (E.isNothing (evaluation ^. EvaluationScore))) E.&&. out ^. OutVariant E.==. variant ^. VariantId - E.&&. evaluation ^. EvaluationTest E.==. E.val mainTestId) + E.&&. evaluation ^. EvaluationTest E.==. test ^. TestId + E.&&. test ^. TestChallenge E.==. E.val challengeId + E.&&. test ^. TestName E.==. E.val (testName mainTest) + E.&&. test ^. TestMetric E.==. E.val (testMetric mainTest) + E.&&. test ^. TestActive + E.&&. version ^. VersionCommit E.==. test ^. TestCommit + E.&&. version ^. VersionMajor E.>=. E.val submittedMajorVersion) E.orderBy [orderDirection (evaluation ^. EvaluationScore)] E.limit 1 return evaluation