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