diff options
Diffstat (limited to 'src/Command/Run.hs')
| -rw-r--r-- | src/Command/Run.hs | 106 |
1 files changed, 79 insertions, 27 deletions
diff --git a/src/Command/Run.hs b/src/Command/Run.hs index 9652529..b299931 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -8,6 +8,7 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class +import Data.Containers.ListUtils import Data.Either import Data.List import Data.Maybe @@ -32,12 +33,19 @@ import Terminal data RunCommand = RunCommand RunOptions [ Text ] data RunOptions = RunOptions - { roRanges :: [ Text ] + { roRerun :: RerunOption + , roRanges :: [ Text ] , roSinceUpstream :: [ Text ] , roNewCommitsOn :: [ Text ] , roNewTags :: [ Pattern ] } +data RerunOption + = RerunExplicit + | RerunFailed + | RerunAll + | RerunNone + instance Command RunCommand where commandName _ = "run" commandDescription _ = "Execude jobs per minici.yaml for given commits" @@ -57,14 +65,27 @@ instance Command RunCommand where type CommandOptions RunCommand = RunOptions defaultCommandOptions _ = RunOptions - { roRanges = [] + { roRerun = RerunExplicit + , roRanges = [] , roSinceUpstream = [] , roNewCommitsOn = [] , roNewTags = [] } commandOptions _ = - [ Option [] [ "range" ] + [ Option [] [ "rerun-explicit" ] + (NoArg (\opts -> opts { roRerun = RerunExplicit })) + "rerun jobs given explicitly on command line and their failed dependencies (default)" + , Option [] [ "rerun-failed" ] + (NoArg (\opts -> opts { roRerun = RerunFailed })) + "rerun failed jobs only" + , Option [] [ "rerun-all" ] + (NoArg (\opts -> opts { roRerun = RerunAll })) + "rerun all jobs" + , Option [] [ "rerun-none" ] + (NoArg (\opts -> opts { roRerun = RerunNone })) + "do not rerun any job" + , Option [] [ "range" ] (ReqArg (\val opts -> opts { roRanges = T.pack val : roRanges opts }) "<range>") "run jobs for commits in given range" , Option [] [ "since-upstream" ] @@ -126,7 +147,8 @@ mergeSources sources = do argumentJobSource :: [ JobName ] -> CommandExec JobSource argumentJobSource [] = emptyJobSource argumentJobSource names = do - ( config, jobsetCommit ) <- getJobRoot >>= \case + jobRoot <- getJobRoot + ( config, jcommit ) <- case jobRoot of JobRootConfig config -> do commit <- sequence . fmap createWipCommit =<< tryGetDefaultRepo return ( config, commit ) @@ -135,29 +157,49 @@ argumentJobSource names = do config <- either fail return =<< loadConfigForCommit =<< getCommitTree commit return ( config, Just commit ) - jobtree <- case jobsetCommit of + jobtree <- case jcommit of Just commit -> (: []) <$> getCommitTree commit Nothing -> return [] - let cidPart = map (JobIdTree Nothing "" . treeId) jobtree - jobsetJobsEither <- fmap Right $ forM names $ \name -> + let cidPart = case jobRoot of + JobRootConfig {} -> [] + JobRootRepo {} -> map (JobIdTree Nothing "" . treeId) jobtree + forM_ names $ \name -> case find ((name ==) . jobName) (configJobs config) of - Just job -> return job + Just _ -> return () Nothing -> tfail $ "job ‘" <> textJobName name <> "’ not found" - oneshotJobSource . (: []) =<< - cmdEvalWith (\ei -> ei { eiCurrentIdRev = cidPart ++ eiCurrentIdRev ei }) - (evalJobSet (map ( Nothing, ) jobtree) JobSet {..}) + + jset <- cmdEvalWith (\ei -> ei { eiCurrentIdRev = cidPart ++ eiCurrentIdRev ei }) $ do + evalJobSetSelected names (map ( Nothing, ) jobtree) JobSet + { jobsetId = () + , jobsetConfig = Just config + , jobsetCommit = jcommit + , jobsetExplicitlyRequested = names + , jobsetJobsEither = Right (configJobs config) + } + oneshotJobSource [ jset ] refJobSource :: [ JobRef ] -> CommandExec JobSource refJobSource [] = emptyJobSource refJobSource refs = do - jobs <- cmdEvalWith id $ mapM evalJobReference refs - oneshotJobSource . map (JobSet Nothing . Right . (: [])) $ jobs + sets <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReferenceToSet refs) + oneshotJobSource sets + where + addJobToList :: [ JobSet ] -> JobSet -> [ JobSet ] + addJobToList (cur : rest) jset + | jobsetId cur == jobsetId jset = cur { jobsetJobsEither = fmap (nubOrdOn jobId) $ (++) <$> (jobsetJobsEither cur) <*> (jobsetJobsEither jset) + , jobsetExplicitlyRequested = nubOrd $ jobsetExplicitlyRequested cur ++ jobsetExplicitlyRequested jset + } : rest + | otherwise = cur : addJobToList rest jset + addJobToList [] jset = [ jset ] loadJobSetFromRoot :: (MonadIO m, MonadFail m) => JobRoot -> Commit -> m DeclaredJobSet loadJobSetFromRoot root commit = case root of JobRootRepo _ -> loadJobSetForCommit commit JobRootConfig config -> return JobSet - { jobsetCommit = Just commit + { jobsetId = () + , jobsetConfig = Just config + , jobsetCommit = Just commit + , jobsetExplicitlyRequested = [] , jobsetJobsEither = Right $ configJobs config } @@ -294,8 +336,10 @@ cmdRun (RunCommand RunOptions {..} args) = do threadCount <- newTVarIO (0 :: Int) let changeCount f = atomically $ do writeTVar threadCount . f =<< readTVar threadCount - let waitForJobs = atomically $ do - flip when retry . (0 <) =<< readTVar threadCount + let waitForJobs = do + atomically $ do + flip when retry . (0 <) =<< readTVar threadCount + waitForRemainingTasks mngr let loop _ Nothing = return () loop names (Just ( [], next )) = do @@ -315,7 +359,11 @@ cmdRun (RunCommand RunOptions {..} args) = do case jobsetJobsEither jobset of Right jobs -> do - outs <- runJobs mngr output jobs + outs <- 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 statuses = map findJob names forM_ (outputTerminal output) $ \tout -> do @@ -348,22 +396,26 @@ fitToLength maxlen str | len <= maxlen = str <> T.replicate (maxlen - len) " " showStatus :: Bool -> JobStatus a -> Text showStatus blink = \case - JobQueued -> "\ESC[94m…\ESC[0m " + JobQueued -> " \ESC[94m…\ESC[0m " 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 " + 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" - JobFailed -> "\ESC[91m✗\ESC[0m " - JobCancelled -> "\ESC[0mC\ESC[0m " - JobDone _ -> "\ESC[92m✓\ESC[0m " + JobFailed -> " \ESC[91m✗\ESC[0m " + JobCancelled -> " \ESC[0mC\ESC[0m " + JobDone _ -> " \ESC[92m✓\ESC[0m " JobDuplicate _ s -> case s of - JobQueued -> "\ESC[94m^\ESC[0m " - JobWaiting _ -> "\ESC[94m^\ESC[0m " - JobSkipped -> "\ESC[0m-\ESC[0m " - JobRunning -> "\ESC[96m" <> (if blink then "*" else "^") <> "\ESC[0m " + JobQueued -> " \ESC[94m^\ESC[0m " + JobWaiting _ -> " \ESC[94m^\ESC[0m " + JobSkipped -> " \ESC[0m-\ESC[0m " + 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" |