From f159eab0dbda7a97b6113f5dfb6a132dc4280c24 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 28 Aug 2023 22:26:46 +0800 Subject: [PATCH] WIP --- .../Distribution/Client/ProjectPlanning.hs | 141 ++++++------------ 1 file changed, 49 insertions(+), 92 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index cc8c3ffe9e7..9fc90b7fe09 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -601,10 +601,7 @@ rebuildInstallPlan rerunIfChanged verbosity fileMonitorElaboratedPlan - ( projectConfigMonitored - , localPackages - , systemSearchPath - ) + (projectConfigMonitored, localPackages, systemSearchPath) $ scopeA verbosity distDirLayout cabalStoreDirLayout projectConfig localPackages mbInstalledPackages -- The improved plan changes each time we install something, whereas @@ -736,30 +733,53 @@ scopeA (configuredPrograms progdb) (getMapMappend (projectConfigSpecificPackage projectConfig)) - -- TODO: [required eventually] find/configure other programs that the - -- user specifies. + let corePackageDbs = applyPackageDbFlags [GlobalPackageDB] (projectConfigPackageDBs projectConfigShared) + installedPkgIndex <- + getInstalledPackages + verbosity + compiler + progdb + platform + corePackageDbs - -- TODO: [required eventually] find/configure all build-tools - -- but note that some of them may be built as part of the plan. + let solverSettings = resolveSolverSettings projectConfig + (sourcePkgDb, totalIndexState, activeRepos) <- + getSourcePackages + verbosity + withRepoCtx + (solverSettingIndexState solverSettings) + (solverSettingActiveRepos solverSettings) - (solverPlan, pkgConfigDB, totalIndexState, activeRepos) <- - let - solverSettings = resolveSolverSettings projectConfig - localPackagesEnabledStanzas = getLocalPackagesEnabledStanzas projectConfig localPackages - in + pkgConfigDB <- getPkgConfigDb verbosity progdb + + let localPackagesEnabledStanzas = getLocalPackagesEnabledStanzas projectConfig localPackages + + solverPlan <- do + -- Run the solver to get the initial install plan. + -- This is expensive so we cache it independently. rerunIfChanged verbosity fileMonitorSolverPlan (solverSettings, localPackages, localPackagesEnabledStanzas, compiler, platform, programDbSignature progdb) - $ phaseRunSolver - verbosity - projectConfig - compilerEtc - localPackages - localPackagesEnabledStanzas - (fromMaybe mempty mbInstalledPackages) - solverSettings - withRepoCtx + $ do + + liftIO $ notice verbosity "Resolving dependencies..." + + return $ foldProgress + (\step rest -> Step (SolverMessage step) rest) + (\err -> Fail (SolverFailure (SolverFailureReport projectConfig compiler platform localPackages) err)) + (\plan -> Done plan) $ + planPackages + verbosity + compiler + platform + Modular + solverSettings + (fromMaybe empty mbInstalledPackages <> installedPkgIndex) + sourcePkgDb + pkgConfigDB + localPackages + localPackagesEnabledStanzas liftIO $ debug verbosity "Elaborating the install plan..." @@ -815,77 +835,8 @@ scopeA projectConfigShared projectConfigBuildOnly --- Run the solver to get the initial install plan. --- This is expensive so we cache it independently. --- -phaseRunSolver - :: Verbosity - -> ProjectConfig - -> (Compiler, Platform, ProgramDb) - -> [PackageSpecifier UnresolvedSourcePackage] - -> Map PackageName (Map OptionalStanza Bool) - -> InstalledPackageIndex - -> SolverSettings - -> (forall a. (RepoContext -> IO a) -> IO a) - -> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos) -phaseRunSolver - verbosity - projectConfig@ProjectConfig{projectConfigShared} - (compiler, platform, progdb) - localPackages - localPackagesEnabledStanzas - installedPackages - solverSettings - withRepoCtx = - do - installedPkgIndex <- - getInstalledPackages - verbosity - compiler - progdb - platform - corePackageDbs - (sourcePkgDb, tis, ar) <- - getSourcePackages - verbosity - withRepoCtx - (solverSettingIndexState solverSettings) - (solverSettingActiveRepos solverSettings) - pkgConfigDB <- getPkgConfigDb verbosity progdb - - -- TODO: [code cleanup] it'd be better if the Compiler contained the - -- ConfiguredPrograms that it needs, rather than relying on the progdb - -- since we don't need to depend on all the programs here, just the - -- ones relevant for the compiler. - - liftIO $ do - notice verbosity "Resolving dependencies..." - planOrError <- - foldProgress logMsg (pure . Left) (pure . Right) $ - planPackages - verbosity - compiler - platform - Modular - solverSettings - (installedPackages <> installedPkgIndex) - sourcePkgDb - pkgConfigDB - localPackages - localPackagesEnabledStanzas - case planOrError of - Left msg -> do - reportPlanningFailure projectConfig compiler platform localPackages - die' verbosity msg - Right plan -> return (plan, pkgConfigDB, tis, ar) - where - corePackageDbs :: [PackageDB] - corePackageDbs = - applyPackageDbFlags - [GlobalPackageDB] - (projectConfigPackageDBs projectConfigShared) - logMsg message rest = debugNoWrap verbosity message >> rest + -- logMsg message rest = debugNoWrap verbosity message >> rest -- Elaborate the solver's install plan to get a fully detailed plan. This -- version of the plan has the final nix-style hashed ids. @@ -945,6 +896,12 @@ phaseElaboratePlan return (instantiatedPlan, elaboratedShared) +data SolverMessage a = SolverMessage a +data SolverFailure a = SolverFailure SolverFailureReport a + +type LocalPackages = [PackageSpecifier UnresolvedSourcePackage] +data SolverFailureReport = SolverFailureReport ProjectConfig Compiler Platform LocalPackages + -- | If a 'PackageSpecifier' refers to a single package, return Just that -- package. reportPlanningFailure :: ProjectConfig -> Compiler -> Platform -> [PackageSpecifier UnresolvedSourcePackage] -> IO ()