From 1ea5e4ecbdaf509e34040f341dfde87cc7dfd99a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Filip=20Grali=C5=84ski?= <filipg@amu.edu.pl>
Date: Fri, 8 Jun 2018 15:00:40 +0200
Subject: [PATCH] handle multiple metrics for the same test

---
 Handler/CreateChallenge.hs |  9 +++++----
 Handler/Shared.hs          |  8 +++++++-
 Handler/ShowChallenge.hs   | 21 ++++++++++++---------
 config/models              |  3 ++-
 4 files changed, 26 insertions(+), 15 deletions(-)

diff --git a/Handler/CreateChallenge.hs b/Handler/CreateChallenge.hs
index 9608e0e..d1d5eb7 100644
--- a/Handler/CreateChallenge.hs
+++ b/Handler/CreateChallenge.hs
@@ -144,18 +144,19 @@ checkTestDir chan challengeId challenge commit testDir = do
         "--expected-directory", challengeRepoDir,
         "--test-name", takeFileName testDir]
       case optionsParsingResult of
-       Left evalException -> do
+       Left _ -> do
          err chan "Cannot read metric"
          return ()
        Right opts -> do
-         _ <- runDB $ insert $ Test {
+         _ <- runDB $ mapM (\(priority, metric) -> insert $ Test {
            testChallenge=challengeId,
-           testMetric=gesMetric $ geoSpec opts,
+           testMetric=metric,
            testName=T.pack $ takeFileName testDir,
            testChecksum=(SHA1 checksum),
            testCommit=commit,
            testActive=True,
-           testPrecision=gesPrecision $ geoSpec opts}
+           testPrecision=gesPrecision $ geoSpec opts,
+           testPriority=Just priority}) $ zip [1..] (gesMetrics $ geoSpec opts)
          return ()
     else
       msg chan $ concat ["Test dir ", (T.pack testDir), " does not have expected results."]
diff --git a/Handler/Shared.hs b/Handler/Shared.hs
index 338e5cd..6a84fdb 100644
--- a/Handler/Shared.hs
+++ b/Handler/Shared.hs
@@ -312,8 +312,14 @@ enableTriggerToken userId Nothing = do
   token <- newToken
   runDB $ update userId [UserTriggerToken =. Just token]
 
+thenCmp :: Ordering -> Ordering -> Ordering
+thenCmp EQ o2 = o2
+thenCmp o1 _  = o1
+
 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 (Just evaluation) = fromMaybe "???" (T.pack <$> show <$> evaluationScore evaluation)
diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index 73229f1..5d2c34e 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -314,30 +314,33 @@ checkOrInsertEvaluation repoDir chan out = do
     Nothing -> do
       msg chan $ "Start evaluation..."
       challengeDir <- getRepoDir $ challengePrivateRepo challenge
-      resultOrException <- liftIO $ rawEval challengeDir repoDir (testName test)
+      resultOrException <- liftIO $ rawEval challengeDir (testMetric test) repoDir (testName test)
       case resultOrException of
-        Right (Left parseResult) -> do
+        Right (Left _) -> do
           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) ]
           time <- liftIO getCurrentTime
-          runDB $ insert $ Evaluation {
+          _ <- runDB $ insert $ Evaluation {
             evaluationTest=outTest out,
             evaluationChecksum=outChecksum out,
             evaluationScore=Just result,
             evaluationErrorMessage=Nothing,
             evaluationStamp=time }
           msg chan "Evaluation done"
+        Right (Right (_, Just _)) -> do
+          err chan "Unexpected multiple results (???)"
         Right (Right (_, Nothing)) -> do
           err chan "Error during the evaluation"
         Left exception -> do
           err chan $ "Evaluation failed: " ++ (T.pack $ show exception)
 
-rawEval :: FilePath -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue)))
-rawEval challengeDir repoDir name = Import.try (runGEvalGetOptions [
-                                    "--expected-directory", challengeDir,
-                                    "--out-directory", repoDir,
-                                    "--test-name", (T.unpack name)])
+rawEval :: FilePath -> Metric -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe [MetricValue])))
+rawEval challengeDir metric repoDir name = Import.try (runGEvalGetOptions [
+                                                          "--metric", (show metric),
+                                                          "--expected-directory", challengeDir,
+                                                          "--out-directory", repoDir,
+                                                          "--test-name", (T.unpack name)])
 
 getSubmissionRepo :: Key Challenge -> RepoSpec -> Channel -> Handler (Maybe (Key Repo))
 getSubmissionRepo challengeId repoSpec chan = do
diff --git a/config/models b/config/models
index b7b267a..c054535 100644
--- a/config/models
+++ b/config/models
@@ -47,7 +47,8 @@ Test
     commit SHA1
     active Bool default=True
     precision Int Maybe
-    UniqueChallengeNameChecksum challenge name checksum
+    priority Int Maybe
+    UniqueChallengeNameMetricChecksum challenge name metric checksum
 Submission
     repo RepoId
     commit SHA1