summaryrefslogtreecommitdiff
path: root/server/Worker.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/Worker.hs')
-rw-r--r--server/Worker.hs12
1 files changed, 8 insertions, 4 deletions
diff --git a/server/Worker.hs b/server/Worker.hs
index 1672026..40a267b 100644
--- a/server/Worker.hs
+++ b/server/Worker.hs
@@ -13,7 +13,8 @@ import CheckDir (recursiveCheckDir)
import Cli.Extras (CliConfig, ProcessFailure,
Severity (..),
callProcessAndLogOutput,
- prettyProcessFailure, runCli)
+ prettyProcessFailure,
+ readProcessAndLogStderr, runCli)
import Control.Concurrent.Async (async, link)
import Control.Concurrent.STM.TQueue
import qualified Data.Text as T
@@ -54,16 +55,19 @@ runJob config Job {..} cliconfig done = runCli cliconfig $ do
(callgit gitdir
[ "clone", toString ref, "--bare"
, "--depth", "1", "-b", toString ref])
+ rev <- map T.strip -- git returns a newline here
+ $ readProcessAndLogStderr Error
+ $ gitProc gitdir ["rev-parse", toString ref]
rand <- liftIO UUID.nextRandom
let workdir = "/tmp" </> ("worktree-" <> UUID.toString rand)
callgit gitdir [ "worktree", "add", workdir ]
callgit workdir [ "checkout", toString ref ]
res <- liftIO $ recursiveCheckDir (orgLintconfig jobOrg) workdir (orgEntrypoint jobOrg)
callgit gitdir [ "worktree", "remove", "-f", "-f", workdir ]
- pure res
+ pure (res, rev)
liftIO $ setJobStatus done jobOrg jobRef $ case res of
- Right res -> Linted res
- Left err -> Failed (prettyProcessFailure err)
+ Right thing -> uncurry Linted thing
+ Left err -> Failed (prettyProcessFailure err)
where
url = repourl jobRef
ref = reporef jobRef