From d442fcbbe5bc40d903b25bd21fd2a9f2b8dd4cc6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 28 Mar 2026 15:17:06 +0100 Subject: Task data type --- src/Command/Run.hs | 4 ++-- src/Job.hs | 11 +++++++++-- 2 files changed, 11 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/Command/Run.hs b/src/Command/Run.hs index b299931..776f869 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -359,12 +359,12 @@ cmdRun (RunCommand RunOptions {..} args) = do case jobsetJobsEither jobset of Right jobs -> do - outs <- runJobs mngr output jobs $ case roRerun of + tasks <- runJobs mngr output jobs $ case roRerun of RerunExplicit -> \jid status -> jid `elem` jobsetExplicitlyRequested jobset || jobStatusFailed status RerunFailed -> \_ status -> jobStatusFailed status RerunAll -> \_ _ -> True RerunNone -> \_ _ -> False - let findJob name = snd <$> find ((name ==) . jobName . fst) outs + let findJob name = taskStatus <$> find ((name ==) . jobName . taskJob) tasks statuses = map findJob names forM_ (outputTerminal output) $ \tout -> do line <- newLine tout "" diff --git a/src/Job.hs b/src/Job.hs index 20e6fd5..aadea66 100644 --- a/src/Job.hs +++ b/src/Job.hs @@ -7,6 +7,7 @@ module Job ( JobStatus(..), jobStatusFinished, jobStatusFailed, JobManager(..), newJobManager, cancelAllJobs, + Task(..), TaskId, runJobs, waitForRemainingTasks, prepareJob, @@ -145,6 +146,12 @@ data JobManager = JobManager , jmOpenStatusUpdates :: TVar Int } +data Task = Task + { taskId :: TaskId + , taskJob :: Job + , taskStatus :: TVar (JobStatus JobOutput) + } + newtype TaskId = TaskId Int deriving (Eq, Ord) @@ -223,7 +230,7 @@ runManagedJob JobManager {..} tid cancel job = bracket acquire release $ \case runJobs :: JobManager -> Output -> [ Job ] -> (JobId -> JobStatus JobOutput -> Bool) -- ^ Rerun condition - -> IO [ ( Job, TVar (JobStatus JobOutput) ) ] + -> IO [ Task ] runJobs mngr@JobManager {..} tout jobs rerun = do results <- atomically $ do forM jobs $ \job -> do @@ -292,7 +299,7 @@ runJobs mngr@JobManager {..} tout jobs rerun = do atomically $ writeTVar outVar $ either id id res outputJobFinishedEvent tout job $ either id id res - return $ map (\( job, _, var ) -> ( job, var )) results + return $ map (\( job, tid, var ) -> Task tid job var ) results waitForRemainingTasks :: JobManager -> IO () waitForRemainingTasks JobManager {..} = do -- cgit v1.2.3