summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2026-09-12 09:14:18 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2026-09-13 15:05:42 +0200
commit108114a076ed24ae998cf8b0222282321963dde4 (patch)
treed453dbd6d536bda0eab1f511e9fabc507e8c0492
parenta589e61c2b807196696632eb17e8ad573daa9c08 (diff)
Don't print footnote for unused previous error status
-rw-r--r--src/Command/Run.hs2
-rw-r--r--src/Job.hs52
2 files changed, 30 insertions, 24 deletions
diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index 6419c58..dd56cf7 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -440,7 +440,7 @@ showStatus blink = \case
JobWaiting uses -> "\ESC[94m~" <> fitToLength 6 (T.intercalate "," (map textJobName uses)) <> "\ESC[0m"
JobSkipped -> " \ESC[0m-\ESC[0m "
JobRunning -> " \ESC[96m" <> (if blink then "*" else "•") <> "\ESC[0m "
- JobError fnote -> "\ESC[91m" <> fitToLength 7 ("!! [" <> T.pack (maybe "?" (show . tfNumber) (footnoteTerminal fnote)) <> "]") <> "\ESC[0m"
+ JobError fnote -> "\ESC[91m" <> fitToLength 7 ("!! [" <> T.pack (maybe "?" (show . tfNumber) (either (const Nothing) footnoteTerminal fnote)) <> "]") <> "\ESC[0m"
JobFailed -> " \ESC[91m✗\ESC[0m "
JobCancelled -> " \ESC[0mC\ESC[0m "
JobDone _ -> " \ESC[92m✓\ESC[0m "
diff --git a/src/Job.hs b/src/Job.hs
index 5b88130..e94524e 100644
--- a/src/Job.hs
+++ b/src/Job.hs
@@ -71,16 +71,17 @@ data ArtifactOutput = ArtifactOutput
deriving (Eq)
-data JobStatus a = JobQueued
- | JobDuplicate JobId (JobStatus a)
- | JobPreviousStatus (JobStatus a)
- | JobWaiting [JobName]
- | JobRunning
- | JobSkipped
- | JobError OutputFootnote
- | JobFailed
- | JobCancelled
- | JobDone a
+data JobStatus a
+ = JobQueued
+ | JobDuplicate JobId (JobStatus a)
+ | JobPreviousStatus (JobStatus a)
+ | JobWaiting [JobName]
+ | JobRunning
+ | JobSkipped
+ | JobError (Either Text OutputFootnote)
+ | JobFailed
+ | JobCancelled
+ | JobDone a
deriving (Eq)
jobStatusFinished :: JobStatus a -> Bool
@@ -120,12 +121,12 @@ textJobStatus = \case
JobCancelled -> "cancelled"
JobDone _ -> "done"
-readJobStatus :: (MonadIO m) => Output -> Text -> m a -> m (Maybe (JobStatus a))
-readJobStatus tout text readResult = case T.lines text of
+readJobStatus :: (MonadIO m) => Text -> m a -> m (Maybe (JobStatus a))
+readJobStatus text readResult = case T.lines text of
"queued" : _ -> return (Just JobQueued)
"running" : _ -> return (Just JobRunning)
"skipped" : _ -> return (Just JobSkipped)
- "error" : note : _ -> Just . JobError <$> liftIO (outputFootnote tout note)
+ "error" : note : _ -> return (Just $ JobError $ Left note)
"failed" : _ -> return (Just JobFailed)
"cancelled" : _ -> return (Just JobCancelled)
"done" : _ -> Just . JobDone <$> readResult
@@ -133,10 +134,15 @@ readJobStatus tout text readResult = case T.lines text of
textJobStatusDetails :: JobStatus a -> Text
textJobStatusDetails = \case
- JobError err -> footnoteText err <> "\n"
+ JobError err -> either id footnoteText err <> "\n"
JobPreviousStatus s -> textJobStatusDetails s
_ -> ""
+printStatusError :: MonadIO m => Output -> JobStatus a -> m (JobStatus a)
+printStatusError tout = \case
+ JobError (Left note) -> JobError . Right <$> liftIO (outputFootnote tout note)
+ status -> return status
+
data JobManager = JobManager
{ jmMaxRunningTasks :: Int
@@ -249,7 +255,7 @@ runJobs mngr@JobManager {..} tout jobs rerun = do
| Just JobCancelledException <- fromException e -> do
return JobCancelled
| otherwise -> do
- JobError <$> outputFootnote tout (T.pack $ displayException e)
+ JobError . Right <$> outputFootnote tout (T.pack $ displayException e)
atomically $ writeTVar taskStatus status
outputJobFinishedEvent tout taskJob status
@@ -268,9 +274,9 @@ runJobs mngr@JobManager {..} tout jobs rerun = do
case duplicate of
Nothing -> do
let jdir = jmDataDir </> jobStorageSubdir (jobId taskJob)
- readStatusFile tout taskJob jdir >>= \case
+ readStatusFile taskJob jdir >>= \case
Just status | status /= JobCancelled && not (rerun (jobId taskJob) status) -> do
- let status' = JobPreviousStatus status
+ status' <- JobPreviousStatus <$> printStatusError tout status
liftIO $ atomically $ writeTVar taskStatus status'
return status'
mbStatus -> do
@@ -323,12 +329,12 @@ waitForUsedArtifacts tout job results outVar = do
forM_ selfSpecs $ \( _, artName@(ArtifactName tname) ) -> do
when (not (artName `elem` map fst (jobArtifacts job))) $ do
- throwError . JobError =<< liftIO (outputFootnote tout $ "Artifact ‘" <> tname <> "’ not produced by the job")
+ throwError . JobError . Right =<< liftIO (outputFootnote tout $ "Artifact ‘" <> tname <> "’ not produced by the job")
ujobs <- forM artSpecs $ \( ujobId, uartName ) -> do
case find (\( j, _, _ ) -> jobId j == ujobId) results of
Just ( _, _, var ) -> return ( var, ( ujobId, uartName ))
- Nothing -> throwError . JobError =<< liftIO (outputFootnote tout $ "Job ‘" <> textJobId ujobId <> "’ not found")
+ Nothing -> throwError . JobError . Right =<< liftIO (outputFootnote tout $ "Job ‘" <> textJobId ujobId <> "’ not found")
let loop prev = do
ustatuses <- atomically $ do
@@ -348,7 +354,7 @@ waitForUsedArtifacts tout job results outVar = do
case jobResult ustatus of
Just out -> case find ((==uartName) . aoutName) $ outArtifacts out of
Just art -> return ( spec, art )
- Nothing -> throwError . JobError =<< liftIO (outputFootnote tout $ "Artifact ‘" <> textJobId tjobId <> "." <> tartName <> "’ not found")
+ Nothing -> throwError . JobError . Right =<< liftIO (outputFootnote tout $ "Artifact ‘" <> textJobId tjobId <> "." <> tartName <> "’ not found")
_ -> throwError JobSkipped
outputJobFinishedEvent :: Output -> Job -> JobStatus a -> IO ()
@@ -358,11 +364,11 @@ outputJobFinishedEvent tout job = \case
JobSkipped -> outputEvent tout $ JobWasSkipped (jobId job)
s -> outputEvent tout $ JobFinished (jobId job) (textJobStatus s)
-readStatusFile :: (MonadIO m, MonadCatch m) => Output -> Job -> FilePath -> m (Maybe (JobStatus JobOutput))
-readStatusFile tout job jdir = do
+readStatusFile :: (MonadIO m, MonadCatch m) => Job -> FilePath -> m (Maybe (JobStatus JobOutput))
+readStatusFile job jdir = do
handleIOError (\_ -> return Nothing) $ do
text <- liftIO $ T.readFile (jdir </> "status")
- readJobStatus tout text $ do
+ readJobStatus text $ do
artifacts <- forM (jobArtifacts job) $ \( aoutName@(ArtifactName tname), _ ) -> do
let adir = jdir </> "artifacts" </> T.unpack tname
aoutStorePath = adir </> "data"