diff options
| -rw-r--r-- | src/Command/Run.hs | 4 | ||||
| -rw-r--r-- | src/Job.hs | 94 | ||||
| -rw-r--r-- | src/Output.hs | 10 | ||||
| -rw-r--r-- | test/script/run.et | 16 |
4 files changed, 100 insertions, 24 deletions
diff --git a/src/Command/Run.hs b/src/Command/Run.hs index a80e15d..c4b92bb 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -381,6 +381,10 @@ showStatus blink = \case JobRunning -> "\ESC[96m" <> (if blink then "*" else "^") <> "\ESC[0m " _ -> showStatus blink s + JobPreviousStatus (JobDone _) -> "\ESC[90m«\ESC[32m✓\ESC[0m " + JobPreviousStatus (JobFailed) -> "\ESC[90m«\ESC[31m✗\ESC[0m " + JobPreviousStatus s -> "\ESC[90m«" <> T.init (showStatus blink s) + displayStatusLine :: TerminalOutput -> TerminalLine -> Text -> Text -> [ Maybe (TVar (JobStatus JobOutput)) ] -> IO () displayStatusLine tout line prefix1 prefix2 statuses = do go "\0" @@ -62,6 +62,7 @@ data ArtifactOutput = ArtifactOutput data JobStatus a = JobQueued | JobDuplicate JobId (JobStatus a) + | JobPreviousStatus (JobStatus a) | JobWaiting [JobName] | JobRunning | JobSkipped @@ -73,23 +74,33 @@ data JobStatus a = JobQueued jobStatusFinished :: JobStatus a -> Bool jobStatusFinished = \case - JobQueued {} -> False - JobDuplicate _ s -> jobStatusFinished s - JobWaiting {} -> False - JobRunning {} -> False - _ -> True + JobQueued {} -> False + JobDuplicate _ s -> jobStatusFinished s + JobPreviousStatus s -> jobStatusFinished s + JobWaiting {} -> False + JobRunning {} -> False + _ -> True jobStatusFailed :: JobStatus a -> Bool jobStatusFailed = \case - JobDuplicate _ s -> jobStatusFailed s - JobError {} -> True - JobFailed {} -> True - _ -> False + JobDuplicate _ s -> jobStatusFailed s + JobPreviousStatus s -> jobStatusFailed s + JobError {} -> True + JobFailed {} -> True + _ -> False + +jobResult :: JobStatus a -> Maybe a +jobResult = \case + JobDone x -> Just x + JobDuplicate _ s -> jobResult s + JobPreviousStatus s -> jobResult s + _ -> Nothing textJobStatus :: JobStatus a -> Text textJobStatus = \case JobQueued -> "queued" JobDuplicate {} -> "duplicate" + JobPreviousStatus s -> textJobStatus s JobWaiting _ -> "waiting" JobRunning -> "running" JobSkipped -> "skipped" @@ -98,9 +109,21 @@ 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 + "queued" : _ -> return (Just JobQueued) + "running" : _ -> return (Just JobRunning) + "skipped" : _ -> return (Just JobSkipped) + "error" : note : _ -> Just . JobError <$> liftIO (outputFootnote tout note) + "failed" : _ -> return (Just JobFailed) + "cancelled" : _ -> return (Just JobCancelled) + "done" : _ -> Just . JobDone <$> readResult + _ -> return Nothing + textJobStatusDetails :: JobStatus a -> Text textJobStatusDetails = \case JobError err -> footnoteText err <> "\n" + JobPreviousStatus s -> textJobStatusDetails s _ -> "" @@ -213,7 +236,7 @@ runJobs mngr@JobManager {..} tout jobs = do | otherwise -> do JobError <$> outputFootnote tout (T.pack $ displayException e) atomically $ writeTVar outVar status - outputEvent tout $ JobFinished (jobId job) (textJobStatus status) + outputJobFinishedEvent tout job status handle handler $ do res <- runExceptT $ do duplicate <- liftIO $ atomically $ do @@ -225,13 +248,19 @@ runJobs mngr@JobManager {..} tout jobs = do case duplicate of Nothing -> do - uses <- waitForUsedArtifacts tout job results outVar - runManagedJob mngr tid (return JobCancelled) $ do - liftIO $ atomically $ writeTVar outVar JobRunning - liftIO $ outputEvent tout $ JobStarted (jobId job) - prepareJob jmDataDir job $ \checkoutPath jdir -> do - updateStatusFile (jdir </> "status") outVar - JobDone <$> runJob job uses checkoutPath jdir + readStatusFile tout job (jmDataDir </> jobStorageSubdir (jobId job)) >>= \case + Just status -> do + let status' = JobPreviousStatus status + liftIO $ atomically $ writeTVar outVar status' + return status' + Nothing -> do + uses <- waitForUsedArtifacts tout job results outVar + runManagedJob mngr tid (return JobCancelled) $ do + liftIO $ atomically $ writeTVar outVar JobRunning + liftIO $ outputEvent tout $ JobStarted (jobId job) + prepareJob jmDataDir job $ \checkoutPath jdir -> do + updateStatusFile jdir outVar + JobDone <$> runJob job uses checkoutPath jdir Just ( jid, origVar ) -> do let wait = do @@ -249,7 +278,7 @@ runJobs mngr@JobManager {..} tout jobs = do liftIO wait atomically $ writeTVar outVar $ either id id res - outputEvent tout $ JobFinished (jobId job) (textJobStatus $ either id id res) + outputJobFinishedEvent tout job $ either id id res return $ map (\( job, _, var ) -> ( job, var )) results waitForUsedArtifacts :: (MonadIO m, MonadError (JobStatus JobOutput) m) => @@ -276,21 +305,42 @@ waitForUsedArtifacts tout job results outVar = do ustatuses <- liftIO $ loop Nothing forM ustatuses $ \(ustatus, (JobName tjobName, uartName@(ArtifactName tartName))) -> do - case ustatus of - JobDone out -> case find ((==uartName) . aoutName) $ outArtifacts out of + case jobResult ustatus of + Just out -> case find ((==uartName) . aoutName) $ outArtifacts out of Just art -> return art Nothing -> throwError . JobError =<< liftIO (outputFootnote tout $ "Artifact '" <> tjobName <> "." <> tartName <> "' not found") _ -> throwError JobSkipped +outputJobFinishedEvent :: Output -> Job -> JobStatus a -> IO () +outputJobFinishedEvent tout job = \case + JobDuplicate _ s -> outputEvent tout $ JobIsDuplicate (jobId job) (textJobStatus s) + JobPreviousStatus s -> outputEvent tout $ JobPreviouslyFinished (jobId job) (textJobStatus s) + 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 + handleIOError (\_ -> return Nothing) $ do + text <- liftIO $ T.readFile (jdir </> "status") + readJobStatus tout text $ do + artifacts <- forM (jobArtifacts job) $ \( aoutName@(ArtifactName tname), _ ) -> do + let adir = jdir </> "artifacts" </> T.unpack tname + aoutStorePath = adir </> "data" + aoutWorkPath <- liftIO $ readFile (adir </> "path") + return ArtifactOutput {..} + + return JobOutput + { outArtifacts = artifacts + } + updateStatusFile :: MonadIO m => FilePath -> TVar (JobStatus JobOutput) -> m () -updateStatusFile path outVar = void $ liftIO $ forkIO $ loop Nothing +updateStatusFile jdir outVar = void $ liftIO $ forkIO $ loop Nothing where loop prev = do status <- atomically $ do status <- readTVar outVar when (Just status == prev) retry return status - T.writeFile path $ textJobStatus status <> "\n" <> textJobStatusDetails status + T.writeFile (jdir </> "status") $ textJobStatus status <> "\n" <> textJobStatusDetails status when (not (jobStatusFinished status)) $ loop $ Just status jobStorageSubdir :: JobId -> FilePath diff --git a/src/Output.hs b/src/Output.hs index 64704ec..4ecf08e 100644 --- a/src/Output.hs +++ b/src/Output.hs @@ -44,6 +44,8 @@ data OutputEvent | LogMessage Text | JobStarted JobId | JobFinished JobId Text + | JobIsDuplicate JobId Text + | JobPreviouslyFinished JobId Text data OutputFootnote = OutputFootnote { footnoteText :: Text @@ -109,6 +111,14 @@ outputEvent out@Output {..} = liftIO . \case forM_ outLogs $ \h -> outStrLn out h ("Finished " <> textJobId jid <> " (" <> status <> ")") forM_ outTest $ \h -> outStrLn out h ("job-finish " <> textJobId jid <> " " <> status) + JobIsDuplicate jid status -> do + forM_ outLogs $ \h -> outStrLn out h ("Duplicate " <> textJobId jid <> " (" <> status <> ")") + forM_ outTest $ \h -> outStrLn out h ("job-duplicate " <> textJobId jid <> " " <> status) + + JobPreviouslyFinished jid status -> do + forM_ outLogs $ \h -> outStrLn out h ("Previously finished " <> textJobId jid <> " (" <> status <> ")") + forM_ outTest $ \h -> outStrLn out h ("job-previous " <> textJobId jid <> " " <> status) + outputFootnote :: Output -> Text -> IO OutputFootnote outputFootnote out@Output {..} footnoteText = do footnoteTerminal <- forM outTerminal $ \term -> newFootnote term footnoteText diff --git a/test/script/run.et b/test/script/run.et index 08cee71..86828ec 100644 --- a/test/script/run.et +++ b/test/script/run.et @@ -10,9 +10,18 @@ def expect_result from p of job result result: /job-finish $job ([a-z]+)/ capture done guard (done == result) +def expect_previous_result from p of job result result: + let dummy = job == "" # TODO: forces string type + expect from p: + /job-previous $job ([a-z]+)/ capture done + guard (done == result) + def expect_success from p of job: expect_result from p of job result "done" +def expect_previous_success from p of job: + expect_previous_result from p of job result "done" + test RunWithoutRepo: node n @@ -61,12 +70,14 @@ test RunWithRepo: local: spawn on n as p args [ "./minici.yaml", "run", "--range=$c0..$c2" ] - expect_result from p: + expect_previous_result from p: of "$t1.success" result "done" of "$t1.failure" result "failed" + expect_result from p: of "$t1.third" result "done" of "$t1.fourth" result "done" + expect_previous_result from p: of "$t2.success" result "done" of "$t2.failure" result "failed" of "$t2.third" result "done" @@ -123,7 +134,7 @@ test RunExternalRepo: # Explicit jobfile within a git repo local: spawn on n as p args [ "--repo=first:./first", "--repo=second:./second", "--storage=.minici", "${scripts.path}/external.yaml", "run", "single" ] - expect_success from p of "single.$first_root" + expect_previous_success from p of "single.$first_root" expect /(.*)/ from p capture done guard (done == "run-finish") @@ -291,5 +302,6 @@ test RunExplicitDependentJob: expect_success from p of "$t4.fifth" flush from p matching /note .*/ + flush from p matching /job-duplicate .*/ expect /(.*)/ from p capture done guard (done == "run-finish") |