diff options
Diffstat (limited to '')
| -rw-r--r-- | server/Worker.hs | 41 |
1 files changed, 23 insertions, 18 deletions
diff --git a/server/Worker.hs b/server/Worker.hs index b3ce1da..7de9cd3 100644 --- a/server/Worker.hs +++ b/server/Worker.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} module Worker (linterThread, Job(..)) where @@ -23,10 +24,12 @@ import Server (Config, JobStatus (..), ServerState, adjustedPath, setJobStatus, tmpdir) import System.Directory (doesDirectoryExist) -import System.Exit (ExitCode (ExitFailure)) +import System.Exit (ExitCode (ExitFailure, ExitSuccess)) import System.FilePath ((</>)) import System.Process import WriteRepo (writeAdjustedRepository) +import Control.Monad.Logger (runStdoutLoggingT, logErrorN, logInfoN, logError) +import Fmt ((+|), (|+)) data Job = Job { jobRef :: RemoteRef @@ -65,34 +68,36 @@ runJob config Job {..} done = do , "--depth", "1", "-b", toString ref]) rev <- map T.strip -- git returns a newline here $ readgit' gitdir ["rev-parse", toString ref] + + let outPath = adjustedPath rev jobOrg + callgit gitdir [ "worktree", "add", "--force", workdir, toString ref ] res <- recursiveCheckDir (orgLintconfig jobOrg) workdir (orgEntrypoint jobOrg) >>= evaluateNF - writeAdjustedRepository (orgLintconfig jobOrg) workdir (toString $ adjustedPath rev jobOrg) res - >>= \case ExitFailure 1 -> - -- error's in the result anyways - pure () - ExitFailure 2 -> - -- TODO: use a fastlogger for this or sth - -- TODO: shouldn't have linted this map at all - putTextLn "ERROR: outpath already exists" - ExitFailure n -> do -- impossible - print n - pure () - _ -> pure () -- all good - - putTextLn "still here!" + writeAdjustedRepository (orgLintconfig jobOrg) workdir (toString outPath) res + >>= runStdoutLoggingT . \case + ExitSuccess -> + logInfoN $ "linted map "+| (show jobRef :: Text) |+"." + ExitFailure 1 -> + logInfoN $ "linted map "+| (show jobRef :: Text) |+ ", which failed." + ExitFailure 2 -> + -- TODO: shouldn't have linted this map at all + logErrorN $ "outpath "+|outPath|+" already exists!" + ExitFailure _ -> + -- writeAdjustedRepository does not return other codes + $(logError) "wtf, this is impossible" + setJobStatus done jobOrg jobRef $ Linted (shrinkDirResult res) rev cleanup workdir = do callgit gitdir [ "worktree", "remove", "-f", "-f", workdir ] - whoops (error :: IOException) = do - -- TODO: should also log this error - setJobStatus done jobOrg jobRef $ Failed (show error) + whoops (error :: IOException) = runStdoutLoggingT $ do + logErrorN (show error) + liftIO $ setJobStatus done jobOrg jobRef $ Failed (show error) url = repourl jobRef ref = reporef jobRef |