diff options
| -rw-r--r-- | src/Command/Run.hs | 14 | ||||
| -rw-r--r-- | src/Eval.hs | 48 |
2 files changed, 14 insertions, 48 deletions
diff --git a/src/Command/Run.hs b/src/Command/Run.hs index 982a07a..04c7273 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -8,6 +8,7 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class +import Data.Containers.ListUtils import Data.Either import Data.List import Data.Maybe @@ -168,29 +169,26 @@ argumentJobSource names = do Nothing -> tfail $ "job ‘" <> textJobName name <> "’ not found" jset <- cmdEvalWith (\ei -> ei { eiCurrentIdRev = cidPart ++ eiCurrentIdRev ei }) $ do - fullSet <- evalJobSet (map ( Nothing, ) jobtree) JobSet + evalJobSetSelected names (map ( Nothing, ) jobtree) JobSet { jobsetId = () , jobsetConfig = Just config , jobsetCommit = jcommit , jobsetExplicitlyRequested = names , jobsetJobsEither = Right (configJobs config) } - let selectedSet = fullSet { jobsetJobsEither = fmap (filter ((`elem` names) . jobName)) (jobsetJobsEither fullSet) } - fillInDependencies selectedSet oneshotJobSource [ jset ] refJobSource :: [ JobRef ] -> CommandExec JobSource refJobSource [] = emptyJobSource refJobSource refs = do - jsets <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReference refs) - sets <- cmdEvalWith id $ do - forM jsets $ \jset -> do - fillInDependencies $ jset { jobsetExplicitlyRequested = either (const []) (map jobId) $ jobsetJobsEither jset } + sets <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReference refs) oneshotJobSource sets where addJobToList :: [ JobSet ] -> JobSet -> [ JobSet ] addJobToList (cur : rest) jset - | jobsetId cur == jobsetId jset = cur { jobsetJobsEither = (++) <$> (fmap reverse $ jobsetJobsEither jset) <*> (jobsetJobsEither cur) } : rest + | jobsetId cur == jobsetId jset = cur { jobsetJobsEither = fmap (nubOrdOn jobId) $ (++) <$> (jobsetJobsEither cur) <*> (jobsetJobsEither jset) + , jobsetExplicitlyRequested = nubOrd $ jobsetExplicitlyRequested cur ++ jobsetExplicitlyRequested jset + } : rest | otherwise = cur : addJobToList rest jset addJobToList [] jset = [ jset ] diff --git a/src/Eval.hs b/src/Eval.hs index 3a6c2c4..2afec42 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -4,10 +4,10 @@ module Eval ( Eval, runEval, evalJobSet, + evalJobSetSelected, evalJobReference, loadJobSetById, - fillInDependencies, ) where import Control.Monad @@ -16,7 +16,6 @@ import Control.Monad.Reader import Data.List import Data.Maybe -import Data.Set qualified as S import Data.Text (Text) import Data.Text qualified as T @@ -189,7 +188,11 @@ evalJobSetSelected selected revisionOverrides decl = do (if alreadyHasDefaultRepoId then filter (isJust . fst) else id) $ repos - jobs <- handleToEither $ evalJobs [] [] repos decl selected + evaluated <- handleToEither $ evalJobs [] [] repos decl selected + let jobs = case liftM2 (,) evaluated (jobsetJobsEither decl) of + Left err -> Left err + Right ( ejobs, djobs ) -> Right $ mapMaybe (\dj -> find ((jobName dj ==) . jobName) ejobs) djobs + let explicit = mapMaybe (\name -> jobId <$> find ((name ==) . jobName) (either (const []) id jobs)) $ jobsetExplicitlyRequested decl return JobSet { jobsetId = JobSetId $ reverse $ reverse addedRepoIds ++ eiCurrentIdRev @@ -217,7 +220,7 @@ canonicalJobName (r : rs) config mbDefaultRepo = do { jobsetId = () , jobsetConfig = Just config , jobsetCommit = Nothing - , jobsetExplicitlyRequested = [] + , jobsetExplicitlyRequested = [ name ] , jobsetJobsEither = Right $ configJobs config } case find ((name ==) . jobName) (configJobs config) of @@ -234,8 +237,7 @@ canonicalJobName (r : rs) config mbDefaultRepo = do case rs' of (r' : _) -> throwError $ OtherEvalError $ "unexpected job ref part ‘" <> r' <> "’" _ -> return () - eset <- evalJobSetSelected [ name ] (maybe id ((:) . ( Nothing, )) mbDefaultRepo $ overrides) dset - return eset { jobsetJobsEither = fmap (filter ((name ==) . jobName)) $ jobsetJobsEither eset } + evalJobSetSelected (jobsetExplicitlyRequested dset) (maybe id ((:) . ( Nothing, )) mbDefaultRepo $ overrides) dset Nothing -> throwError $ OtherEvalError $ "job ‘" <> r <> "’ not found" canonicalJobName [] _ _ = throwError $ OtherEvalError "expected job name" @@ -312,37 +314,3 @@ loadJobSetById (JobSetId sid) = do jobsetFromCommitConfig sid defRepo JobRootConfig config -> do jobsetFromConfig sid config Nothing - -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 - allJobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither eset - deps <- gather allJobs S.empty (map jobName origJobs) - - let jobs = catMaybes $ flip map allJobs $ \ejob -> if - | Just job <- find ((jobName ejob ==) . jobName) origJobs - -> Just job - - | jobName ejob `S.member` deps - -> Just ejob - - | otherwise - -> Nothing - - return $ jset { jobsetJobsEither = Right jobs } - where - gather djobs cur ( name : rest ) - | name `S.member` cur - = gather djobs cur rest - - | Just djob <- find ((name ==) . jobName) djobs - = gather djobs (S.insert name cur) $ map fst (jobUses djob) ++ map (fst . jpArtifact) (jobPublish djob) ++ rest - - | otherwise - = throwError $ OtherEvalError $ "dependency ‘" <> textJobName name <> "’ not found" - - gather _ cur [] = return cur |