Explicit JobSet ID

7 files changed, 45 insertions, 30 deletions

diff --git a/src/Command/Extract.hs b/src/Command/Extract.hs
index 8a0a035..cc92587 100644
--- a/src/Command/Extract.hs
+++ b/src/Command/Extract.hs
@@ -78,7 +78,7 @@ cmdExtract (ExtractCommand ExtractOptions {..} ExtractArguments {..}) = do
             _     -> return False
 
     forM_ extractArtifacts $ \( ref, ArtifactName aname ) -> do
-        jid@(JobId ids) <- either (tfail . textEvalError) (return . jobId) =<<
+        jid@(JobId ids) <- either (tfail . textEvalError) (return . jobId . fst) =<<
             liftIO (runEval (evalJobReference ref) einput)
 
         let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids
diff --git a/src/Command/JobId.hs b/src/Command/JobId.hs
index 173f543..096ed56 100644
--- a/src/Command/JobId.hs
+++ b/src/Command/JobId.hs
@@ -52,7 +52,7 @@ cmdJobId :: JobIdCommand -> CommandExec ()
 cmdJobId (JobIdCommand JobIdOptions {..} ref) = do
     einput <- getEvalInput
     out <- getOutput
-    JobId ids <- either (tfail . textEvalError) (return . jobId) =<<
+    JobId ids <- either (tfail . textEvalError) (return . jobId . fst) =<<
         liftIO (runEval (evalJobReference ref) einput)
 
     outputMessage out $ textJobId $ JobId ids
diff --git a/src/Command/Log.hs b/src/Command/Log.hs
index 25bfc06..e48ce8f 100644
--- a/src/Command/Log.hs
+++ b/src/Command/Log.hs
@@ -37,7 +37,7 @@ instance Command LogCommand where
 cmdLog :: LogCommand -> CommandExec ()
 cmdLog (LogCommand ref) = do
     einput <- getEvalInput
-    jid <- either (tfail . textEvalError) (return . jobId) =<<
+    jid <- either (tfail . textEvalError) (return . jobId . fst) =<<
         liftIO (runEval (evalJobReference ref) einput)
     output <- getOutput
     storageDir <- getStorageDir
diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index ca6d275..a7e7eff 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -139,6 +139,7 @@ argumentJobSource names = do
         Just commit -> (: []) <$> getCommitTree commit
         Nothing -> return []
     let cidPart = map (JobIdTree Nothing "" . treeId) jobtree
+        jobsetId = ()
     jobsetJobsEither <- fmap Right $ forM names $ \name ->
         case find ((name ==) . jobName) (configJobs config) of
             Just job -> return job
@@ -151,22 +152,20 @@ refJobSource :: [ JobRef ] -> CommandExec JobSource
 refJobSource [] = emptyJobSource
 refJobSource refs = do
     jobs <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReference refs)
-    oneshotJobSource . map (JobSet Nothing . Right . reverse) $ jobs
+    oneshotJobSource . map (\( sid, js ) -> JobSet sid Nothing (Right $ reverse js)) $ jobs
   where
-    deriveSetId :: Job -> [ JobIdPart ]
-    deriveSetId job = let JobId parts = jobId job in init parts
-
-    addJobToList :: [[ Job ]] -> Job -> [[ Job ]]
-    addJobToList (js@(j : _) : rest) job
-        | deriveSetId j == deriveSetId job = (job : js) : rest
-        | otherwise                        = js : addJobToList rest job
-    addJobToList _ job                     = [[ job ]]
+    addJobToList :: [ ( JobSetId, [ Job ] ) ] -> ( Job, JobSetId ) -> [ ( JobSetId, [ Job ] ) ]
+    addJobToList (( sid, js ) : rest ) ( job, jsid )
+        | sid == jsid             = ( sid, job : js ) : rest
+        | otherwise               = ( sid, js ) : addJobToList rest ( job, jsid )
+    addJobToList [] ( job, jsid ) = [ ( jsid, [ job ] ) ]
 
 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 = ()
+        , jobsetCommit = Just commit
         , jobsetJobsEither = Right $ configJobs config
         }
 
diff --git a/src/Config.hs b/src/Config.hs
index 4327193..ea2907c 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -173,6 +173,7 @@ loadJobSetForCommit :: (MonadIO m, MonadFail m) => Commit -> m DeclaredJobSet
 loadJobSetForCommit commit = return . toJobSet =<< loadConfigForCommit =<< getCommitTree commit
   where
     toJobSet configEither = JobSet
