summaryrefslogtreecommitdiff
path: root/server/Worker.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--server/Worker.hs28
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 ]