From bd8fc83c05e2663450592635e2ac6c0f29280447 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Wed, 11 Nov 2015 10:24:03 +0100
Subject: [PATCH] fix updating repos, evaluation non-default test sets

---
 Handler/CreateChallenge.hs |  5 +++--
 Handler/Shared.hs          | 33 +++++++++++++++++----------------
 Handler/ShowChallenge.hs   |  9 +++++----
 3 files changed, 25 insertions(+), 22 deletions(-)

diff --git a/Handler/CreateChallenge.hs b/Handler/CreateChallenge.hs
index 2612e17..66b495a 100644
--- a/Handler/CreateChallenge.hs
+++ b/Handler/CreateChallenge.hs
@@ -43,10 +43,11 @@ postCreateChallengeR = do
 
 doCreateChallenge :: Text -> Text -> Text -> Text -> Text -> Channel -> Handler ()
 doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do
-  maybePublicRepoId <- cloneRepo publicUrl publicBranch chan
+  maybePublicRepoId <- cloneRepo publicUrl publicBranch publicUrl publicBranch chan
   case maybePublicRepoId of
     Just publicRepoId -> do
-      maybePrivateRepoId <- cloneRepo privateUrl privateBranch chan
+      publicRepo <- runDB $ get404 publicRepoId
+      maybePrivateRepoId <- cloneRepo privateUrl privateBranch (T.pack $ getRepoDir publicRepoId) (repoBranch publicRepo) chan
       case maybePrivateRepoId of
           Just privateRepoId -> addChallenge name publicRepoId privateRepoId chan
           Nothing -> return ()
diff --git a/Handler/Shared.hs b/Handler/Shared.hs
index 7d41dfe..6210717 100644
--- a/Handler/Shared.hs
+++ b/Handler/Shared.hs
@@ -65,40 +65,41 @@ err = msg
 raw :: Channel -> Text -> Handler ()
 raw = msg
 
-doRepoCloning :: Text -> Text -> Channel -> Handler ()
-doRepoCloning url branch chan = do
-  msg chan "Did something"
-  _ <- cloneRepo url branch chan
-  return ()
-
 validGitProtocols :: [String]
 validGitProtocols = ["git", "http", "https", "ssh"]
 
 validGitProtocolsAsText :: Text
 validGitProtocolsAsText = T.pack $ intercalate ", " $ map (++"://") validGitProtocols
 
-cloneRepo :: Text -> Text -> Channel -> Handler (Maybe (Key Repo))
-cloneRepo url branch chan = do
+cloneRepo :: Text -> Text -> Text -> Text -> Channel -> Handler (Maybe (Key Repo))
+cloneRepo url branch referenceUrl referenceBranch chan = do
   maybeRepo <- runDB $ getBy $ UniqueUrlBranch url branch
   case maybeRepo of
     Just _ -> do
       err chan "Repo already there"
       return Nothing
-    Nothing -> cloneRepo' url branch url branch chan
+    Nothing -> cloneRepo' url branch referenceUrl referenceBranch chan
 
 updateRepo :: Key Repo -> Channel -> Handler Bool
 updateRepo repoId chan = do
   repo <- runDB $ get404 repoId
   let repoDir = getRepoDir repoId
-  (exitCode, _) <- runProgram (Just repoDir) gitPath ["pull", "--progress"] chan
+  (exitCode, _) <- runProgram (Just repoDir) gitPath ["fetch", "--progress"] chan
   case exitCode of
     ExitSuccess -> do
-      maybeHeadCommit <- getHeadCommit repoDir chan
-      case maybeHeadCommit of
-        Just headCommit -> do
-          runDB $ update repoId [RepoCurrentCommit =. headCommit]
-          return True
-        Nothing -> return False
+      (exitCode, _) <- runProgram (Just repoDir) gitPath ["reset",
+                                                         "--hard",
+                                                         "FETCH_HEAD"] chan
+      case exitCode of
+       ExitSuccess -> do
+         maybeHeadCommit <- getHeadCommit repoDir chan
+         case maybeHeadCommit of
+          Just headCommit -> do
+            runDB $ update repoId [RepoCurrentCommit =. headCommit]
+            return True
+          Nothing -> return False
+       _ -> return False
+    _ -> return False
 
 getHeadCommit :: FilePath -> Channel -> Handler (Maybe SHA1)
 getHeadCommit repoDir chan = do
diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index 556b611..b78f613 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -134,7 +134,7 @@ checkOrInsertEvaluation repoDir chan out = do
       msg chan $ concat ["Already evaluated with score ", (T.pack $ fromMaybe "???" $ show <$> evaluationScore evaluation)]
     Nothing -> do
       msg chan $ "Start evaluation..."
-      resultOrException <- liftIO $ rawEval challenge repoDir
+      resultOrException <- liftIO $ rawEval challenge repoDir (testName test)
       case resultOrException of
         Right (Left parseResult) -> do
           err chan "Cannot parse options, check the challenge repo"
@@ -153,10 +153,11 @@ checkOrInsertEvaluation repoDir chan out = do
         Left exception -> do
           err chan $ "Evaluation failed: " ++ (T.pack $ show exception)
 
-rawEval :: Challenge -> FilePath -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue)))
-rawEval challenge repoDir = try (runGEvalGetOptions [
+rawEval :: Challenge -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue)))
+rawEval challenge repoDir name = try (runGEvalGetOptions [
                                     "--expected-directory", (getRepoDir $ challengePrivateRepo challenge),
-                                    "--out-directory", repoDir])
+                                    "--out-directory", repoDir,
+                                    "--test-name", (T.unpack name)])
 
 getSubmissionRepo :: Key Challenge -> Text -> Text -> Channel -> Handler (Maybe (Key Repo))
 getSubmissionRepo challengeId url branch chan = do