Automatically run dependencies

Changelog: Automatically run dependencies of jobs specified on command line

4 files changed, 125 insertions, 13 deletions

diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index a7e7eff..a80e15d 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -126,7 +126,7 @@ mergeSources sources = do
 argumentJobSource :: [ JobName ] -> CommandExec JobSource
 argumentJobSource [] = emptyJobSource
 argumentJobSource names = do
-    ( config, jobsetCommit ) <- getJobRoot >>= \case
+    ( config, jcommit ) <- getJobRoot >>= \case
         JobRootConfig config -> do
             commit <- sequence . fmap createWipCommit =<< tryGetDefaultRepo
             return ( config, commit )
@@ -135,24 +135,33 @@ 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
-        jobsetId = ()
-    jobsetJobsEither <- fmap Right $ forM names $ \name ->
+    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
+        fullSet <- evalJobSet (map ( Nothing, ) jobtree) JobSet
+            { jobsetId = ()
+            , jobsetCommit = jcommit
+            , jobsetJobsEither = Right (configJobs config)
+            }
+        let selectedSet = fullSet { jobsetJobsEither = fmap (filter ((`elem` names) . jobName)) (jobsetJobsEither fullSet) }
+        fillInDependencies selectedSet
+    oneshotJobSource [ jset ]
 
 refJobSource :: [ JobRef ] -> CommandExec JobSource
 refJobSource [] = emptyJobSource
 refJobSource refs = do
     jobs <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReference refs)
-    oneshotJobSource . map (\( sid, js ) -> JobSet sid Nothing (Right $ reverse js)) $ jobs
+    sets <- cmdEvalWith id $ do
+        forM jobs $ \( sid, js ) -> do
+            fillInDependencies $ JobSet sid Nothing (Right $ reverse js)
+    oneshotJobSource sets
   where
     addJobToList :: [ ( JobSetId, [ Job ] ) ] -> ( Job, JobSetId ) -> [ ( JobSetId, [ Job ] ) ]
     addJobToList (( sid, js ) : rest ) ( job, jsid )
diff --git a/src/Eval.hs b/src/Eval.hs
index 57a9d88..67fea8d 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -6,6 +6,9 @@ module Eval (
     evalJob,
     evalJobSet,
     evalJobReference,
+
+    loadJobSetById,
+    fillInDependencies,
 ) where
 
 import Control.Monad
@@ -14,6 +17,7 @@ import Control.Monad.Reader
 
 import Data.List
 import Data.Maybe
+import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
 
@@ -178,3 +182,86 @@ evalJobReference (JobRef rs) =
             canonicalCommitConfig rs defRepo
         JobRootConfig config -> do
             canonicalJobName rs config Nothing
