refactor: introduce resolveProgramDb

Author: andreabedini

cabal-install/src/Distribution/Client/ProjectConfig.hs

@@ -57,6 +57,7 @@ module Distribution.Client.ProjectConfig
   , BuildTimeSettings (..)
   , resolveBuildTimeSettings
   , resolveNumJobsSetting
+  , resolveProgramDb
 
     -- * Checking configuration
   , checkBadPerPackageCompilerPaths
@@ -175,6 +176,9 @@ import Distribution.Simple.InstallDirs
   )
 import Distribution.Simple.Program
   ( ConfiguredProgram (..)
+  , ProgramDb
+  , defaultProgramDb
+  , userSpecifyPaths
   )
 import Distribution.Simple.Setup
   ( Flag (Flag)
@@ -245,6 +249,7 @@ import System.IO
   )
 
 import Distribution.Deprecated.ProjectParseUtils (ProjectParseError (..), ProjectParseWarning)
+import Distribution.Simple.Program.Db (prependProgramSearchPath)
 import Distribution.Solver.Types.ProjectConfigPath
 
 ----------------------------------------
@@ -554,6 +559,12 @@ resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs =
       1 -> Serial
       n -> NumJobs (Just n)
 
+resolveProgramDb :: Verbosity -> PackageConfig -> IO ProgramDb
+resolveProgramDb verbosity pkgconf = do
+  let extraPath = fromNubList (packageConfigProgramPathExtra pkgconf)
+  progdb <- prependProgramSearchPath verbosity extraPath [] defaultProgramDb
+  return $ userSpecifyPaths (Map.toList (getMapLast (packageConfigProgramPaths pkgconf))) progdb
+
 ---------------------------------------------
 -- Reading and writing project config files
 --

cabal-install/src/Distribution/Client/ProjectPlanning.hs

@@ -476,7 +476,7 @@ configureCompiler
         , projectConfigHcPkg
         }
     , projectConfigLocalPackages =
-      PackageConfig
+      projectConfigLocalPackages@PackageConfig
         { packageConfigProgramPaths
         , packageConfigProgramPathExtra
         }
@@ -497,16 +497,14 @@ configureCompiler
       )
       $ do
         liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
-        let extraPath = fromNubList packageConfigProgramPathExtra
-        progdb <- liftIO $ prependProgramSearchPath verbosity extraPath [] defaultProgramDb
-        let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb
+        progdb <- liftIO $ resolveProgramDb verbosity projectConfigLocalPackages
         result@(_, _, progdb'') <-
           liftIO $
             Cabal.configCompilerEx
               hcFlavor
               hcPath
               hcPkg
-              progdb'
+              progdb
               verbosity
 
         -- Note that we added the user-supplied program locations and args