handle multiple metrics for the same test

This commit is contained in:
Filip Graliński 2018-06-08 15:00:40 +02:00
parent fe170e9a05
commit 1ea5e4ecbd
4 changed files with 26 additions and 15 deletions

View File

@ -144,18 +144,19 @@ checkTestDir chan challengeId challenge commit testDir = do
"--expected-directory", challengeRepoDir, "--expected-directory", challengeRepoDir,
"--test-name", takeFileName testDir] "--test-name", takeFileName testDir]
case optionsParsingResult of case optionsParsingResult of
Left evalException -> do Left _ -> do
err chan "Cannot read metric" err chan "Cannot read metric"
return () return ()
Right opts -> do Right opts -> do
_ <- runDB $ insert $ Test { _ <- runDB $ mapM (\(priority, metric) -> insert $ Test {
testChallenge=challengeId, testChallenge=challengeId,
testMetric=gesMetric $ geoSpec opts, testMetric=metric,
testName=T.pack $ takeFileName testDir, testName=T.pack $ takeFileName testDir,
testChecksum=(SHA1 checksum), testChecksum=(SHA1 checksum),
testCommit=commit, testCommit=commit,
testActive=True, testActive=True,
testPrecision=gesPrecision $ geoSpec opts} testPrecision=gesPrecision $ geoSpec opts,
testPriority=Just priority}) $ zip [1..] (gesMetrics $ geoSpec opts)
return () return ()
else else
msg chan $ concat ["Test dir ", (T.pack testDir), " does not have expected results."] msg chan $ concat ["Test dir ", (T.pack testDir), " does not have expected results."]

View File

@ -312,8 +312,14 @@ enableTriggerToken userId Nothing = do
token <- newToken token <- newToken
runDB $ update userId [UserTriggerToken =. Just token] runDB $ update userId [UserTriggerToken =. Just token]
thenCmp :: Ordering -> Ordering -> Ordering
thenCmp EQ o2 = o2
thenCmp o1 _ = o1
getMainTest :: [Entity Test] -> Entity Test getMainTest :: [Entity Test] -> Entity Test
getMainTest tests = DL.maximumBy (\(Entity _ a) (Entity _ b) -> ((testName a) `compare` (testName b))) tests getMainTest tests = DL.maximumBy (\(Entity _ a) (Entity _ b) -> ( ((testName a) `compare` (testName b))
`thenCmp`
((fromMaybe 9999 $ testPriority b) `compare` (fromMaybe 9999 $ testPriority a)) ) ) tests
formatFullScore :: Maybe Evaluation -> Text formatFullScore :: Maybe Evaluation -> Text
formatFullScore (Just evaluation) = fromMaybe "???" (T.pack <$> show <$> evaluationScore evaluation) formatFullScore (Just evaluation) = fromMaybe "???" (T.pack <$> show <$> evaluationScore evaluation)

View File

@ -314,27 +314,30 @@ checkOrInsertEvaluation repoDir chan out = do
Nothing -> do Nothing -> do
msg chan $ "Start evaluation..." msg chan $ "Start evaluation..."
challengeDir <- getRepoDir $ challengePrivateRepo challenge challengeDir <- getRepoDir $ challengePrivateRepo challenge
resultOrException <- liftIO $ rawEval challengeDir repoDir (testName test) resultOrException <- liftIO $ rawEval challengeDir (testMetric test) repoDir (testName test)
case resultOrException of case resultOrException of
Right (Left parseResult) -> do Right (Left _) -> do
err chan "Cannot parse options, check the challenge repo" err chan "Cannot parse options, check the challenge repo"
Right (Right (opts, Just result)) -> do Right (Right (_, Just [result])) -> do
msg chan $ concat [ "Evaluated! Score ", (T.pack $ show result) ] msg chan $ concat [ "Evaluated! Score ", (T.pack $ show result) ]
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
runDB $ insert $ Evaluation { _ <- runDB $ insert $ Evaluation {
evaluationTest=outTest out, evaluationTest=outTest out,
evaluationChecksum=outChecksum out, evaluationChecksum=outChecksum out,
evaluationScore=Just result, evaluationScore=Just result,
evaluationErrorMessage=Nothing, evaluationErrorMessage=Nothing,
evaluationStamp=time } evaluationStamp=time }
msg chan "Evaluation done" msg chan "Evaluation done"
Right (Right (_, Just _)) -> do
err chan "Unexpected multiple results (???)"
Right (Right (_, Nothing)) -> do Right (Right (_, Nothing)) -> do
err chan "Error during the evaluation" err chan "Error during the evaluation"
Left exception -> do Left exception -> do
err chan $ "Evaluation failed: " ++ (T.pack $ show exception) err chan $ "Evaluation failed: " ++ (T.pack $ show exception)
rawEval :: FilePath -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue))) rawEval :: FilePath -> Metric -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe [MetricValue])))
rawEval challengeDir repoDir name = Import.try (runGEvalGetOptions [ rawEval challengeDir metric repoDir name = Import.try (runGEvalGetOptions [
"--metric", (show metric),
"--expected-directory", challengeDir, "--expected-directory", challengeDir,
"--out-directory", repoDir, "--out-directory", repoDir,
"--test-name", (T.unpack name)]) "--test-name", (T.unpack name)])

View File

@ -47,7 +47,8 @@ Test
commit SHA1 commit SHA1
active Bool default=True active Bool default=True
precision Int Maybe precision Int Maybe
UniqueChallengeNameChecksum challenge name checksum priority Int Maybe
UniqueChallengeNameMetricChecksum challenge name metric checksum
Submission Submission
repo RepoId repo RepoId
commit SHA1 commit SHA1