diff options
| -rw-r--r-- | src/Command/Run.hs | 36 | ||||
| -rw-r--r-- | src/Config.hs | 1 | ||||
| -rw-r--r-- | src/Eval.hs | 10 | ||||
| -rw-r--r-- | src/Job.hs | 17 | ||||
| -rw-r--r-- | src/Job/Types.hs | 1 | ||||
| -rw-r--r-- | src/Output.hs | 5 | ||||
| -rw-r--r-- | test/asset/run/rerun.yaml | 45 | ||||
| -rw-r--r-- | test/script/run.et | 121 |
8 files changed, 221 insertions, 15 deletions
diff --git a/src/Command/Run.hs b/src/Command/Run.hs index c4b92bb..ddc166a 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -32,12 +32,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 +64,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" ] @@ -148,6 +168,7 @@ argumentJobSource names = do fullSet <- evalJobSet (map ( Nothing, ) jobtree) JobSet { jobsetId = () , jobsetCommit = jcommit + , jobsetExplicitlyRequested = names , jobsetJobsEither = Right (configJobs config) } let selectedSet = fullSet { jobsetJobsEither = fmap (filter ((`elem` names) . jobName)) (jobsetJobsEither fullSet) } @@ -160,7 +181,7 @@ refJobSource refs = do jobs <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReference refs) sets <- cmdEvalWith id $ do forM jobs $ \( sid, js ) -> do - fillInDependencies $ JobSet sid Nothing (Right $ reverse js) + fillInDependencies $ JobSet sid Nothing (map jobId js) (Right $ reverse js) oneshotJobSource sets where addJobToList :: [ ( JobSetId, [ Job ] ) ] -> ( Job, JobSetId ) -> [ ( JobSetId, [ Job ] ) ] @@ -175,6 +196,7 @@ loadJobSetFromRoot root commit = case root of JobRootConfig config -> return JobSet { jobsetId = () , jobsetCommit = Just commit + , jobsetExplicitlyRequested = [] , jobsetJobsEither = Right $ configJobs config } @@ -332,7 +354,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 diff --git a/src/Config.hs b/src/Config.hs index ea2907c..8a7649a 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -175,5 +175,6 @@ loadJobSetForCommit commit = return . toJobSet =<< loadConfigForCommit =<< getCo toJobSet configEither = JobSet { jobsetId = () , jobsetCommit = Just commit + , jobsetExplicitlyRequested = [] , jobsetJobsEither = fmap configJobs configEither } diff --git a/src/Eval.hs b/src/Eval.hs index 67fea8d..cc3c45c 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -124,9 +124,15 @@ evalJobSet revisionOverrides decl = do jobs <- fmap (fmap (map fst)) $ either (return . Left) (handleToEither . mapM (evalJob revisionOverrides decl)) $ jobsetJobsEither decl + let explicit = + case liftM2 zip (jobsetJobsEither decl) jobs of + Left _ -> [] + Right declEval -> catMaybes $ + map (\jid -> jobId . snd <$> find ((jid ==) . jobId . fst) declEval) $ jobsetExplicitlyRequested decl return JobSet { jobsetId = JobSetId $ reverse $ eiCurrentIdRev , jobsetCommit = jobsetCommit decl + , jobsetExplicitlyRequested = explicit , jobsetJobsEither = jobs } where @@ -144,7 +150,7 @@ evalRepo (Just name) = asks (lookup name . eiOtherRepos) >>= \case canonicalJobName :: [ Text ] -> Config -> Maybe Tree -> Eval ( Job, JobSetId ) canonicalJobName (r : rs) config mbDefaultRepo = do let name = JobName r - dset = JobSet () Nothing $ Right $ configJobs config + dset = JobSet () Nothing [] $ Right $ configJobs config case find ((name ==) . jobName) (configJobs config) of Just djob -> do otherRepos <- collectOtherRepos dset djob @@ -187,7 +193,7 @@ evalJobReference (JobRef rs) = jobsetFromConfig :: [ JobIdPart ] -> Config -> Maybe Tree -> Eval ( DeclaredJobSet, [ JobIdPart ], [ ( Maybe RepoName, Tree ) ] ) jobsetFromConfig sid config _ = do EvalInput {..} <- ask - let dset = JobSet () Nothing $ Right $ configJobs config + let dset = JobSet () Nothing [] $ Right $ configJobs config otherRepos <- forM sid $ \case JobIdName name -> do throwError $ OtherEvalError $ "expected tree id, not a job name ‘" <> textJobName name <> "’" @@ -213,8 +213,10 @@ runManagedJob JobManager {..} tid cancel job = bracket acquire release $ \case writeTVar jmRunningTasks . M.delete tid =<< readTVar jmRunningTasks -runJobs :: JobManager -> Output -> [ Job ] -> IO [ ( Job, TVar (JobStatus JobOutput) ) ] -runJobs mngr@JobManager {..} tout jobs = do +runJobs :: JobManager -> Output -> [ Job ] + -> (JobId -> JobStatus JobOutput -> Bool) -- ^ Rerun condition + -> IO [ ( Job, TVar (JobStatus JobOutput) ) ] +runJobs mngr@JobManager {..} tout jobs rerun = do results <- atomically $ do forM jobs $ \job -> do tid <- reserveTaskId mngr @@ -250,11 +252,13 @@ runJobs mngr@JobManager {..} tout jobs = do Nothing -> do let jdir = jmDataDir </> jobStorageSubdir (jobId job) readStatusFile tout job jdir >>= \case - Just status -> do + Just status | not (rerun (jobId job) status) -> do let status' = JobPreviousStatus status liftIO $ atomically $ writeTVar outVar status' return status' - Nothing -> do + mbStatus -> do + when (isJust mbStatus) $ do + liftIO $ removeDirectoryRecursive jdir uses <- waitForUsedArtifacts tout job results outVar runManagedJob mngr tid (return JobCancelled) $ do liftIO $ atomically $ writeTVar outVar JobRunning @@ -316,6 +320,7 @@ 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) + 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)) @@ -326,7 +331,7 @@ readStatusFile tout job jdir = do artifacts <- forM (jobArtifacts job) $ \( aoutName@(ArtifactName tname), _ ) -> do let adir = jdir </> "artifacts" </> T.unpack tname aoutStorePath = adir </> "data" - aoutWorkPath <- liftIO $ readFile (adir </> "path") + aoutWorkPath <- fmap T.unpack $ liftIO $ T.readFile (adir </> "path") return ArtifactOutput {..} return JobOutput @@ -394,7 +399,7 @@ runJob job uses checkoutPath jdir = do liftIO $ do createDirectoryIfMissing True $ takeDirectory target copyRecursiveForce path target - writeFile (adir </> "path") workPath + T.writeFile (adir </> "path") $ T.pack workPath return $ ArtifactOutput { aoutName = name , aoutWorkPath = workPath diff --git a/src/Job/Types.hs b/src/Job/Types.hs index ad575a1..a0c1d47 100644 --- a/src/Job/Types.hs +++ b/src/Job/Types.hs @@ -57,6 +57,7 @@ data ArtifactName = ArtifactName Text data JobSet' d = JobSet { jobsetId :: JobSetId' d , jobsetCommit :: Maybe Commit + , jobsetExplicitlyRequested :: [ JobId' d ] , jobsetJobsEither :: Either String [ Job' d ] } diff --git a/src/Output.hs b/src/Output.hs index 4ecf08e..5fa2f81 100644 --- a/src/Output.hs +++ b/src/Output.hs @@ -46,6 +46,7 @@ data OutputEvent | JobFinished JobId Text | JobIsDuplicate JobId Text | JobPreviouslyFinished JobId Text + | JobWasSkipped JobId data OutputFootnote = OutputFootnote { footnoteText :: Text @@ -119,6 +120,10 @@ outputEvent out@Output {..} = liftIO . \case forM_ outLogs $ \h -> outStrLn out h ("Previously finished " <> textJobId jid <> " (" <> status <> ")") forM_ outTest $ \h -> outStrLn out h ("job-previous " <> textJobId jid <> " " <> status) + JobWasSkipped jid -> do + forM_ outLogs $ \h -> outStrLn out h ("Skipped " <> textJobId jid) + forM_ outTest $ \h -> outStrLn out h ("job-skip " <> textJobId jid) + outputFootnote :: Output -> Text -> IO OutputFootnote outputFootnote out@Output {..} footnoteText = do footnoteTerminal <- forM outTerminal $ \term -> newFootnote term footnoteText diff --git a/test/asset/run/rerun.yaml b/test/asset/run/rerun.yaml new file mode 100644 index 0000000..dc18b41 --- /dev/null +++ b/test/asset/run/rerun.yaml @@ -0,0 +1,45 @@ +job first: + shell: + - touch x + + artifact out: + path: x + + +job second: + uses: + - first.out + + shell: + - mv x y + + artifact out: + path: y + + +job first_fail: + shell: + - "false" + + artifact out: + path: x + + +job second_skip: + uses: + - first_fail.out + + shell: + - "true" + + artifact out: + path: y + + +job third: + uses: + - second.out + - second_skip.out + + shell: + - "true" diff --git a/test/script/run.et b/test/script/run.et index 86828ec..7c3fb38 100644 --- a/test/script/run.et +++ b/test/script/run.et @@ -22,6 +22,11 @@ def expect_success from p of job: def expect_previous_success from p of job: expect_previous_result from p of job result "done" +def expect_skip from p of job: + let dummy = job == "" # TODO: forces string type + expect from p: + /job-skip $job/ + test RunWithoutRepo: node n @@ -72,14 +77,16 @@ test RunWithRepo: spawn on n as p args [ "./minici.yaml", "run", "--range=$c0..$c2" ] expect_previous_result from p: of "$t1.success" result "done" - of "$t1.failure" result "failed" expect_result from p: + of "$t1.failure" result "failed" of "$t1.third" result "done" of "$t1.fourth" result "done" expect_previous_result from p: of "$t2.success" result "done" + expect_result from p: of "$t2.failure" result "failed" + expect_previous_result from p: of "$t2.third" result "done" of "$t2.fourth" result "done" @@ -134,7 +141,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_previous_success from p of "single.$first_root" + expect_success from p of "single.$first_root" expect /(.*)/ from p capture done guard (done == "run-finish") @@ -305,3 +312,113 @@ test RunExplicitDependentJob: flush from p matching /job-duplicate .*/ expect /(.*)/ from p capture done guard (done == "run-finish") + + +test RunRerun: + node n + shell on n as git_init: + mkdir -p main + git -C main -c init.defaultBranch=master init -q + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + cp "${scripts.path}/rerun.yaml" main/minici.yaml + git -C main add minici.yaml + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'minici' + git -C main rev-parse HEAD^{tree} + + expect /([0-9a-f]+)/ from git_init capture t1 + + local: + spawn on n as p args [ "./main", "run", "$t1.third" ] + expect_success from p of "$t1.first" + expect_success from p of "$t1.second" + expect_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-explicit", "$t1.second" ] + expect_previous_success from p of "$t1.first" + expect_success from p of "$t1.second" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-failed", "$t1.second" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-all", "$t1.second" ] + expect_success from p of "$t1.first" + expect_success from p of "$t1.second" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-none", "$t1.second" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-explicit", "$t1.third" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + expect_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-failed", "$t1.third" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + expect_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-all", "$t1.third" ] + expect_success from p of "$t1.first" + expect_success from p of "$t1.second" + expect_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-none", "$t1.third" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + expect_previous_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") |