-        { jobsetCommit = Just commit
+        { jobsetId = ()
+        , jobsetCommit = Just commit
         , jobsetJobsEither = fmap configJobs configEither
         }
diff --git a/src/Eval.hs b/src/Eval.hs
index f064cb1..57a9d88 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -78,7 +78,7 @@ collectOtherRepos dset decl = do
     return $ map (\r -> ( r, commonSubdir r )) . nub . map jcRepo $ checkouts
 
 
-evalJob :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> DeclaredJob -> Eval Job
+evalJob :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> DeclaredJob -> Eval ( Job, JobSetId )
 evalJob revisionOverrides dset decl = do
     EvalInput {..} <- ask
     otherRepos <- collectOtherRepos dset decl
@@ -102,20 +102,27 @@ evalJob revisionOverrides dset decl = do
             }
 
     let otherRepoIds = map (\( repo, ( subtree, tree )) -> JobIdTree (fst <$> repo) subtree (treeId tree)) otherRepoTrees
-    return Job
-        { jobId = JobId $ reverse $ reverse otherRepoIds ++ JobIdName (jobId decl) : eiCurrentIdRev
-        , jobName = jobName decl
-        , jobCheckout = checkouts
-        , jobRecipe = jobRecipe decl
-        , jobArtifacts = jobArtifacts decl
-        , jobUses = jobUses decl
-        }
+    return
+        ( Job
+            { jobId = JobId $ reverse $ reverse otherRepoIds ++ JobIdName (jobId decl) : eiCurrentIdRev
+            , jobName = jobName decl
+            , jobCheckout = checkouts
+            , jobRecipe = jobRecipe decl
+            , jobArtifacts = jobArtifacts decl
+            , jobUses = jobUses decl
+            }
+        , JobSetId $ reverse $ reverse otherRepoIds ++ eiCurrentIdRev
+        )
 
 evalJobSet :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> Eval JobSet
 evalJobSet revisionOverrides decl = do
-    jobs <- either (return . Left) (handleToEither . mapM (evalJob revisionOverrides decl)) $ jobsetJobsEither decl
+    EvalInput {..} <- ask
+    jobs <- fmap (fmap (map fst))
+        $ either (return . Left) (handleToEither . mapM (evalJob revisionOverrides decl))
+        $ jobsetJobsEither decl
     return JobSet
-        { jobsetCommit = jobsetCommit decl
+        { jobsetId = JobSetId $ reverse $ eiCurrentIdRev
+        , jobsetCommit = jobsetCommit decl
         , jobsetJobsEither = jobs
         }
   where
@@ -130,10 +137,10 @@ evalRepo (Just name) = asks (lookup name . eiOtherRepos) >>= \case
     Nothing -> throwError $ OtherEvalError $ "repo ‘" <> textRepoName name <> "’ not defined"
 
 
-canonicalJobName :: [ Text ] -> Config -> Maybe Tree -> Eval Job
+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
@@ -157,14 +164,14 @@ readTreeFromIdRef (r : rs) subdir repo = do
             Nothing -> throwError $ OtherEvalError $ "failed to resolve ‘" <> r <> "’ to a commit or tree in " <> T.pack (show repo)
 readTreeFromIdRef [] _ _ = throwError $ OtherEvalError $ "expected commit or tree reference"
 
-canonicalCommitConfig :: [ Text ] -> Repo -> Eval Job
+canonicalCommitConfig :: [ Text ] -> Repo -> Eval ( Job, JobSetId )
 canonicalCommitConfig rs repo = do
     ( tree, rs' ) <- readTreeFromIdRef rs "" repo
     config <- either fail return =<< loadConfigForCommit tree
     local (\ei -> ei { eiCurrentIdRev = JobIdTree Nothing "" (treeId tree) : eiCurrentIdRev ei }) $
         canonicalJobName rs' config (Just tree)
 
-evalJobReference :: JobRef -> Eval Job
+evalJobReference :: JobRef -> Eval ( Job, JobSetId )
 evalJobReference (JobRef rs) =
     asks eiJobRoot >>= \case
         JobRootRepo defRepo -> do
diff --git a/src/Job/Types.hs b/src/Job/Types.hs
index 4024317..ad575a1 100644
--- a/src/Job/Types.hs
+++ b/src/Job/Types.hs
@@ -55,13 +55,18 @@ data ArtifactName = ArtifactName Text
 
 
 data JobSet' d = JobSet
-    { jobsetCommit :: Maybe Commit
+    { jobsetId :: JobSetId' d
+    , jobsetCommit :: Maybe Commit
     , jobsetJobsEither :: Either String [ Job' d ]
     }
 
 type JobSet = JobSet' Evaluated
 type DeclaredJobSet = JobSet' Declared
 
+type family JobSetId' d :: Type where
+    JobSetId' Declared = ()
+    JobSetId' Evaluated = JobSetId
+
 jobsetJobs :: JobSet -> [ Job ]
 jobsetJobs = either (const []) id . jobsetJobsEither
 
@@ -69,6 +74,9 @@ jobsetJobs = either (const []) id . jobsetJobsEither
 newtype JobId = JobId [ JobIdPart ]
     deriving (Eq, Ord)
 
+newtype JobSetId = JobSetId [ JobIdPart ]
+    deriving (Eq, Ord)
+
 data JobIdPart
     = JobIdName JobName
     | JobIdCommit (Maybe RepoName) CommitId