From 12fd6a1c58f7687ef90beb82acb262e680f376f1 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Sat, 14 Dec 2019 11:17:12 +0100
Subject: [PATCH] Handle switching to the right commit

(Though not robust)
---
 Handler/Evaluate.hs | 10 +++++++++-
 Handler/Shared.hs   | 18 ++++++++++++++++++
 2 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/Handler/Evaluate.hs b/Handler/Evaluate.hs
index b482b72..c214879 100644
--- a/Handler/Evaluate.hs
+++ b/Handler/Evaluate.hs
@@ -6,6 +6,8 @@ import Handler.Common
 import Handler.Runner
 import Handler.Shared
 
+import qualified Data.Text as T
+
 canBeReevaluated :: (YesodAuthPersist (HandlerSite m), MonadHandler m, PersistUniqueRead backend, AuthEntity (HandlerSite m) ~ User, AuthId (HandlerSite m) ~ Key User, BaseBackend backend ~ SqlBackend) => Key Submission -> ReaderT backend m Bool
 canBeReevaluated submissionId = do
   maybeUser <- maybeAuth
@@ -45,6 +47,12 @@ doReevaluateSubmission submissionId chan = do
   status <- runDB $ canBeReevaluated submissionId
   if status
     then
-      msg chan "Will re-evaluate!"
+     do
+      mRepoDir <- getSubmissionRepoDir submissionId chan
+      case mRepoDir of
+        Just repoDir -> do
+          msg chan ("Will evaluate in " ++ (T.pack repoDir))
+        Nothing -> do
+          err chan "Something went wrong, won't evaluate"
     else
       msg chan "Won't re-evaluate!"
diff --git a/Handler/Shared.hs b/Handler/Shared.hs
index 75887a1..93b345d 100644
--- a/Handler/Shared.hs
+++ b/Handler/Shared.hs
@@ -165,6 +165,24 @@ updateRepo repoId chan = do
           Nothing -> return False
     _ -> return False
 
+-- | Get a directionary with a submission.
+-- It may reset a git repository which might be risky if a repository
+-- is shared among a number of submissions.
+getSubmissionRepoDir :: SubmissionId -> Channel -> Handler (Maybe FilePath)
+getSubmissionRepoDir submissionId chan = do
+  submission <- runDB $ get404 submissionId
+  repoDir <- getRepoDir $ submissionRepo submission
+  let sha1Code = submissionCommit submission
+  -- this is not right... it should be fixed in the future
+  -- 1. All kinds of mayhem may ensue in case of concurrency
+  -- 2. ... especially if the repository is shared among a number of submissions
+  -- 3. The commit might not be actually there (it might have been garbage collected).
+  (exitCode, _) <- runProgram (Just repoDir) gitPath ["reset", "--hard", T.unpack $ fromSHA1ToText sha1Code] chan
+  case exitCode of
+    ExitSuccess -> return (Just repoDir)
+    ExitFailure _ -> return Nothing
+
+
 getHeadCommit :: FilePath -> Channel -> Handler (Maybe SHA1)
 getHeadCommit repoDir chan = do
   (exitCode, out) <- runProgram (Just repoDir) gitPath ["rev-parse", "HEAD"] chan