Fix extra-prog-path propagation in the codebase.

This allows finding system executables in:
- `cabal exec`
- `cabal build` (configure steps for example)
- `cabal get`

In particular this fixes PATH issues when running MinGW cabal in
PowerShell.

Author: jasagredo

Cabal/src/Distribution/Simple/Configure.hs

@@ -1008,6 +1008,9 @@ configure (pkg_descr0, pbi) cfg = do
 mkPromisedDepsSet :: [GivenComponent] -> Map (PackageName, ComponentName) ComponentId
 mkPromisedDepsSet comps = Map.fromList [((pn, CLibName ln), cid) | GivenComponent pn ln cid <- comps]
 
+-- | Adds the extra program paths from the flags provided to @configure@ as
+-- well as specified locations for certain known programs and their default
+-- arguments.
 mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb
 mkProgramDb cfg initialProgramDb = programDb
   where

Cabal/src/Distribution/Simple/ConfigureScript.hs

@@ -169,10 +169,7 @@ runConfigureScript verbosity flags lbi = do
       maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)]
       args' = configureFile' : args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag
       shProg = simpleProgram "sh"
-      progDb =
-        modifyProgramSearchPath
-          (\p -> map ProgramSearchPathDir extraPath ++ p)
-          emptyProgramDb
+  progDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb
   shConfiguredProg <-
     lookupProgram shProg
       `fmap` configureProgram verbosity shProg progDb

Cabal/src/Distribution/Simple/Program/Db.hs

@@ -34,6 +34,7 @@ module Distribution.Simple.Program.Db
     -- ** Query and manipulate the program db
   , addKnownProgram
   , addKnownPrograms
+  , appendProgramSearchPath
   , lookupKnownProgram
   , knownPrograms
   , getProgramSearchPath
@@ -221,6 +222,20 @@ modifyProgramSearchPath
 modifyProgramSearchPath f db =
   setProgramSearchPath (f $ getProgramSearchPath db) db
 
+-- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'
+-- by appending the provided extra paths. Also logs the added paths
+-- in info verbosity.
+appendProgramSearchPath
+   :: Verbosity
+   -> [FilePath]
+   -> ProgramDb
+   -> IO ProgramDb
+appendProgramSearchPath verbosity extraPaths db = do
+  info verbosity . unlines $
+    "Including the following directories in PATH:"
+      : map ("- " ++) extraPaths
+  pure $ modifyProgramSearchPath (map ProgramSearchPathDir extraPaths ++) db
+
 -- | User-specify this path.  Basically override any path information
 --  for this program in the configuration. If it's not a known
 --  program ignore it.

Cabal/src/Distribution/Simple/Program/GHC.hs

@@ -554,8 +554,6 @@ data GhcOptions = GhcOptions
   , ghcOptExtraPath :: NubListR FilePath
   -- ^ Put the extra folders in the PATH environment variable we invoke
   -- GHC with
-  -- | Put the extra folders in the PATH environment variable we invoke
-  -- GHC with
   , ghcOptCabal :: Flag Bool
   -- ^ Let GHC know that it is Cabal that's calling it.
   -- Modifies some of the GHC error messages.

Cabal/src/Distribution/Simple/Program/Run.hs

@@ -51,8 +51,13 @@ data ProgramInvocation = ProgramInvocation
   { progInvokePath :: FilePath
   , progInvokeArgs :: [String]
   , progInvokeEnv :: [(String, Maybe String)]
-  , -- Extra paths to add to PATH
-    progInvokePathEnv :: [FilePath]
+  , progInvokePathEnv :: [FilePath]
+  -- ^ Extra paths to add to PATH.
+  --
+  -- NOTE: The only program that sets paths here is GHC. See
+  -- 'componentGhcOptions' and the value of 'ghcOptExtraPath' there used then in
+  -- 'ghcInvocation'. Every other program we run doesn't set this but instead
+  -- provides a @"PATH"@ var in @progInvokeEnv@.
   , progInvokeCwd :: Maybe FilePath
   , progInvokeInput :: Maybe IOData
   , progInvokeInputEncoding :: IOEncoding

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

@@ -26,6 +26,10 @@ import Distribution.Client.NixStyleOptions
   , defaultNixStyleFlags
   , nixStyleOptions
   )
