Options to select rerun behavior

Changelog: Added `--rerun-*` command-line options to configure which jobs should be rerun

6 files changed, 57 insertions, 13 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 <> "’"
diff --git a/src/Job.hs b/src/Job.hs
index 0b618f5..ffbb0c1 100644
--- a/src/Job.hs
+++ b/src/Job.hs
@@ -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