+
+
+jobsetFromConfig :: [ JobIdPart ] -> Config -> Maybe Tree -> Eval ( DeclaredJobSet, [ JobIdPart ], [ ( Maybe RepoName, Tree ) ] )
+jobsetFromConfig sid config _ = do
+    EvalInput {..} <- ask
+    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 <> "’"
+        JobIdCommit name cid -> do
+            repo <- evalRepo name
+            tree <- getCommitTree =<< readCommitId repo cid
+            return ( name, tree )
+        JobIdTree name path tid -> do
+            repo <- evalRepo name
+            tree <- readTreeId repo path tid
+            return ( name, tree )
+    return ( dset, eiCurrentIdRev, otherRepos )
+
+jobsetFromCommitConfig :: [ JobIdPart ] -> Repo -> Eval ( DeclaredJobSet, [ JobIdPart ], [ ( Maybe RepoName, Tree ) ] )
+jobsetFromCommitConfig (JobIdTree name path tid : sid) repo = do
+    when (isJust name) $ do
+        throwError $ OtherEvalError $ "expected default repo commit or tree id"
+    when (not (null path)) $ do
+        throwError $ OtherEvalError $ "expected root commit or tree id"
+    tree <- readTreeId repo path tid
+    config <- either fail return =<< loadConfigForCommit tree
+    local (\ei -> ei { eiCurrentIdRev = JobIdTree Nothing "" (treeId tree) : eiCurrentIdRev ei }) $ do
+        ( dset, idRev, otherRepos ) <- jobsetFromConfig sid config (Just tree)
+        return ( dset, idRev, ( Nothing, tree ) : otherRepos )
+
+jobsetFromCommitConfig (JobIdCommit name cid : sid) repo = do
+    when (isJust name) $ do
+        throwError $ OtherEvalError $ "expected default repo commit or tree id"
+    tree <- getCommitTree =<< readCommitId repo cid
+    jobsetFromCommitConfig (JobIdTree name "" (treeId tree) : sid) repo
+
+jobsetFromCommitConfig (JobIdName name : _) _ = do
+    throwError $ OtherEvalError $ "expected commit or tree id, not a job name ‘" <> textJobName name <> "’"
+
+jobsetFromCommitConfig [] _ = do
+    throwError $ OtherEvalError $ "expected commit or tree id"
+
+loadJobSetById :: JobSetId -> Eval ( DeclaredJobSet, [ JobIdPart ], [ ( Maybe RepoName, Tree ) ] )
+loadJobSetById (JobSetId sid) = do
+    asks eiJobRoot >>= \case
+        JobRootRepo defRepo -> do
+            jobsetFromCommitConfig sid defRepo
+        JobRootConfig config -> do
+            jobsetFromConfig sid config Nothing
+
+fillInDependencies :: JobSet -> Eval JobSet
+fillInDependencies jset = do
+    ( dset, idRev, otherRepos ) <- local (\ei -> ei { eiCurrentIdRev = [] }) $ do
+        loadJobSetById (jobsetId jset)
+    origJobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither jset
+    declJobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither dset
+    deps <- gather declJobs S.empty (map jobName origJobs)
+
+    jobs <- local (\ei -> ei { eiCurrentIdRev = idRev }) $ do
+        fmap catMaybes $ forM declJobs $ \djob -> if
+            | Just job <- find ((jobName djob ==) . jobName) origJobs
+            -> return (Just job)
+
+            | jobName djob `S.member` deps
+            -> Just . fst <$> evalJob otherRepos dset djob
+
+            | otherwise
+            -> return Nothing
+
+    return $ jset { jobsetJobsEither = Right jobs }
+  where
+    gather djobs cur ( name : rest )
+        | name `S.member` cur
+        = gather djobs cur rest
+
+        | Just djob <- find ((name ==) . jobName) djobs
+        = gather djobs (S.insert name cur) $ map fst (jobUses djob) ++ rest
+
+        | otherwise
+        = throwError $ OtherEvalError $ "dependency ‘" <> textJobName name <> "’ not found"
+
+    gather _ cur [] = return cur
diff --git a/src/Repo.hs b/src/Repo.hs
index b154209..09e577b 100644
--- a/src/Repo.hs
+++ b/src/Repo.hs
@@ -9,8 +9,8 @@ module Repo (
     Tag(..),
 
     openRepo,
-    readCommit, tryReadCommit,
-    readTree, tryReadTree,
+    readCommit, readCommitId, tryReadCommit,
+    readTree, readTreeId, tryReadTree,
     readBranch,
     readTag,
     listCommits,
@@ -175,6 +175,9 @@ readCommit :: (MonadIO m, MonadFail m) => Repo -> Text -> m Commit
 readCommit repo@GitRepo {..} ref = maybe (fail err) return =<< tryReadCommit repo ref
     where err = "revision ‘" <> T.unpack ref <> "’ not found in ‘" <> gitDir <> "’"
 
+readCommitId :: (MonadIO m, MonadFail m) => Repo -> CommitId -> m Commit
+readCommitId repo cid = readCommit repo (textCommitId cid)
+
 tryReadCommit :: (MonadIO m, MonadFail m) => Repo -> Text -> m (Maybe Commit)
 tryReadCommit repo ref = sequence . fmap (mkCommit repo . CommitId) =<< tryReadObjectId repo "commit" ref
 
@@ -182,6 +185,9 @@ readTree :: (MonadIO m, MonadFail m) => Repo -> FilePath -> Text -> m Tree
 readTree repo@GitRepo {..} subdir ref = maybe (fail err) return =<< tryReadTree repo subdir ref
     where err = "tree ‘" <> T.unpack ref <> "’ not found in ‘" <> gitDir <> "’"
 
+readTreeId :: (MonadIO m, MonadFail m) => Repo -> FilePath -> TreeId -> m Tree
+readTreeId repo subdir tid = readTree repo subdir $ textTreeId tid
+
 tryReadTree :: (MonadIO m, MonadFail m) => Repo -> FilePath -> Text -> m (Maybe Tree)
 tryReadTree treeRepo treeSubdir ref = do
     fmap (fmap TreeId) (tryReadObjectId treeRepo "tree" ref) >>= \case
diff --git a/test/script/run.et b/test/script/run.et
index 5531707..5d34552 100644
--- a/test/script/run.et
+++ b/test/script/run.et
@@ -271,14 +271,24 @@ test RunExplicitDependentJob:
     expect /([0-9a-f]+)/ from git_init capture t4
 
     local:
-        spawn on n as p args [ "./main", "run", "$c1.first", "$t2.first", "$t3.second", "$c1.fifth", "$c1.fourth", "$c1.third", "$c1.second" ]
+        spawn on n as p args [ "./main", "run", "$c1.first", "$t2.first", "$t3.fourth", "$c1.fifth", "$c1.fourth", "$c1.third", "$c1.second", "$t4.fifth" ]
         expect_success from p of "$t1.first"
         expect_success from p of "$t1.second"
         expect_success from p of "$t1.third"
         expect_success from p of "$t1.fourth"
         expect_success from p of "$t1.fifth"
+
         expect_success from p of "$t2.first"
-        expect from p /job-finish $t3.second error/
+
+        expect_success from p of "$t3.first"
+        expect_success from p of "$t3.second"
+        expect_success from p of "$t3.fourth"
+
+        expect_success from p of "$t4.first"
+        expect_success from p of "$t4.second"
+        expect_success from p of "$t4.third"
+        expect_success from p of "$t4.fourth"
+        expect_success from p of "$t4.fifth"
 
         flush from p matching /note .*/
         expect /(.*)/ from p capture done