diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2025-06-29 22:20:10 +0200 | 
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-06-30 20:38:25 +0200 | 
| commit | ac70a5f9aebcfd51901740681463d1ac4fa90e33 (patch) | |
| tree | 353ea6ed5aaea7dab8e12e31b31e039367c4c58b /src/Eval.hs | |
| parent | f1beff8cdbf5a2e54ea5e36b6edf337fc45ffc8b (diff) | |
Explicit JobSet ID
Diffstat (limited to 'src/Eval.hs')
| -rw-r--r-- | src/Eval.hs | 37 | 
1 files changed, 22 insertions, 15 deletions
| 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 |