Handle switching to the right commit
(Though not robust)
This commit is contained in:
parent
120c87e44a
commit
12fd6a1c58
@ -6,6 +6,8 @@ import Handler.Common
|
|||||||
import Handler.Runner
|
import Handler.Runner
|
||||||
import Handler.Shared
|
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 :: (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
|
canBeReevaluated submissionId = do
|
||||||
maybeUser <- maybeAuth
|
maybeUser <- maybeAuth
|
||||||
@ -45,6 +47,12 @@ doReevaluateSubmission submissionId chan = do
|
|||||||
status <- runDB $ canBeReevaluated submissionId
|
status <- runDB $ canBeReevaluated submissionId
|
||||||
if status
|
if status
|
||||||
then
|
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
|
else
|
||||||
msg chan "Won't re-evaluate!"
|
msg chan "Won't re-evaluate!"
|
||||||
|
@ -165,6 +165,24 @@ updateRepo repoId chan = do
|
|||||||
Nothing -> return False
|
Nothing -> return False
|
||||||
_ -> 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 :: FilePath -> Channel -> Handler (Maybe SHA1)
|
||||||
getHeadCommit repoDir chan = do
|
getHeadCommit repoDir chan = do
|
||||||
(exitCode, out) <- runProgram (Just repoDir) gitPath ["rev-parse", "HEAD"] chan
|
(exitCode, out) <- runProgram (Just repoDir) gitPath ["rev-parse", "HEAD"] chan
|
||||||
|
Loading…
Reference in New Issue
Block a user