+import Distribution.Client.ProjectConfig.Types
+  ( ProjectConfig (projectConfigShared)
+  , ProjectConfigShared (projectConfigProgPathExtra)
+  )
 import Distribution.Client.ProjectFlags
   ( removeIgnoreProjectOption
   )
@@ -66,12 +70,9 @@ import Distribution.Simple.GHC
   )
 import Distribution.Simple.Program.Db
   ( configuredPrograms
-  , modifyProgramSearchPath
+  , appendProgramSearchPath
   , requireProgram
   )
-import Distribution.Simple.Program.Find
-  ( ProgramSearchPathEntry (..)
-  )
 import Distribution.Simple.Program.Run
   ( programInvocation
   , runProgramInvocation
@@ -86,11 +87,13 @@ import Distribution.Simple.Program.Types
 import Distribution.Simple.Utils
   ( createDirectoryIfMissingVerbose
   , dieWithException
-  , info
   , notice
   , withTempDirectory
   , wrapText
   )
+import Distribution.Utils.NubList
+  ( fromNubList
+  )
 import Distribution.Verbosity
   ( normal
   )
@@ -162,10 +165,11 @@ execAction flags@NixStyleFlags{..} extraArgs globalFlags = do
       mempty
 
   -- Some dependencies may have executables. Let's put those on the PATH.
-  extraPaths <- pathAdditions verbosity baseCtx buildCtx
-  let programDb =
-        modifyProgramSearchPath
-          (map ProgramSearchPathDir extraPaths ++)
+  let extraPaths = pathAdditions baseCtx buildCtx
+
+  programDb <-
+        appendProgramSearchPath verbosity
+          extraPaths
           . pkgConfigCompilerProgs
           . elaboratedShared
           $ buildCtx
@@ -263,13 +267,14 @@ withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do
         action envOverrides
     )
 
-pathAdditions :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO [FilePath]
-pathAdditions verbosity ProjectBaseContext{..} ProjectBuildContext{..} = do
-  info verbosity . unlines $
-    "Including the following directories in PATH:"
-      : paths
-  return paths
+pathAdditions :: ProjectBaseContext -> ProjectBuildContext -> [FilePath]
+pathAdditions ProjectBaseContext{..} ProjectBuildContext{..} =
+    paths ++ cabalConfigPaths
   where
+    cabalConfigPaths = fromNubList
+                       . projectConfigProgPathExtra
+                       . projectConfigShared
+                       $ projectConfig
     paths =
       S.toList $
         binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute

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

@@ -151,13 +151,10 @@ import qualified Distribution.Simple.InstallDirs as InstallDirs
 import qualified Distribution.Simple.PackageIndex as PI
 import Distribution.Simple.Program.Db
   ( defaultProgramDb
-  , modifyProgramSearchPath
+  , appendProgramSearchPath
   , userSpecifyArgss
   , userSpecifyPaths
   )
-import Distribution.Simple.Program.Find
-  ( ProgramSearchPathEntry (..)
-  )
 import Distribution.Simple.Setup
   ( Flag (..)
   , installDirsOptions
@@ -496,6 +493,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
           , projectConfigHcPath
           , projectConfigHcPkg
           , projectConfigStoreDir
+          , projectConfigProgPathExtra
           }
       , projectConfigLocalPackages =
         PackageConfig
@@ -509,17 +507,13 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
     hcPath = flagToMaybe projectConfigHcPath
     hcPkg = flagToMaybe projectConfigHcPkg
 
+  configProgDb <- appendProgramSearchPath verbosity ((fromNubList packageConfigProgramPathExtra) ++ (fromNubList projectConfigProgPathExtra)) defaultProgramDb
+  let
     -- ProgramDb with directly user specified paths
     preProgDb =
       userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))
         . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs))
-        . modifyProgramSearchPath
-          ( ++
-              [ ProgramSearchPathDir dir
-              | dir <- fromNubList packageConfigProgramPathExtra
-              ]
-          )
-        $ defaultProgramDb
+        $ configProgDb
 
   -- progDb is a program database with compiler tools configured properly
   ( compiler@Compiler

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

@@ -48,6 +48,10 @@ import Distribution.Client.NixStyleOptions
   , defaultNixStyleFlags
   , nixStyleOptions
   )
