diff options
Diffstat (limited to 'server/Worker.hs')
| -rw-r--r-- | server/Worker.hs | 22 |
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) |