diff options
Diffstat (limited to '')
-rw-r--r-- | server/Worker.hs | 28 |
1 files changed, 26 insertions, 2 deletions
diff --git a/server/Worker.hs b/server/Worker.hs index 6092c78..8b3903c 100644 --- a/server/Worker.hs +++ b/server/Worker.hs @@ -13,6 +13,7 @@ import Universum import CheckDir (recursiveCheckDir, shrinkDirResult) import Control.Concurrent.Async (async, link) +import Control.Concurrent.STM (writeTChan) import Control.Concurrent.STM.TQueue import Control.Exception (IOException, handle) import Control.Monad.Logger (logError, logErrorN, logInfoN, @@ -23,9 +24,12 @@ import qualified Data.UUID.V4 as UUID import Fmt ((+|), (|+)) import Server (Config, JobStatus (..), Org (..), + RealtimeMsg (RelintPending, Reload), RemoteRef (reporef, repourl), ServerState, adjustedPath, - setJobStatus, tmpdir) + getJobStatus, + newRealtimeChannel, + setJobStatus, tmpdir, toSha) import System.Directory (doesDirectoryExist) import System.Exit (ExitCode (ExitFailure, ExitSuccess)) import System.FilePath ((</>)) @@ -60,6 +64,18 @@ runJob config Job {..} done = do $ finally (lint workdir) (cleanup workdir) where lint workdir = do + maybeRealtime <- getJobStatus done (orgSlug jobOrg) (toSha jobRef) >>= \case + Nothing -> pure Nothing + Just (org, ref, jobstatus) -> case jobstatus of + Linted res rev (_, realtime) -> do + setJobStatus done org ref (Linted res rev (True, realtime)) + pure $ Just realtime + Pending realtime -> pure $ Just realtime + _ -> pure Nothing + + whenJust maybeRealtime $ \realtime -> + atomically $ writeTChan realtime RelintPending + ifM (doesDirectoryExist gitdir) -- TODO: these calls fail for dumb http, add some fallback! (callgit gitdir @@ -90,8 +106,16 @@ runJob config Job {..} done = do -- writeAdjustedRepository does not return other codes $(logError) "wtf, this is impossible" + realtime <- case maybeRealtime of + Just realtime -> do + atomically $ writeTChan realtime Reload + pure realtime + Nothing -> + newRealtimeChannel + setJobStatus done jobOrg jobRef $ - Linted (shrinkDirResult res) rev + Linted (shrinkDirResult res) rev (False, realtime) + cleanup workdir = do callgit gitdir [ "worktree", "remove", "-f", "-f", workdir ] |