+import Distribution.Client.ProjectConfig.Types
+  ( ProjectConfig (projectConfigShared)
+  , ProjectConfigShared (projectConfigProgPathExtra)
+  )
 import Distribution.Client.ProjectOrchestration
 import Distribution.Client.ProjectPlanning
   ( ElaboratedConfiguredPackage (..)
@@ -105,6 +109,9 @@ import Distribution.Types.UnqualComponentName
   ( UnqualComponentName
   , unUnqualComponentName
   )
+import Distribution.Utils.NubList
+  ( fromNubList
+  )
 import Distribution.Verbosity
   ( normal
   , silent
@@ -288,6 +295,13 @@ runAction flags@NixStyleFlags{..} targetAndArgs globalFlags =
           buildSettingDryRun (buildSettings baseCtx)
             || buildSettingOnlyDownload (buildSettings baseCtx)
 
+    let extraPath =
+          fromNubList
+            . projectConfigProgPathExtra
+            . projectConfigShared
+            . projectConfig
+            $ baseCtx
+
     if dryRun
       then notice verbosity "Running of executable suppressed by flag(s)"
       else
@@ -300,6 +314,7 @@ runAction flags@NixStyleFlags{..} targetAndArgs globalFlags =
                 dataDirsEnvironmentForPlan
                   (distDirLayout baseCtx)
                   elaboratedPlan
+            , progInvokePathEnv = extraPath
             }
   where
     (targetStr, args) = splitAt 1 targetAndArgs

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

@@ -1540,6 +1540,14 @@ parseConfig src initial = \str -> do
                       splitMultiPath
                         (configConfigureArgs scf)
                   }
+        , savedGlobalFlags =
+            let sgf = savedGlobalFlags conf
+             in sgf
+                  { globalProgPathExtra =
+                      toNubList $
+                        splitMultiPath
+                          (fromNubList $ globalProgPathExtra sgf)
+                  }
         }
 
     parse =

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

@@ -78,6 +78,9 @@ import Distribution.Solver.Types.SourcePackage
 import Control.Monad (mapM_)
 import qualified Data.Map as Map
 import Distribution.Client.Errors
+import Distribution.Utils.NubList
+  ( fromNubList
+  )
 import System.Directory
   ( createDirectoryIfMissing
   , doesDirectoryExist
@@ -99,7 +102,7 @@ get
   -> IO ()
 get verbosity _ _ _ [] =
   notice verbosity "No packages requested. Nothing to do."
-get verbosity repoCtxt _ getFlags userTargets = do
+get verbosity repoCtxt globalFlags getFlags userTargets = do
   let useSourceRepo = case getSourceRepository getFlags of
         NoFlag -> False
         _ -> True
@@ -154,7 +157,7 @@ get verbosity repoCtxt _ getFlags userTargets = do
 
     clone :: [UnresolvedSourcePackage] -> IO ()
     clone =
-      clonePackagesFromSourceRepo verbosity prefix kind
+      clonePackagesFromSourceRepo verbosity prefix kind (fromNubList $ globalProgPathExtra globalFlags)
         . map (\pkg -> (packageId pkg, packageSourceRepos pkg))
       where
         kind :: Maybe RepoKind
@@ -337,6 +340,8 @@ clonePackagesFromSourceRepo
   -- ^ destination dir prefix
   -> Maybe RepoKind
   -- ^ preferred 'RepoKind'
+  -> [FilePath]
+  -- ^ Extra prog paths
   -> [(PackageId, [PD.SourceRepo])]
   -- ^ the packages and their
   -- available 'SourceRepo's
@@ -345,13 +350,14 @@ clonePackagesFromSourceRepo
   verbosity
   destDirPrefix
   preferredRepoKind
+  progPaths
   pkgrepos = do
     -- Do a bunch of checks and collect the required info
     pkgrepos' <- traverse preCloneChecks pkgrepos
 
     -- Configure the VCS drivers for all the repository types we may need
     vcss <-
-      configureVCSs verbosity $
+      configureVCSs verbosity progPaths $
         Map.fromList
           [ (vcsRepoType vcs, vcs)
           | (_, _, vcs, _) <- pkgrepos'