summaryrefslogtreecommitdiff
path: root/server/Worker.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--server/Worker.hs22
1 files changed, 11 insertions, 11 deletions
diff --git a/server/Worker.hs b/server/Worker.hs
index 8b3903c..a5fab58 100644
--- a/server/Worker.hs
+++ b/server/Worker.hs
@@ -22,12 +22,12 @@ import qualified Data.Text as T
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import Fmt ((+|), (|+))
+import LintConfig (stuffConfig)
import Server (Config, JobStatus (..),
Org (..),
RealtimeMsg (RelintPending, Reload),
- RemoteRef (reporef, repourl),
- ServerState, adjustedPath,
- getJobStatus,
+ RemoteRef (..), ServerState,
+ adjustedPath, getJobStatus,
newRealtimeChannel,
setJobStatus, tmpdir, toSha)
import System.Directory (doesDirectoryExist)
@@ -63,6 +63,7 @@ runJob config Job {..} done = do
handle whoops
$ finally (lint workdir) (cleanup workdir)
where
+ lintConfig = stuffConfig (orgLintconfig jobOrg) (reponame jobRef)
lint workdir = do
maybeRealtime <- getJobStatus done (orgSlug jobOrg) (toSha jobRef) >>= \case
Nothing -> pure Nothing
@@ -80,9 +81,9 @@ runJob config Job {..} done = do
-- TODO: these calls fail for dumb http, add some fallback!
(callgit gitdir
[ "fetch", "origin", toString ref, "--depth", "1" ])
- (callgit gitdir
- [ "clone", toString ref, "--bare"
- , "--depth", "1", "-b", toString ref])
+ (callProcess "git"
+ [ "clone", toString url, "--bare"
+ , "--depth", "1", "-b", toString ref, gitdir])
rev <- map T.strip -- git returns a newline here
$ readgit' gitdir ["rev-parse", toString ref]
@@ -90,10 +91,10 @@ runJob config Job {..} done = do
callgit gitdir [ "worktree", "add", "--force", workdir, toString ref ]
- res <- recursiveCheckDir (orgLintconfig jobOrg) workdir (orgEntrypoint jobOrg)
+ res <- recursiveCheckDir lintConfig workdir (orgEntrypoint jobOrg)
>>= evaluateNF
- writeAdjustedRepository (orgLintconfig jobOrg) workdir (toString outPath) res
+ writeAdjustedRepository lintConfig workdir (toString outPath) res
>>= runStdoutLoggingT . \case
ExitSuccess ->
logInfoN $ "linted map "+| (show jobRef :: Text) |+"."
@@ -126,7 +127,6 @@ runJob config Job {..} done = do
url = repourl jobRef
ref = reporef jobRef
- callgit = callgit'
gitdir = view tmpdir config </> toString hashedname
hashedname = T.map escapeSlash url
where escapeSlash = \case { '/' -> '-'; a -> a }
@@ -137,8 +137,8 @@ readgit' dir args = map toText $
print args
readProcess "git" ([ "-C", toString dir ] <> args) ""
-callgit' :: MonadIO m => FilePath -> [String] -> m ()
-callgit' dir args =
+callgit :: MonadIO m => FilePath -> [String] -> m ()
+callgit dir args =
liftIO $ do
print args
callProcess "git" ([ "-C", toString dir ] <> args)