Put job ID to evaluated job

6 files changed, 44 insertions, 9 deletions

diff --git a/src/Command.hs b/src/Command.hs
index e2ef911..6fb7e90 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -134,6 +134,7 @@ getEvalInput :: CommandExec EvalInput
 getEvalInput = CommandExec $ do
     eiJobRoot <- asks ciJobRoot
     eiRootPath <- asks ciRootPath
+    eiCurrentIdRev <- return []
     eiContainingRepo <- asks ciContainingRepo
     eiOtherRepos <- asks ciOtherRepos
     return EvalInput {..}
diff --git a/src/Command/JobId.hs b/src/Command/JobId.hs
index eb51a66..d0a85db 100644
--- a/src/Command/JobId.hs
+++ b/src/Command/JobId.hs
@@ -35,4 +35,4 @@ cmdJobId (JobIdCommand ref) = do
     JobId ids <- either (tfail . textEvalError) return =<<
         liftIO (runEval (evalJobReference ref) einput)
 
-    liftIO $ T.putStrLn $ T.intercalate "." $ map textJobIdPart ids
+    liftIO $ T.putStrLn $ textJobId $ JobId ids
diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index e0277c3..068f3a2 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -22,6 +22,7 @@ import Command
 import Config
 import Eval
 import Job
+import Job.Types
 import Repo
 import Terminal
 
@@ -132,7 +133,13 @@ argumentJobSource names = do
             config <- either fail return =<< loadConfigForCommit =<< getCommitTree commit
             return ( config, Just commit )
 
-    einput <- getEvalInput
+    cidPart <- case jobsetCommit of
+        Just commit -> (: []) . JobIdTree . treeId <$> getCommitTree commit
+        Nothing -> return []
+    einputBase <- getEvalInput
+    let einput = einputBase
+            { eiCurrentIdRev = cidPart ++ eiCurrentIdRev einputBase
+            }
     jobsetJobsEither <- fmap Right $ forM names $ \name ->
         case find ((name ==) . jobName) (configJobs config) of
             Just job -> return job
@@ -151,15 +158,22 @@ rangeSource :: Text -> Text -> CommandExec JobSource
 rangeSource base tip = do
     root <- getJobRoot
     repo <- getDefaultRepo
-    einput <- getEvalInput
+    einputBase <- getEvalInput
     commits <- listCommits repo (base <> ".." <> tip)
-    oneshotJobSource . map (evalJobSet einput) =<< mapM (loadJobSetFromRoot root) commits
+    jobsets <- forM commits $ \commit -> do
+        tree <- getCommitTree commit
+        let einput = einputBase
+                { eiCurrentIdRev = JobIdTree (treeId tree) : eiCurrentIdRev einputBase
+                }
+        evalJobSet einput <$> loadJobSetFromRoot root commit
+    oneshotJobSource jobsets
+
 
 watchBranchSource :: Text -> CommandExec JobSource
 watchBranchSource branch = do
     root <- getJobRoot
     repo <- getDefaultRepo
-    einput <- getEvalInput
+    einputBase <- getEvalInput
     getCurrentTip <- watchBranch repo branch
     let go prev tmvar = do
             cur <- atomically $ do
@@ -170,7 +184,12 @@ watchBranchSource branch = do
                     Nothing -> retry
 
             commits <- listCommits repo (textCommitId (commitId prev) <> ".." <> textCommitId (commitId cur))
-            jobsets <- map (evalJobSet einput) <$> mapM (loadJobSetFromRoot root) commits
+            jobsets <- forM commits $ \commit -> do
+                tree <- getCommitTree commit
+                let einput = einputBase
+                        { eiCurrentIdRev = JobIdTree (treeId tree) : eiCurrentIdRev einputBase
+                        }
+                evalJobSet einput <$> loadJobSetFromRoot root commit
             nextvar <- newEmptyTMVarIO
             atomically $ putTMVar tmvar $ Just ( jobsets, JobSource nextvar )
             go cur nextvar
@@ -189,12 +208,16 @@ watchTagSource :: Pattern -> CommandExec JobSource
 watchTagSource pat = do
     root <- getJobRoot
     chan <- watchTags =<< getDefaultRepo
-    einput <- getEvalInput
+    einputBase <- getEvalInput
 
     let go tmvar = do
             tag <- atomically $ readTChan chan
             if match pat $ T.unpack $ tagTag tag
               then do
+                tree <- getCommitTree $ tagObject tag
+                let einput = einputBase
+                        { eiCurrentIdRev = JobIdTree (treeId tree) : eiCurrentIdRev einputBase
+                        }
                 jobset <- evalJobSet einput <$> (loadJobSetFromRoot root) (tagObject tag)
                 nextvar <- newEmptyTMVarIO
                 atomically $ putTMVar tmvar $ Just ( [ jobset ], JobSource nextvar )
diff --git a/src/Config.hs b/src/Config.hs
index 98b5aa5..fb9a527 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -78,6 +78,7 @@ instance FromYAML Config where
 parseJob :: Text -> Node Pos -> Parser DeclaredJob
 parseJob name node = flip (withMap "Job") node $ \j -> do
     let jobName = JobName name
+        jobId = jobName
     ( jobContainingCheckout, jobOtherCheckout ) <- partitionEithers <$> choice
         [ parseSingleCheckout =<< j .: "checkout"
         , parseMultipleCheckouts =<< j .: "checkout"
diff --git a/src/Eval.hs b/src/Eval.hs
index 807a3b8..0e3e3e0 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -25,6 +25,7 @@ import Repo
 data EvalInput = EvalInput
     { eiJobRoot :: JobRoot
     , eiRootPath :: FilePath
+    , eiCurrentIdRev :: [ JobIdPart ]
     , eiContainingRepo :: Maybe Repo
     , eiOtherRepos :: [ ( RepoName, Repo ) ]
     }
@@ -49,7 +50,8 @@ evalJob EvalInput {..} decl = do
             lookup name eiOtherRepos
         return ( repo, revision, checkout )
     return Job
-        { jobName = jobName decl
+        { jobId = JobId $ reverse $ JobIdName (jobId decl) : eiCurrentIdRev
+        , jobName = jobName decl
         , jobContainingCheckout = jobContainingCheckout decl
         , jobOtherCheckout = otherCheckout
         , jobRecipe = jobRecipe decl
diff --git a/src/Job/Types.hs b/src/Job/Types.hs
index 5415e4d..19cf560 100644
--- a/src/Job/Types.hs
+++ b/src/Job/Types.hs
@@ -14,7 +14,8 @@ data Declared
 data Evaluated
 
 data Job' d = Job
-    { jobName :: JobName
+    { jobId :: JobId' d
+    , jobName :: JobName
     , jobContainingCheckout :: [ JobCheckout ]
     , jobOtherCheckout :: [ ( JobRepo d, Maybe Text, JobCheckout ) ]
     , jobRecipe :: [ CreateProcess ]
@@ -25,6 +26,10 @@ data Job' d = Job
 type Job = Job' Evaluated
 type DeclaredJob = Job' Declared
 
+type family JobId' d :: Type where
+    JobId' Declared = JobName
+    JobId' Evaluated = JobId
+
 data JobName = JobName Text
     deriving (Eq, Ord, Show)
 
@@ -78,3 +83,6 @@ textJobIdPart = \case
     JobIdName name -> textJobName name
     JobIdCommit cid -> textCommitId cid
     JobIdTree tid -> textTreeId tid
+
+textJobId :: JobId -> Text
+textJobId (JobId ids) = T.intercalate "." $ map textJobIdPart ids