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

Fix issue with unwanted messages

This commit is contained in:
Filip Graliński 2019-09-10 08:59:30 +02:00
parent 284d7e1acf
commit 0f4150a4a5
4 changed files with 26 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Handler/Graph.hs
View File

@ -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

3
Handler/Query.hs
View File

@ -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

10
Handler/Shared.hs
View File

@ -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

16
Handler/ShowChallenge.hs
View File

@ -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