diff options
Diffstat (limited to 'src/Eval.hs')
| -rw-r--r-- | src/Eval.hs | 74 |
1 files changed, 51 insertions, 23 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index b73f0f3..1b0d7dd 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -54,6 +54,29 @@ commonPrefix :: Eq a => [ a ] -> [ a ] -> [ a ] commonPrefix (x : xs) (y : ys) | x == y = x : commonPrefix xs ys commonPrefix _ _ = [] +checkIfAlreadyHasDefaultRepoId :: Eval Bool +checkIfAlreadyHasDefaultRepoId = do + asks (any isDefaultRepoId . eiCurrentIdRev) + where + isDefaultRepoId (JobIdName _) = False + isDefaultRepoId (JobIdCommit rname _) = isNothing rname + isDefaultRepoId (JobIdTree rname _ _) = isNothing rname + +collectJobSetRepos :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> Eval [ ( Maybe RepoName, Tree ) ] +collectJobSetRepos revisionOverrides dset = do + jobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither dset + let someJobUsesDefaultRepo = any (any (isNothing . jcRepo) . jobCheckout) jobs + repos = + (if someJobUsesDefaultRepo then (Nothing :) else id) $ + map (Just . repoName) $ maybe [] configRepos $ jobsetConfig dset + forM repos $ \rname -> do + case lookup rname revisionOverrides of + Just tree -> return ( rname, tree ) + Nothing -> do + repo <- evalRepo rname + tree <- getCommitTree =<< readCommit repo "HEAD" + return ( rname, tree ) + collectOtherRepos :: DeclaredJobSet -> DeclaredJob -> Eval [ ( Maybe ( RepoName, Maybe Text ), FilePath ) ] collectOtherRepos dset decl = do jobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither dset @@ -69,10 +92,7 @@ collectOtherRepos dset decl = do job <- maybe (throwError $ OtherEvalError $ "job ‘" <> textJobName name <> "’ not found") return . find ((name ==) . jobName) $ jobs return $ jobCheckout job - let isDefaultRepoId (JobIdName _) = False - isDefaultRepoId (JobIdCommit rname _) = isNothing rname - isDefaultRepoId (JobIdTree rname _ _) = isNothing rname - alreadyHasDefaultRepoId <- asks (any isDefaultRepoId . eiCurrentIdRev) + alreadyHasDefaultRepoId <- checkIfAlreadyHasDefaultRepoId let checkouts = (if alreadyHasDefaultRepoId then filter (isJust . jcRepo) else id) $ concat dependencyRepos @@ -132,6 +152,13 @@ evalJob revisionOverrides dset decl = do evalJobSet :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> Eval JobSet evalJobSet revisionOverrides decl = do EvalInput {..} <- ask + repos <- collectJobSetRepos revisionOverrides decl + alreadyHasDefaultRepoId <- checkIfAlreadyHasDefaultRepoId + let addedRepoIds = + map (\( mbname, tree ) -> JobIdTree mbname "" (treeId tree)) $ + (if alreadyHasDefaultRepoId then filter (isJust . fst) else id) $ + repos + jobs <- fmap (fmap (map fst)) $ either (return . Left) (handleToEither . mapM (evalJob revisionOverrides decl)) $ jobsetJobsEither decl @@ -141,7 +168,7 @@ evalJobSet revisionOverrides decl = do Right declEval -> catMaybes $ map (\jid -> jobId . snd <$> find ((jid ==) . jobId . fst) declEval) $ jobsetExplicitlyRequested decl return JobSet - { jobsetId = JobSetId $ reverse $ eiCurrentIdRev + { jobsetId = JobSetId $ reverse $ reverse addedRepoIds ++ eiCurrentIdRev , jobsetConfig = jobsetConfig decl , jobsetCommit = jobsetCommit decl , jobsetExplicitlyRequested = explicit @@ -162,7 +189,13 @@ evalRepo (Just name) = asks (lookup name . eiOtherRepos) >>= \case canonicalJobName :: [ Text ] -> Config -> Maybe Tree -> Eval JobSet canonicalJobName (r : rs) config mbDefaultRepo = do let name = JobName r - dset = JobSet () (Just config) Nothing [] $ Right $ configJobs config + dset = JobSet + { jobsetId = () + , jobsetConfig = Just config + , jobsetCommit = Nothing + , jobsetExplicitlyRequested = [] + , jobsetJobsEither = Right $ configJobs config + } case find ((name ==) . jobName) (configJobs config) of Just djob -> do otherRepos <- collectOtherRepos dset djob @@ -177,14 +210,8 @@ canonicalJobName (r : rs) config mbDefaultRepo = do case rs' of (r' : _) -> throwError $ OtherEvalError $ "unexpected job ref part ‘" <> r' <> "’" _ -> return () - ( job, sid ) <- evalJob (maybe id ((:) . ( Nothing, )) mbDefaultRepo $ overrides) dset djob - return JobSet - { jobsetId = sid - , jobsetConfig = Just config - , jobsetCommit = Nothing - , jobsetExplicitlyRequested = [] - , jobsetJobsEither = Right [ job ] - } + eset <- evalJobSet (maybe id ((:) . ( Nothing, )) mbDefaultRepo $ overrides) dset + return eset { jobsetJobsEither = fmap (filter ((name ==) . jobName)) $ jobsetJobsEither eset } Nothing -> throwError $ OtherEvalError $ "job ‘" <> r <> "’ not found" canonicalJobName [] _ _ = throwError $ OtherEvalError "expected job name" @@ -266,20 +293,21 @@ fillInDependencies :: JobSet -> Eval JobSet fillInDependencies jset = do ( dset, idRev, otherRepos ) <- local (\ei -> ei { eiCurrentIdRev = [] }) $ do loadJobSetById (jobsetId jset) + eset <- local (\ei -> ei { eiCurrentIdRev = idRev }) $ do + evalJobSet otherRepos dset 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) + allJobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither eset + deps <- gather allJobs 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) + let jobs = catMaybes $ flip map allJobs $ \ejob -> if + | Just job <- find ((jobName ejob ==) . jobName) origJobs + -> Just job - | jobName djob `S.member` deps - -> Just . fst <$> evalJob otherRepos dset djob + | jobName ejob `S.member` deps + -> Just ejob | otherwise - -> return Nothing + -> Nothing return $ jset { jobsetJobsEither = Right jobs } where |