diff options
| -rw-r--r-- | src/Command/Shell.hs | 2 | ||||
| -rw-r--r-- | src/Job.hs | 9 |
2 files changed, 6 insertions, 5 deletions
diff --git a/src/Command/Shell.hs b/src/Command/Shell.hs index 4cd2b7e..6e0d880 100644 --- a/src/Command/Shell.hs +++ b/src/Command/Shell.hs @@ -41,6 +41,6 @@ cmdShell (ShellCommand ref) = do liftIO (runEval (evalJobReference ref) einput) sh <- fromMaybe "/bin/sh" <$> liftIO (lookupEnv "SHELL") storageDir <- getStorageDir - prepareJob storageDir job $ \checkoutPath _ -> do + prepareJob storageDir job $ \checkoutPath -> do liftIO $ withCreateProcess (proc sh []) { cwd = Just checkoutPath } $ \_ _ _ ph -> do void $ waitForProcess ph @@ -248,7 +248,8 @@ runJobs mngr@JobManager {..} tout jobs = do case duplicate of Nothing -> do - readStatusFile tout job (jmDataDir </> jobStorageSubdir (jobId job)) >>= \case + let jdir = jmDataDir </> jobStorageSubdir (jobId job) + readStatusFile tout job jdir >>= \case Just status -> do let status' = JobPreviousStatus status liftIO $ atomically $ writeTVar outVar status' @@ -258,7 +259,7 @@ runJobs mngr@JobManager {..} tout jobs = do runManagedJob mngr tid (return JobCancelled) $ do liftIO $ atomically $ writeTVar outVar JobRunning liftIO $ outputEvent tout $ JobStarted (jobId job) - prepareJob jmDataDir job $ \checkoutPath jdir -> do + prepareJob jmDataDir job $ \checkoutPath -> do updateStatusFile jdir outVar JobDone <$> runJob job uses checkoutPath jdir @@ -346,7 +347,7 @@ updateStatusFile jdir outVar = void $ liftIO $ forkIO $ loop Nothing jobStorageSubdir :: JobId -> FilePath jobStorageSubdir (JobId jidParts) = "jobs" </> joinPath (map (T.unpack . textJobIdPart) (jidParts)) -prepareJob :: (MonadIO m, MonadMask m, MonadFail m) => FilePath -> Job -> (FilePath -> FilePath -> m a) -> m a +prepareJob :: (MonadIO m, MonadMask m, MonadFail m) => FilePath -> Job -> (FilePath -> m a) -> m a prepareJob dir job inner = do withSystemTempDirectory "minici" $ \checkoutPath -> do forM_ (jobCheckout job) $ \(JobCheckout tree mbsub dest) -> do @@ -355,7 +356,7 @@ prepareJob dir job inner = do let jdir = dir </> jobStorageSubdir (jobId job) liftIO $ createDirectoryIfMissing True jdir - inner checkoutPath jdir + inner checkoutPath runJob :: Job -> [ArtifactOutput] -> FilePath -> FilePath -> ExceptT (JobStatus JobOutput) IO JobOutput runJob job uses checkoutPath jdir = do |