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

Force evaluation when re-evaluating

Browse Source
This commit is contained in:
Filip Gralinski 2020-09-05 15:07:23 +02:00
parent dce08f5ce6
commit 06d31dfb69
2 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
Handler/Evaluate.hs
View File

@ -99,7 +99,7 @@ doReevaluateSubmission submissionId chan = do
runDB $ update submissionId [SubmissionVersion =. currentChallengeVersion] runDB $ update submissionId [SubmissionVersion =. currentChallengeVersion]
catch (getOuts chan submissionId (gonitoMetadataGeneralParams gonitoMetadata) >> return ()) $ \(_::SomeException) -> do catch (getOuts True chan submissionId (gonitoMetadataGeneralParams gonitoMetadata) >> return ()) $ \(_::SomeException) -> do
err chan "SOMETHING WENT WRONG!!! REVERTING TO THE PREVIOUS VERSION" err chan "SOMETHING WENT WRONG!!! REVERTING TO THE PREVIOUS VERSION"
runDB $ update submissionId [SubmissionVersion =. previousVersion] runDB $ update submissionId [SubmissionVersion =. previousVersion]
@ -111,8 +111,8 @@ doReevaluateSubmission submissionId chan = do
msg chan "Won't re-evaluate!" msg chan "Won't re-evaluate!"
-- | Does the evaluation for a submission. Inserts Out, Variant and Evaluation records. -- | Does the evaluation for a submission. Inserts Out, Variant and Evaluation records.
getOuts :: Channel -> Key Submission -> M.Map Text Text -> Handler ([Out]) getOuts :: Bool -> Channel -> Key Submission -> M.Map Text Text -> Handler ([Out])
getOuts chan submissionId generalParams = do getOuts forceEvaluation chan submissionId generalParams = do
submission <- runDB $ get404 submissionId submission <- runDB $ get404 submissionId
let challengeId = submissionChallenge submission let challengeId = submissionChallenge submission
let version = submissionVersion submission let version = submissionVersion submission
@ -125,7 +125,7 @@ getOuts chan submissionId generalParams = do
let outs = concat outs' let outs = concat outs'
mapM_ checkOrInsertOut outs mapM_ checkOrInsertOut outs
mapM_ (checkOrInsertEvaluation repoDir chan version) outs mapM_ (checkOrInsertEvaluation repoDir forceEvaluation chan version) outs
return outs return outs
outFileName :: FilePath outFileName :: FilePath
@ -201,8 +201,8 @@ checkOrInsertOut out = do
Just _ -> return () Just _ -> return ()
Nothing -> (runDB $ insert out) >> return () Nothing -> (runDB $ insert out) >> return ()
checkOrInsertEvaluation :: FilePath -> Channel -> SHA1 -> Out -> Handler () checkOrInsertEvaluation :: FilePath -> Bool -> Channel -> SHA1 -> Out -> Handler ()
checkOrInsertEvaluation repoDir chan version out = do checkOrInsertEvaluation repoDir forceEvaluation chan version out = do
test <- runDB $ get404 $ outTest out test <- runDB $ get404 $ outTest out
challenge <- runDB $ get404 $ testChallenge test challenge <- runDB $ get404 $ testChallenge test
maybeEvaluation' <- runDB $ fetchTheEvaluation out version maybeEvaluation' <- runDB $ fetchTheEvaluation out version
@ -213,10 +213,13 @@ checkOrInsertEvaluation repoDir chan version out = do
Nothing -> Nothing Nothing -> Nothing
Nothing -> Nothing Nothing -> Nothing
case maybeEvaluation of if not forceEvaluation && isJust maybeEvaluation
Just (Entity _ evaluation) -> do then
do
let Just (Entity _ evaluation) = maybeEvaluation
msg chan $ concat ["Already evaluated with score ", (fromMaybe "???" $ formatNonScientifically <$> evaluationScore evaluation)] msg chan $ concat ["Already evaluated with score ", (fromMaybe "???" $ formatNonScientifically <$> evaluationScore evaluation)]
Nothing -> do else
do
msg chan $ "Start evaluation..." msg chan $ "Start evaluation..."
challengeDir <- getRepoDirOrClone (challengePrivateRepo challenge) chan challengeDir <- getRepoDirOrClone (challengePrivateRepo challenge) chan
variant <- runDB $ get404 $ outVariant out variant <- runDB $ get404 $ outVariant out
@ -230,6 +233,14 @@ checkOrInsertEvaluation repoDir chan version out = do
asPercentage = False } asPercentage = False }
msg chan $ concat [ "Evaluated! Score ", (T.pack $ formatTheResult defaultFormattingOpts result) ] msg chan $ concat [ "Evaluated! Score ", (T.pack $ formatTheResult defaultFormattingOpts result) ]
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
if forceEvaluation
then
runDB $ deleteWhere [
EvaluationTest ==. outTest out,
EvaluationChecksum ==. outChecksum out,
EvaluationVersion ==. Just version ]
else
return ()
_ <- runDB $ insert $ let (pointResult, errorBound) = extractResult result _ <- runDB $ insert $ let (pointResult, errorBound) = extractResult result
in Evaluation { in Evaluation {
evaluationTest=outTest out, evaluationTest=outTest out,

2
Handler/ShowChallenge.hs
View File

@ -453,7 +453,7 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
dependencySubRepoCommit = s, dependencySubRepoCommit = s,
dependencySuperRepoCommit = (repoCurrentCommit repo) }) $ gonitoMetadataDependencies gonitoMetadata dependencySuperRepoCommit = (repoCurrentCommit repo) }) $ gonitoMetadataDependencies gonitoMetadata
outs <- getOuts chan submissionId (gonitoMetadataGeneralParams gonitoMetadata) outs <- getOuts False chan submissionId (gonitoMetadataGeneralParams gonitoMetadata)
currentTagIds <- runDB $ selectList [SubmissionTagSubmission ==. submissionId] [] currentTagIds <- runDB $ selectList [SubmissionTagSubmission ==. submissionId] []