From ac70a5f9aebcfd51901740681463d1ac4fa90e33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 29 Jun 2025 22:20:10 +0200 Subject: Explicit JobSet ID --- src/Command/Extract.hs | 2 +- src/Command/JobId.hs | 2 +- src/Command/Log.hs | 2 +- src/Command/Run.hs | 19 +++++++++---------- src/Config.hs | 3 ++- src/Eval.hs | 37 ++++++++++++++++++++++--------------- src/Job/Types.hs | 10 +++++++++- 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 -- cgit v1.2.3