From 2c0ab5bb88fbe75f9bc9aa2bfb6e04268da13c71 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 15 Dec 2023 17:11:08 +0100 Subject: [PATCH 1/3] Fix extra-prog-path propagation in the codebase. Extra prog paths were being handled in many different ways all thorugh the codebase. This PR introduces a unified way to look at them. Aiming for traceability, the addition of extra paths is now traced via `logExtraProgramSearchPath`. All appearances of `modifyProgramSearchPath` are replaced with `appendProgramSearchPath` which traces the added paths. `progInvokePathEnv` was only being set by GHC for some paths to executables in components and only under certain circumstances. Now every `ghcInvocation` sets the extra paths directly into `pkgInvokeEnv`. In particular this fixes PATH issues when running MinGW cabal in PowerShell, as usually for other OSes the system path contains most of the expected directories. (cherry picked from commit 46df8ba712470ef8f80ef1256861b1e0a37a0976) # Conflicts: # Cabal/src/Distribution/Simple/Configure.hs # Cabal/src/Distribution/Simple/ConfigureScript.hs # Cabal/src/Distribution/Simple/GHC.hs # Cabal/src/Distribution/Simple/GHCJS.hs # Cabal/src/Distribution/Simple/Program/Db.hs # Cabal/src/Distribution/Simple/Program/Find.hs # Cabal/src/Distribution/Simple/Program/GHC.hs # Cabal/src/Distribution/Simple/Program/Run.hs # Cabal/src/Distribution/Simple/Program/Types.hs # cabal-install/src/Distribution/Client/CmdExec.hs # cabal-install/src/Distribution/Client/CmdInstall.hs # cabal-install/src/Distribution/Client/CmdRun.hs # cabal-install/src/Distribution/Client/Config.hs # cabal-install/src/Distribution/Client/Get.hs # cabal-install/src/Distribution/Client/HttpUtils.hs # cabal-install/src/Distribution/Client/ProjectConfig.hs # cabal-install/src/Distribution/Client/ProjectOrchestration.hs # cabal-install/src/Distribution/Client/ProjectPlanning.hs # cabal-install/src/Distribution/Client/SetupWrapper.hs # cabal-install/src/Distribution/Client/VCS.hs # cabal-install/tests/UnitTests/Distribution/Client/Get.hs # cabal-install/tests/UnitTests/Distribution/Client/VCS.hs --- Cabal/src/Distribution/Simple/Configure.hs | 63 ++++++++- .../Distribution/Simple/ConfigureScript.hs | 7 + Cabal/src/Distribution/Simple/GHC.hs | 9 ++ Cabal/src/Distribution/Simple/GHCJS.hs | 7 + Cabal/src/Distribution/Simple/Program/Db.hs | 49 +++++++ Cabal/src/Distribution/Simple/Program/Find.hs | 50 +++++++ Cabal/src/Distribution/Simple/Program/GHC.hs | 37 ++++- Cabal/src/Distribution/Simple/Program/Run.hs | 95 ++++++++++++- .../src/Distribution/Simple/Program/Types.hs | 33 +++++ .../src/Distribution/Client/CmdExec.hs | 48 +++++++ .../src/Distribution/Client/CmdInstall.hs | 112 +++++++++++++++ .../src/Distribution/Client/CmdRun.hs | 131 ++++++++++++++++++ .../src/Distribution/Client/Config.hs | 37 +++++ cabal-install/src/Distribution/Client/Get.hs | 48 +++++++ .../src/Distribution/Client/HttpUtils.hs | 82 +++++++++++ .../src/Distribution/Client/ProjectConfig.hs | 7 + .../Client/ProjectOrchestration.hs | 13 ++ .../Distribution/Client/ProjectPlanning.hs | 36 +++++ .../src/Distribution/Client/SetupWrapper.hs | 60 ++++++++ cabal-install/src/Distribution/Client/VCS.hs | 48 +++++++ .../UnitTests/Distribution/Client/Get.hs | 129 +++++++++++++++++ .../UnitTests/Distribution/Client/VCS.hs | 45 ++++++ changelog.d/propagate-extra-prog-path | 13 ++ 23 files changed, 1154 insertions(+), 5 deletions(-) create mode 100644 changelog.d/propagate-extra-prog-path diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index ac7bd852f0d..8e8a0acca47 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -73,11 +73,19 @@ import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Check hiding (doesFileExist) import Distribution.Simple.BuildToolDepends import Distribution.Simple.Program +<<<<<<< HEAD import Distribution.Simple.Setup as Setup import Distribution.Simple.BuildTarget import Distribution.Simple.LocalBuildInfo import Distribution.Types.PackageVersionConstraint import Distribution.Types.LocalBuildInfo +======= +import Distribution.Simple.Program.Db (appendProgramSearchPath, lookupProgramByName) +import Distribution.Simple.Setup.Common as Setup +import Distribution.Simple.Setup.Config as Setup +import Distribution.Simple.Utils +import Distribution.System +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Types.ComponentRequestedSpec import Distribution.Types.GivenComponent import Distribution.Simple.Utils @@ -391,6 +399,7 @@ configure (pkg_descr0, pbi) cfg = do let internalPackageSet :: Set LibraryName internalPackageSet = getInternalLibraries pkg_descr0 +<<<<<<< HEAD -- Make a data structure describing what components are enabled. let enabled :: ComponentRequestedSpec enabled = case mb_cname of @@ -412,6 +421,23 @@ configure (pkg_descr0, pbi) cfg = do die' verbosity $ "--enable-tests/--enable-benchmarks are incompatible with" ++ " explicitly specifying a component to configure." +======= + programDbPre <- mkProgramDb cfg (configPrograms cfg) + -- comp: the compiler we're building with + -- compPlatform: the platform we're building for + -- programDb: location and args of all programs we're + -- building with + ( comp :: Compiler + , compPlatform :: Platform + , programDb00 :: ProgramDb + ) <- + configCompilerEx + (flagToMaybe (configHcFlavor cfg)) + (flagToMaybe (configHcPath cfg)) + (flagToMaybe (configHcPkg cfg)) + programDbPre + (lessVerbose verbosity) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Some sanity checks related to dynamic/static linking. when (fromFlag (configDynExe cfg) && fromFlag (configFullyStaticExe cfg)) $ @@ -843,9 +869,18 @@ configure (pkg_descr0, pbi) cfg = do where verbosity = fromFlag (configVerbosity cfg) -mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb -mkProgramDb cfg initialProgramDb = programDb +-- | 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 -> IO ProgramDb +mkProgramDb cfg initialProgramDb = do + programDb <- appendProgramSearchPath (fromFlagOrDefault normal (configVerbosity cfg)) searchpath initialProgramDb + pure + . userSpecifyArgss (configProgramArgs cfg) + . userSpecifyPaths (configProgramPaths cfg) + $ programDb where +<<<<<<< HEAD programDb = userSpecifyArgss (configProgramArgs cfg) . userSpecifyPaths (configProgramPaths cfg) . setProgramSearchPath searchpath @@ -853,6 +888,16 @@ mkProgramDb cfg initialProgramDb = programDb searchpath = map ProgramSearchPathDir (fromNubList $ configProgramPathExtra cfg) ++ getProgramSearchPath initialProgramDb +======= + searchpath = fromNubList $ configProgramPathExtra cfg + +-- Note. We try as much as possible to _prepend_ rather than postpend the extra-prog-path +-- so that we can override the system path. However, in a v2-build, at this point, the "system" path +-- has already been extended by both the built-tools-depends paths, as well as the program-path-extra +-- so for v2 builds adding it again is entirely unnecessary. However, it needs to get added again _anyway_ +-- so as to take effect for v1 builds or standalone calls to Setup.hs +-- In this instance, the lesser evil is to not allow it to override the system path. +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- ----------------------------------------------------------------------------- -- Helper functions for configure @@ -1700,6 +1745,7 @@ ccLdOptionsBuildInfo cflags ldflags ldflags_static = -- ----------------------------------------------------------------------------- -- Determining the compiler details +<<<<<<< HEAD configCompilerAuxEx :: ConfigFlags -> IO (Compiler, Platform, ProgramDb) configCompilerAuxEx cfg = configCompilerEx (flagToMaybe $ configHcFlavor cfg) @@ -1709,6 +1755,19 @@ configCompilerAuxEx cfg = configCompilerEx (flagToMaybe $ configHcFlavor cfg) (fromFlag (configVerbosity cfg)) where programDb = mkProgramDb cfg defaultProgramDb +======= +configCompilerAuxEx + :: ConfigFlags + -> IO (Compiler, Platform, ProgramDb) +configCompilerAuxEx cfg = do + programDb <- mkProgramDb cfg defaultProgramDb + configCompilerEx + (flagToMaybe $ configHcFlavor cfg) + (flagToMaybe $ configHcPath cfg) + (flagToMaybe $ configHcPkg cfg) + programDb + (fromFlag (configVerbosity cfg)) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> Verbosity diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs index 9c3e5c8874b..91eff3b06b4 100644 --- a/Cabal/src/Distribution/Simple/ConfigureScript.hs +++ b/Cabal/src/Distribution/Simple/ConfigureScript.hs @@ -137,10 +137,17 @@ runConfigureScript verbosity flags lbi = do maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)] args' = configureFile':args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag shProg = simpleProgram "sh" +<<<<<<< HEAD progDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb shConfiguredProg <- lookupProgram shProg `fmap` configureProgram verbosity shProg progDb +======= + progDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb + shConfiguredProg <- + lookupProgram shProg + `fmap` configureProgram verbosity shProg progDb +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) case shConfiguredProg of Just sh -> runProgramInvocation verbosity $ (programInvocation (sh {programOverrideEnv = overEnv}) args') diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 1fbd153187f..a9e3f1e7867 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -1889,8 +1889,17 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do | otherwise = error "libAbiHash: Can't find an enabled library way" (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) +<<<<<<< HEAD hash <- getProgramInvocationOutput verbosity (ghcInvocation ghcProg comp platform ghcArgs) +======= + + hash <- + getProgramInvocationOutput + verbosity + =<< ghcInvocation verbosity ghcProg comp platform ghcArgs + +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) return (takeWhile (not . isSpace) hash) componentGhcOptions :: Verbosity -> LocalBuildInfo diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index dcd5b3230d9..5aed74f5bcb 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -1601,8 +1601,15 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do | otherwise = error "libAbiHash: Can't find an enabled library way" (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) +<<<<<<< HEAD hash <- getProgramInvocationOutput verbosity (ghcInvocation ghcjsProg comp platform ghcArgs) +======= + hash <- + getProgramInvocationOutput + verbosity + =<< ghcInvocation verbosity ghcjsProg comp platform ghcArgs +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) return (takeWhile (not . isSpace) hash) componentGhcOptions :: Verbosity -> LocalBuildInfo diff --git a/Cabal/src/Distribution/Simple/Program/Db.hs b/Cabal/src/Distribution/Simple/Program/Db.hs index 4657e19b059..8399d9c247f 100644 --- a/Cabal/src/Distribution/Simple/Program/Db.hs +++ b/Cabal/src/Distribution/Simple/Program/Db.hs @@ -32,6 +32,7 @@ module Distribution.Simple.Program.Db ( restoreProgramDb, -- ** Query and manipulate the program db +<<<<<<< HEAD addKnownProgram, addKnownPrograms, lookupKnownProgram, @@ -48,6 +49,26 @@ module Distribution.Simple.Program.Db ( lookupProgram, updateProgram, configuredPrograms, +======= + , addKnownProgram + , addKnownPrograms + , appendProgramSearchPath + , lookupKnownProgram + , knownPrograms + , getProgramSearchPath + , setProgramSearchPath + , modifyProgramSearchPath + , userSpecifyPath + , userSpecifyPaths + , userMaybeSpecifyPath + , userSpecifyArgs + , userSpecifyArgss + , userSpecifiedArgs + , lookupProgram + , lookupProgramByName + , updateProgram + , configuredPrograms +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- ** Query and manipulate the program db configureProgram, @@ -222,6 +243,7 @@ modifyProgramSearchPath :: (ProgramSearchPath -> ProgramSearchPath) modifyProgramSearchPath f db = setProgramSearchPath (f $ getProgramSearchPath db) db +<<<<<<< HEAD -- |User-specify this path. Basically override any path information -- for this program in the configuration. If it's not a known -- program ignore it. @@ -229,6 +251,33 @@ modifyProgramSearchPath f db = userSpecifyPath :: String -- ^Program name -> FilePath -- ^user-specified path to the program -> ProgramDb -> ProgramDb +======= +-- | 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 = + if not $ null extraPaths + then do + logExtraProgramSearchPath verbosity extraPaths + pure $ modifyProgramSearchPath (map ProgramSearchPathDir extraPaths ++) db + else pure 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. +userSpecifyPath + :: String + -- ^ Program name + -> FilePath + -- ^ user-specified path to the program + -> ProgramDb + -> ProgramDb +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) userSpecifyPath name path = updateUnconfiguredProgs $ flip Map.update name $ \(prog, _, args) -> Just (prog, Just path, args) diff --git a/Cabal/src/Distribution/Simple/Program/Find.hs b/Cabal/src/Distribution/Simple/Program/Find.hs index 1e8497e1e1a..5602d354fdf 100644 --- a/Cabal/src/Distribution/Simple/Program/Find.hs +++ b/Cabal/src/Distribution/Simple/Program/Find.hs @@ -24,6 +24,7 @@ -- So we need an extension of the usual 'findExecutable' that can look in -- additional locations, either before, after or instead of the normal OS -- locations. +<<<<<<< HEAD -- module Distribution.Simple.Program.Find ( -- * Program search path @@ -33,6 +34,19 @@ module Distribution.Simple.Program.Find ( findProgramOnSearchPath, programSearchPathAsPATHVar, getSystemSearchPath, +======= +module Distribution.Simple.Program.Find + ( -- * Program search path + ProgramSearchPath + , ProgramSearchPathEntry (..) + , defaultProgramSearchPath + , findProgramOnSearchPath + , programSearchPathAsPATHVar + , logExtraProgramSearchPath + , getSystemSearchPath + , getExtraPathEnv + , simpleProgram +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) ) where import Prelude () @@ -76,8 +90,25 @@ instance Structured ProgramSearchPathEntry defaultProgramSearchPath :: ProgramSearchPath defaultProgramSearchPath = [ProgramSearchPathDefault] +<<<<<<< HEAD findProgramOnSearchPath :: Verbosity -> ProgramSearchPath -> FilePath -> IO (Maybe (FilePath, [FilePath])) +======= +logExtraProgramSearchPath + :: Verbosity + -> [FilePath] + -> IO () +logExtraProgramSearchPath verbosity extraPaths = + info verbosity . unlines $ + "Including the following directories in PATH:" + : map ("- " ++) extraPaths + +findProgramOnSearchPath + :: Verbosity + -> ProgramSearchPath + -> FilePath + -> IO (Maybe (FilePath, [FilePath])) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) findProgramOnSearchPath verbosity searchpath prog = do debug verbosity $ "Searching for " ++ prog ++ " in path." res <- tryPathElems [] searchpath @@ -141,6 +172,25 @@ findProgramOnSearchPath verbosity searchpath prog = do Just _ -> return a Nothing -> firstJustM mas +-- | Adds some paths to the "PATH" entry in the key-value environment provided +-- or if there is none, looks up @$PATH@ in the real environment. +getExtraPathEnv + :: Verbosity + -> [(String, Maybe String)] + -> [FilePath] + -> IO [(String, Maybe String)] +getExtraPathEnv _ _ [] = return [] +getExtraPathEnv verbosity env extras = do + mb_path <- case lookup "PATH" env of + Just x -> return x + Nothing -> lookupEnv "PATH" + logExtraProgramSearchPath verbosity extras + let extra = intercalate [searchPathSeparator] extras + path' = case mb_path of + Nothing -> extra + Just path -> extra ++ searchPathSeparator : path + return [("PATH", Just path')] + -- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var. -- Note that this is close but not perfect because on Windows the search -- algorithm looks at more than just the @%PATH%@. diff --git a/Cabal/src/Distribution/Simple/Program/GHC.hs b/Cabal/src/Distribution/Simple/Program/GHC.hs index 902422c253f..ee3f8d8bc3f 100644 --- a/Cabal/src/Distribution/Simple/Program/GHC.hs +++ b/Cabal/src/Distribution/Simple/Program/GHC.hs @@ -31,6 +31,12 @@ import Distribution.PackageDescription import Distribution.ModuleName import Distribution.Simple.Compiler import Distribution.Simple.Flag +<<<<<<< HEAD +======= +import Distribution.Simple.GHC.ImplInfo +import Distribution.Simple.Program.Find (getExtraPathEnv) +import Distribution.Simple.Program.Run +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Simple.Program.Types import Distribution.Simple.Program.Run import Distribution.System @@ -529,11 +535,21 @@ data GhcOptions = GhcOptions { -- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag. ghcOptVerbosity :: Flag Verbosity, +<<<<<<< HEAD -- | Put the extra folders in the PATH environment variable we invoke -- GHC with ghcOptExtraPath :: NubListR FilePath, -- | Let GHC know that it is Cabal that's calling it. +======= + ghcOptVerbosity :: Flag Verbosity + -- ^ Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag. + , ghcOptExtraPath :: NubListR FilePath + -- ^ 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. +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Modifies some of the GHC error messages. ghcOptCabal :: Flag Bool @@ -569,8 +585,9 @@ data GhcProfAuto = GhcProfAutoAll -- ^ @-fprof-auto@ runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO () runGHC verbosity ghcProg comp platform opts = do - runProgramInvocation verbosity (ghcInvocation ghcProg comp platform opts) + runProgramInvocation verbosity =<< ghcInvocation verbosity ghcProg comp platform opts +<<<<<<< HEAD ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> ProgramInvocation @@ -578,6 +595,24 @@ ghcInvocation prog comp platform opts = (programInvocation prog (renderGhcOptions comp platform opts)) { progInvokePathEnv = fromNubListR (ghcOptExtraPath opts) } +======= +ghcInvocation + :: Verbosity + -> ConfiguredProgram + -> Compiler + -> Platform + -> GhcOptions + -> IO ProgramInvocation +ghcInvocation verbosity ghcProg comp platform opts = do + -- NOTE: GHC is the only program whose path we modify with more values than + -- the standard @extra-prog-path@, namely the folders of the executables in + -- the components, see @componentGhcOptions@. + let envOverrides = programOverrideEnv ghcProg + extraPath <- getExtraPathEnv verbosity envOverrides (fromNubListR (ghcOptExtraPath opts)) + let ghcProg' = ghcProg{programOverrideEnv = envOverrides ++ extraPath} + + pure $ programInvocation ghcProg' (renderGhcOptions comp platform opts) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String] renderGhcOptions comp _platform@(Platform _arch os) opts diff --git a/Cabal/src/Distribution/Simple/Program/Run.hs b/Cabal/src/Distribution/Simple/Program/Run.hs index 66ab3ac82a7..8a765582be4 100644 --- a/Cabal/src/Distribution/Simple/Program/Run.hs +++ b/Cabal/src/Distribution/Simple/Program/Run.hs @@ -37,8 +37,11 @@ import Distribution.Simple.Program.Types import Distribution.Simple.Utils import Distribution.Utils.Generic import Distribution.Verbosity +<<<<<<< HEAD import System.FilePath (searchPathSeparator) +======= +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map @@ -49,6 +52,7 @@ import qualified Data.Map as Map -- and actually doing it. This provides the opportunity to the caller to -- adjust how the program will be called. These invocations can either be run -- directly or turned into shell or batch scripts. +<<<<<<< HEAD -- data ProgramInvocation = ProgramInvocation { progInvokePath :: FilePath, @@ -61,6 +65,18 @@ data ProgramInvocation = ProgramInvocation { progInvokeInputEncoding :: IOEncoding, -- ^ TODO: remove this, make user decide when constructing 'progInvokeInput'. progInvokeOutputEncoding :: IOEncoding } +======= +data ProgramInvocation = ProgramInvocation + { progInvokePath :: FilePath + , progInvokeArgs :: [String] + , progInvokeEnv :: [(String, Maybe String)] + , progInvokeCwd :: Maybe FilePath + , progInvokeInput :: Maybe IOData + , progInvokeInputEncoding :: IOEncoding + -- ^ TODO: remove this, make user decide when constructing 'progInvokeInput'. + , progInvokeOutputEncoding :: IOEncoding + } +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) data IOEncoding = IOEncodingText -- locale mode text | IOEncodingUTF8 -- always utf8 @@ -72,6 +88,7 @@ encodeToIOData IOEncodingUTF8 (IODataText str) = IODataBinary (toUTF8LBS str emptyProgramInvocation :: ProgramInvocation emptyProgramInvocation = +<<<<<<< HEAD ProgramInvocation { progInvokePath = "", progInvokeArgs = [], @@ -82,6 +99,17 @@ emptyProgramInvocation = progInvokeInputEncoding = IOEncodingText, progInvokeOutputEncoding = IOEncodingText } +======= + ProgramInvocation + { progInvokePath = "" + , progInvokeArgs = [] + , progInvokeEnv = [] + , progInvokeCwd = Nothing + , progInvokeInput = Nothing + , progInvokeInputEncoding = IOEncodingText + , progInvokeOutputEncoding = IOEncodingText + } +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation simpleProgramInvocation path args = @@ -102,6 +130,7 @@ programInvocation prog args = runProgramInvocation :: Verbosity -> ProgramInvocation -> IO () +<<<<<<< HEAD runProgramInvocation verbosity ProgramInvocation { progInvokePath = path, @@ -145,6 +174,58 @@ runProgramInvocation verbosity path args mcwd menv (Just input) IODataModeBinary +======= +runProgramInvocation + verbosity + ProgramInvocation + { progInvokePath = path + , progInvokeArgs = args + , progInvokeEnv = [] + , progInvokeCwd = Nothing + , progInvokeInput = Nothing + } = + rawSystemExit verbosity path args +runProgramInvocation + verbosity + ProgramInvocation + { progInvokePath = path + , progInvokeArgs = args + , progInvokeEnv = envOverrides + , progInvokeCwd = mcwd + , progInvokeInput = Nothing + } = do + menv <- getEffectiveEnvironment envOverrides + maybeExit $ + rawSystemIOWithEnv + verbosity + path + args + mcwd + menv + Nothing + Nothing + Nothing +runProgramInvocation + verbosity + ProgramInvocation + { progInvokePath = path + , progInvokeArgs = args + , progInvokeEnv = envOverrides + , progInvokeCwd = mcwd + , progInvokeInput = Just inputStr + , progInvokeInputEncoding = encoding + } = do + menv <- getEffectiveEnvironment envOverrides + (_, errors, exitCode) <- + rawSystemStdInOut + verbosity + path + args + mcwd + menv + (Just input) + IODataModeBinary +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) when (exitCode /= ExitSuccess) $ die' verbosity $ "'" ++ path ++ "' exited with an error:\n" ++ errors where @@ -180,21 +261,29 @@ getProgramInvocationIODataAndErrors getProgramInvocationIODataAndErrors verbosity ProgramInvocation +<<<<<<< HEAD { progInvokePath = path , progInvokeArgs = args , progInvokeEnv = envOverrides , progInvokePathEnv = extraPath , progInvokeCwd = mcwd , progInvokeInput = minputStr +======= + { progInvokePath = path + , progInvokeArgs = args + , progInvokeEnv = envOverrides + , progInvokeCwd = mcwd + , progInvokeInput = minputStr +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) , progInvokeInputEncoding = encoding } mode = do - pathOverride <- getExtraPathEnv envOverrides extraPath - menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) + menv <- getEffectiveEnvironment envOverrides rawSystemStdInOut verbosity path args mcwd menv input mode where input = encodeToIOData encoding <$> minputStr +<<<<<<< HEAD getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> IO [(String, Maybe String)] getExtraPathEnv _ [] = return [] getExtraPathEnv env extras = do @@ -207,6 +296,8 @@ getExtraPathEnv env extras = do Just path -> extra ++ searchPathSeparator : path return [("PATH", Just path')] +======= +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- | Return the current environment extended with the given overrides. -- If an entry is specified twice in @overrides@, the second entry takes -- precedence. diff --git a/Cabal/src/Distribution/Simple/Program/Types.hs b/Cabal/src/Distribution/Simple/Program/Types.hs index 4078f050185..f2684922161 100644 --- a/Cabal/src/Distribution/Simple/Program/Types.hs +++ b/Cabal/src/Distribution/Simple/Program/Types.hs @@ -87,6 +87,39 @@ instance Show Program where type ProgArg = String +<<<<<<< HEAD +======= +-- | A search path to use when locating executables. This is analogous +-- to the unix @$PATH@ or win32 @%PATH%@ but with the ability to use +-- the system default method for finding executables ('findExecutable' which +-- on unix is simply looking on the @$PATH@ but on win32 is a bit more +-- complicated). +-- +-- The default to use is @[ProgSearchPathDefault]@ but you can add extra dirs +-- either before, after or instead of the default, e.g. here we add an extra +-- dir to search after the usual ones. +-- +-- > ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir] +-- +-- We also use this path to set the environment when running child processes. +-- +-- The @ProgramDb@ is created with a @ProgramSearchPath@ to which we +-- @appendProgramSearchPath@ to add the ones that come from cli flags and from +-- configurations. Then each of the programs that are configured in the db +-- inherits the same path as part of @configureProgram@. +type ProgramSearchPath = [ProgramSearchPathEntry] + +data ProgramSearchPathEntry + = -- | A specific dir + ProgramSearchPathDir FilePath + | -- | The system default + ProgramSearchPathDefault + deriving (Eq, Generic, Typeable) + +instance Binary ProgramSearchPathEntry +instance Structured ProgramSearchPathEntry + +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- | Represents a program which has been configured and is thus ready to be run. -- -- These are usually made by configuring a 'Program', but if you have to diff --git a/cabal-install/src/Distribution/Client/CmdExec.hs b/cabal-install/src/Distribution/Client/CmdExec.hs index 80220592498..961de878a49 100644 --- a/cabal-install/src/Distribution/Client/CmdExec.hs +++ b/cabal-install/src/Distribution/Client/CmdExec.hs @@ -27,6 +27,10 @@ import Distribution.Client.Setup ( ConfigFlags(configVerbosity) , GlobalFlags ) +import Distribution.Client.ProjectConfig.Types + ( ProjectConfig (projectConfigShared) + , ProjectConfigShared (projectConfigProgPathExtra) + ) import Distribution.Client.ProjectFlags ( removeIgnoreProjectOption ) @@ -54,13 +58,21 @@ import Distribution.Client.ProjectPlanning import Distribution.Simple.Command ( CommandUI(..) ) import Distribution.Simple.Program.Db +<<<<<<< HEAD ( modifyProgramSearchPath +======= + ( appendProgramSearchPath + , configuredPrograms +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) , requireProgram , configuredPrograms ) +<<<<<<< HEAD import Distribution.Simple.Program.Find ( ProgramSearchPathEntry(..) ) +======= +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Simple.Program.Run ( programInvocation , runProgramInvocation @@ -79,13 +91,22 @@ import Distribution.Simple.Flag ( fromFlagOrDefault ) import Distribution.Simple.Utils +<<<<<<< HEAD ( die' , info , createDirectoryIfMissingVerbose +======= + ( createDirectoryIfMissingVerbose + , dieWithException + , notice +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) , withTempDirectory , wrapText , notice ) +import Distribution.Utils.NubList + ( fromNubList + ) import Distribution.Verbosity ( normal ) @@ -147,12 +168,24 @@ execAction flags@NixStyleFlags {..} extraArgs globalFlags = do mempty -- Some dependencies may have executables. Let's put those on the PATH. +<<<<<<< HEAD extraPaths <- pathAdditions verbosity baseCtx buildCtx let programDb = modifyProgramSearchPath (map ProgramSearchPathDir extraPaths ++) . pkgConfigCompilerProgs . elaboratedShared $ buildCtx +======= + let extraPaths = pathAdditions baseCtx buildCtx + + programDb <- + appendProgramSearchPath + verbosity + extraPaths + . pkgConfigCompilerProgs + . elaboratedShared + $ buildCtx +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Now that we have the packages, set up the environment. We accomplish this -- by creating an environment file that selects the databases and packages we @@ -235,6 +268,7 @@ withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do buildStatus action envOverrides) +<<<<<<< HEAD pathAdditions :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO [FilePath] pathAdditions verbosity ProjectBaseContext{..}ProjectBuildContext{..} = do info verbosity . unlines $ "Including the following directories in PATH:" @@ -243,6 +277,20 @@ pathAdditions verbosity ProjectBaseContext{..}ProjectBuildContext{..} = do where paths = S.toList $ binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute +======= +pathAdditions :: ProjectBaseContext -> ProjectBuildContext -> [FilePath] +pathAdditions ProjectBaseContext{..} ProjectBuildContext{..} = + paths ++ cabalConfigPaths + where + cabalConfigPaths = + fromNubList + . projectConfigProgPathExtra + . projectConfigShared + $ projectConfig + paths = + S.toList $ + binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) binDirectories :: DistDirLayout diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 8cf8c57ccf8..4231ddfb490 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -39,7 +39,88 @@ import Distribution.Client.Types , SourcePackageDb(..) ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Package +<<<<<<< HEAD ( Package(..), PackageName, mkPackageName, unPackageName ) +======= + ( Package (..) + , PackageName + , mkPackageName + , unPackageName + ) +import Distribution.Simple.BuildPaths + ( exeExtension + ) +import Distribution.Simple.Command + ( CommandUI (..) + , optionName + , usageAlternatives + ) +import Distribution.Simple.Compiler + ( Compiler (..) + , CompilerFlavor (..) + , CompilerId (..) + , PackageDB (..) + , PackageDBStack + ) +import Distribution.Simple.Configure + ( configCompilerEx + ) +import Distribution.Simple.Flag + ( flagElim + , flagToMaybe + , fromFlagOrDefault + ) +import Distribution.Simple.GHC + ( GhcEnvironmentFileEntry (..) + , GhcImplInfo (..) + , ParseErrorExc + , getGhcAppDir + , getImplInfo + , ghcPlatformAndVersionString + , readGhcEnvironmentFile + , renderGhcEnvironmentFile + ) +import qualified Distribution.Simple.InstallDirs as InstallDirs +import qualified Distribution.Simple.PackageIndex as PI +import Distribution.Simple.Program.Db + ( appendProgramSearchPath + , defaultProgramDb + , userSpecifyArgss + , userSpecifyPaths + ) +import Distribution.Simple.Setup + ( Flag (..) + , installDirsOptions + ) +import Distribution.Simple.Utils + ( createDirectoryIfMissingVerbose + , dieWithException + , notice + , ordNub + , safeHead + , warn + , withTempDirectory + , wrapText + ) +import Distribution.Solver.Types.PackageConstraint + ( PackageProperty (..) + ) +import Distribution.Solver.Types.PackageIndex + ( lookupPackageName + , searchByName + ) +import Distribution.Solver.Types.SourcePackage + ( SourcePackage (..) + ) +import Distribution.System + ( OS (Windows) + , Platform + , buildOS + ) +import Distribution.Types.InstalledPackageInfo + ( InstalledPackageInfo (..) + ) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Types.PackageId ( PackageIdentifier(..) ) import Distribution.Client.ProjectConfig @@ -316,6 +397,7 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject withoutProject let +<<<<<<< HEAD ProjectConfig { projectConfigBuildOnly = ProjectConfigBuildOnly { projectConfigLogsDir @@ -332,19 +414,49 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe packageConfigProgramPathExtra } } = config +======= + ProjectConfig + { projectConfigBuildOnly = + ProjectConfigBuildOnly + { projectConfigLogsDir + } + , projectConfigShared = + ProjectConfigShared + { projectConfigHcFlavor + , projectConfigHcPath + , projectConfigHcPkg + , projectConfigStoreDir + , projectConfigProgPathExtra + } + , projectConfigLocalPackages = + PackageConfig + { packageConfigProgramPaths + , packageConfigProgramArgs + , packageConfigProgramPathExtra + } + } = config +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) hcFlavor = flagToMaybe projectConfigHcFlavor hcPath = flagToMaybe projectConfigHcPath hcPkg = flagToMaybe projectConfigHcPkg + configProgDb <- appendProgramSearchPath verbosity ((fromNubList packageConfigProgramPathExtra) ++ (fromNubList projectConfigProgPathExtra)) defaultProgramDb + let -- ProgramDb with directly user specified paths preProgDb = +<<<<<<< HEAD userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs)) . modifyProgramSearchPath (++ [ ProgramSearchPathDir dir | dir <- fromNubList packageConfigProgramPathExtra ]) $ defaultProgramDb +======= + userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) + . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs)) + $ configProgDb +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- progDb is a program database with compiler tools configured properly (compiler@Compiler { compilerId = diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs index 85a50eec389..2fa71410b86 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -69,6 +69,110 @@ import Distribution.Verbosity import Data.List (group) import qualified Data.Set as Set +<<<<<<< HEAD +======= +import Distribution.Client.CmdErrorMessages + ( plural + , renderListCommaAnd + , renderListPretty + , renderTargetProblem + , renderTargetProblemNoTargets + , renderTargetSelector + , showTargetSelector + , targetSelectorFilter + , targetSelectorPluralPkgs + ) +import Distribution.Client.Errors +import Distribution.Client.GlobalFlags + ( defaultGlobalFlags + ) +import Distribution.Client.InstallPlan + ( foldPlanPackage + , toList + ) +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..) + , defaultNixStyleFlags + , nixStyleOptions + ) +import Distribution.Client.ProjectConfig.Types + ( ProjectConfig (projectConfigShared) + , ProjectConfigShared (projectConfigProgPathExtra) + ) +import Distribution.Client.ProjectOrchestration +import Distribution.Client.ProjectPlanning + ( ElaboratedConfiguredPackage (..) + , ElaboratedInstallPlan + , binDirectoryFor + ) +import Distribution.Client.ProjectPlanning.Types + ( dataDirsEnvironmentForPlan + ) +import Distribution.Client.ScriptUtils + ( AcceptNoTargets (..) + , TargetContext (..) + , movedExePath + , updateContextAndWriteProjectFile + , withContextAndSelectors + ) +import Distribution.Client.Setup + ( ConfigFlags (..) + , GlobalFlags (..) + ) +import Distribution.Client.TargetProblem + ( TargetProblem (..) + ) +import Distribution.Client.Utils + ( giveRTSWarning + , occursOnlyOrBefore + ) +import Distribution.Simple.Command + ( CommandUI (..) + , usageAlternatives + ) +import Distribution.Simple.Flag + ( fromFlagOrDefault + ) +import Distribution.Simple.Program.Find + ( ProgramSearchPathEntry (ProgramSearchPathDir) + , defaultProgramSearchPath + , logExtraProgramSearchPath + , programSearchPathAsPATHVar + ) +import Distribution.Simple.Program.Run + ( ProgramInvocation (..) + , emptyProgramInvocation + , runProgramInvocation + ) +import Distribution.Simple.Utils + ( dieWithException + , info + , notice + , safeHead + , warn + , wrapText + ) +import Distribution.Types.ComponentName + ( componentNameRaw + ) +import Distribution.Types.UnitId + ( UnitId + ) +import Distribution.Types.UnqualComponentName + ( UnqualComponentName + , unUnqualComponentName + ) +import Distribution.Utils.NubList + ( fromNubList + ) +import Distribution.Verbosity + ( normal + , silent + ) +import GHC.Environment + ( getFullArgs + ) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import System.Directory ( doesFileExist ) import System.FilePath @@ -230,7 +334,19 @@ runAction flags@NixStyleFlags {..} targetAndArgs globalFlags let dryRun = buildSettingDryRun (buildSettings baseCtx) || buildSettingOnlyDownload (buildSettings baseCtx) + let extraPath = + fromNubList + . projectConfigProgPathExtra + . projectConfigShared + . projectConfig + $ baseCtx + + logExtraProgramSearchPath verbosity extraPath + + progPath <- programSearchPathAsPATHVar (map ProgramSearchPathDir extraPath ++ defaultProgramSearchPath) + if dryRun +<<<<<<< HEAD then notice verbosity "Running of executable suppressed by flag(s)" else runProgramInvocation @@ -242,6 +358,21 @@ runAction flags@NixStyleFlags {..} targetAndArgs globalFlags (distDirLayout baseCtx) elaboratedPlan } +======= + then notice verbosity "Running of executable suppressed by flag(s)" + else + runProgramInvocation + verbosity + emptyProgramInvocation + { progInvokePath = exePath + , progInvokeArgs = args + , progInvokeEnv = + ("PATH", Just $ progPath) + : dataDirsEnvironmentForPlan + (distDirLayout baseCtx) + elaboratedPlan + } +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where (targetStr, args) = splitAt 1 targetAndArgs diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index d9019ea8a36..7890b2c8e26 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -1262,6 +1262,7 @@ parseConfig src initial = \str -> do -- This is a fixup, pending a full config parser rewrite, to -- ensure that config fields which can be comma-separated lists -- actually parse as comma-separated lists. +<<<<<<< HEAD fixConfigMultilines conf = conf { savedConfigureFlags = let scf = savedConfigureFlags conf @@ -1281,6 +1282,42 @@ parseConfig src initial = \str -> do (configConfigureArgs scf) } } +======= + fixConfigMultilines conf = + conf + { savedConfigureFlags = + let scf = savedConfigureFlags conf + in scf + { configProgramPathExtra = + toNubList $ + splitMultiPath + (fromNubList $ configProgramPathExtra scf) + , configExtraLibDirs = + splitMultiPath + (configExtraLibDirs scf) + , configExtraLibDirsStatic = + splitMultiPath + (configExtraLibDirsStatic scf) + , configExtraFrameworkDirs = + splitMultiPath + (configExtraFrameworkDirs scf) + , configExtraIncludeDirs = + splitMultiPath + (configExtraIncludeDirs scf) + , configConfigureArgs = + splitMultiPath + (configConfigureArgs scf) + } + , savedGlobalFlags = + let sgf = savedGlobalFlags conf + in sgf + { globalProgPathExtra = + toNubList $ + splitMultiPath + (fromNubList $ globalProgPathExtra sgf) + } + } +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) parse = parseFields (configFieldDescriptions src ++ deprecatedFieldDescriptions) initial diff --git a/cabal-install/src/Distribution/Client/Get.hs b/cabal-install/src/Distribution/Client/Get.hs index d5670096991..2e16d68055e 100644 --- a/cabal-install/src/Distribution/Client/Get.hs +++ b/cabal-install/src/Distribution/Client/Get.hs @@ -53,7 +53,14 @@ import Distribution.PackageDescription.PrettyPrint ( writeGenericPackageDescription ) import qualified Data.Map as Map +<<<<<<< HEAD import Control.Monad ( mapM_ ) +======= +import Distribution.Client.Errors +import Distribution.Utils.NubList + ( fromNubList + ) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import System.Directory ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist ) import System.FilePath @@ -68,9 +75,14 @@ get :: Verbosity -> [UserTarget] -> IO () get verbosity _ _ _ [] = +<<<<<<< HEAD notice verbosity "No packages requested. Nothing to do." get verbosity repoCtxt _ getFlags userTargets = do +======= + notice verbosity "No packages requested. Nothing to do." +get verbosity repoCtxt globalFlags getFlags userTargets = do +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) let useSourceRepo = case getSourceRepository getFlags of NoFlag -> False _ -> True @@ -121,8 +133,14 @@ get verbosity repoCtxt _ getFlags userTargets = do prefix = fromFlagOrDefault "" (getDestDir getFlags) clone :: [UnresolvedSourcePackage] -> IO () +<<<<<<< HEAD clone = clonePackagesFromSourceRepo verbosity prefix kind . map (\pkg -> (packageId pkg, packageSourceRepos pkg)) +======= + clone = + clonePackagesFromSourceRepo verbosity prefix kind (fromNubList $ globalProgPathExtra globalFlags) + . map (\pkg -> (packageId pkg, packageSourceRepos pkg)) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where kind :: Maybe RepoKind kind = fromFlag . getSourceRepository $ getFlags @@ -274,6 +292,7 @@ instance Exception ClonePackageException where -- | Given a bunch of package ids and their corresponding available -- 'SourceRepo's, pick a single 'SourceRepo' for each one and clone into -- new subdirs of the given directory. +<<<<<<< HEAD -- clonePackagesFromSourceRepo :: Verbosity -> FilePath -- ^ destination dir prefix @@ -285,13 +304,42 @@ clonePackagesFromSourceRepo :: Verbosity clonePackagesFromSourceRepo verbosity destDirPrefix preferredRepoKind pkgrepos = do +======= +clonePackagesFromSourceRepo + :: Verbosity + -> FilePath + -- ^ destination dir prefix + -> Maybe RepoKind + -- ^ preferred 'RepoKind' + -> [FilePath] + -- ^ Extra prog paths + -> [(PackageId, [PD.SourceRepo])] + -- ^ the packages and their + -- available 'SourceRepo's + -> IO () +clonePackagesFromSourceRepo + verbosity + destDirPrefix + preferredRepoKind + progPaths + pkgrepos = do +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- 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 +<<<<<<< HEAD vcss <- configureVCSs verbosity $ Map.fromList [ (vcsRepoType vcs, vcs) | (_, _, vcs, _) <- pkgrepos' ] +======= + vcss <- + configureVCSs verbosity progPaths $ + Map.fromList + [ (vcsRepoType vcs, vcs) + | (_, _, vcs, _) <- pkgrepos' + ] +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Now execute all the required commands for each repo sequence_ diff --git a/cabal-install/src/Distribution/Client/HttpUtils.hs b/cabal-install/src/Distribution/Client/HttpUtils.hs index 54c88d97ea5..6fbd819b074 100644 --- a/cabal-install/src/Distribution/Client/HttpUtils.hs +++ b/cabal-install/src/Distribution/Client/HttpUtils.hs @@ -19,6 +19,67 @@ import Prelude () import Distribution.Client.Compat.Prelude hiding (Proxy (..)) import Distribution.Utils.Generic +<<<<<<< HEAD +======= +import qualified Control.Exception as Exception +import Distribution.Client.Types + ( RemoteRepo (..) + , unRepoName + ) +import Distribution.Client.Types.Credentials (Auth) +import Distribution.Client.Utils + ( withTempFileName + ) +import Distribution.Client.Version + ( cabalInstallVersion + ) +import Distribution.Simple.Program + ( ConfiguredProgram + , Program + , ProgramInvocation (..) + , getProgramInvocationOutput + , programInvocation + , programPath + , simpleProgram + ) +import Distribution.Simple.Program.Db + ( ProgramDb + , addKnownPrograms + , appendProgramSearchPath + , configureAllKnownPrograms + , emptyProgramDb + , lookupProgram + , requireProgram + ) +import Distribution.Simple.Program.Run + ( getProgramInvocationOutputAndErrors + ) +import Distribution.Simple.Utils + ( IOData (..) + , copyFileVerbose + , debug + , dieWithException + , info + , notice + , warn + , withTempFile + ) +import Distribution.System + ( buildArch + , buildOS + ) +import Distribution.Utils.String (trim) +import Network.Browser + ( browse + , request + , setAllowBasicAuth + , setAuthorityGen + , setErrHandler + , setOutHandler + , setProxy + , setUserAgent + ) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Network.HTTP ( Request (..), Response (..), RequestMethod (..) , Header(..), HeaderName(..), lookupHeader ) @@ -333,6 +394,7 @@ configureTransport verbosity extraPath (Just name) = -- the user specifically selected a transport by name so we'll try and -- configure that one +<<<<<<< HEAD case find (\(name',_,_,_) -> name' == name) supportedTransports of Just (_, mprog, _tls, mkTrans) -> do @@ -349,11 +411,21 @@ configureTransport verbosity extraPath (Just name) = ++ ". The supported transports are " ++ intercalate ", " [ name' | (name', _, _, _ ) <- supportedTransports ] +======= + case find (\(name', _, _, _) -> name' == name) supportedTransports of + Just (_, mprog, _tls, mkTrans) -> do + baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb + progdb <- case mprog of + Nothing -> return emptyProgramDb + Just prog -> snd <$> requireProgram verbosity prog baseProgDb + -- ^^ if it fails, it'll fail here +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) configureTransport verbosity extraPath Nothing = do -- the user hasn't selected a transport, so we'll pick the first one we -- can configure successfully, provided that it supports tls +<<<<<<< HEAD -- for all the transports except plain-http we need to try and find -- their external executable let baseProgDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb @@ -361,6 +433,16 @@ configureTransport verbosity extraPath Nothing = do addKnownPrograms [ prog | (_, Just prog, _, _) <- supportedTransports ] baseProgDb +======= + -- for all the transports except plain-http we need to try and find + -- their external executable + baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb + progdb <- + configureAllKnownPrograms verbosity $ + addKnownPrograms + [prog | (_, Just prog, _, _) <- supportedTransports] + baseProgDb +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) let availableTransports = [ (name, transport) diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 91c12552c99..86b71209ca0 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -1149,11 +1149,18 @@ syncAndReadSourcePackagesRemoteRepos verbosity [ ((rtype, rloc), [(repo, vcsRepoType vcs)]) | (repo, rloc, rtype, vcs) <- repos' ] +<<<<<<< HEAD --TODO: pass progPathExtra on to 'configureVCS' let _progPathExtra = fromNubList projectConfigProgPathExtra getConfiguredVCS <- delayInitSharedResources $ \repoType -> let vcs = Map.findWithDefault (error $ "Unknown VCS: " ++ prettyShow repoType) repoType knownVCSs in configureVCS verbosity {-progPathExtra-} vcs +======= + let progPathExtra = fromNubList projectConfigProgPathExtra + getConfiguredVCS <- delayInitSharedResources $ \repoType -> + let vcs = Map.findWithDefault (error $ "Unknown VCS: " ++ prettyShow repoType) repoType knownVCSs + in configureVCS verbosity progPathExtra vcs +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) concat <$> sequenceA [ rerunIfChanged verbosity monitor repoGroup' $ do diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index da67b8a3ef4..257ff4b5051 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -190,6 +190,7 @@ data CurrentCommand = InstallCommand | HaddockCommand | BuildCommand | ReplComma deriving (Show, Eq) -- | This holds the context of a project prior to solving: the content of the +<<<<<<< HEAD -- @cabal.project@ and all the local package @.cabal@ files. -- data ProjectBaseContext = ProjectBaseContext { @@ -201,6 +202,18 @@ data ProjectBaseContext = ProjectBaseContext { currentCommand :: CurrentCommand, installedPackages :: Maybe InstalledPackageIndex } +======= +-- @cabal.project@, @cabal/config@ and all the local package @.cabal@ files. +data ProjectBaseContext = ProjectBaseContext + { distDirLayout :: DistDirLayout + , cabalDirLayout :: CabalDirLayout + , projectConfig :: ProjectConfig + , localPackages :: [PackageSpecifier UnresolvedSourcePackage] + , buildSettings :: BuildTimeSettings + , currentCommand :: CurrentCommand + , installedPackages :: Maybe InstalledPackageIndex + } +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) establishProjectBaseContext :: Verbosity diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 0f09514fca4..356f31e1215 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -385,6 +385,7 @@ rebuildProjectConfig verbosity projectConfigBuildOnly } = do +<<<<<<< HEAD pkgLocations <- findProjectPackages distDirLayout projectConfig -- Create folder only if findProjectPackages did not throw a -- BadPackageLocations exception. @@ -430,6 +431,31 @@ configureCompiler verbosity Cabal.configCompilerEx hcFlavor hcPath hcPkg progdb verbosity +======= + progsearchpath <- liftIO $ getSystemSearchPath + rerunIfChanged + verbosity + fileMonitorCompiler + ( hcFlavor + , hcPath + , hcPkg + , progsearchpath + , packageConfigProgramPaths + , packageConfigProgramPathExtra + ) + $ do + liftIO $ info verbosity "Compiler settings changed, reconfiguring..." + progdb <- liftIO $ appendProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb + let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb + result@(_, _, progdb'') <- + liftIO $ + Cabal.configCompilerEx + hcFlavor + hcPath + hcPkg + progdb' + verbosity +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Note that we added the user-supplied program locations and args -- for /all/ programs, not just those for the compiler prog and @@ -437,6 +463,7 @@ configureCompiler verbosity -- the compiler will configure (and it does vary between compilers). -- We do know however that the compiler will only configure the -- programs it cares about, and those are the ones we monitor here. +<<<<<<< HEAD monitorFiles (programsMonitorFiles progdb') return result @@ -450,6 +477,15 @@ configureCompiler verbosity ([ ProgramSearchPathDir dir | dir <- fromNubList packageConfigProgramPathExtra ] ++) $ defaultProgramDb +======= + monitorFiles (programsMonitorFiles progdb'') + + return result + where + hcFlavor = flagToMaybe projectConfigHcFlavor + hcPath = flagToMaybe projectConfigHcPath + hcPkg = flagToMaybe projectConfigHcPkg +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- | Return an up-to-date elaborated install plan. diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index e4885ed07c6..7639d9bd658 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -29,6 +29,52 @@ import Distribution.Client.Compat.Prelude import Distribution.CabalSpecVersion (cabalSpecMinimumLibraryVersion) import qualified Distribution.Make as Make import qualified Distribution.Simple as Simple +<<<<<<< HEAD +======= +import Distribution.Simple.Build.Macros + ( generatePackageVersionMacros + ) +import Distribution.Simple.BuildPaths + ( defaultDistPref + , exeExtension + ) +import Distribution.Simple.Compiler + ( Compiler (compilerId) + , PackageDB (..) + , PackageDBStack + , compilerFlavor + ) +import Distribution.Simple.Configure + ( configCompilerEx + ) +import Distribution.Simple.PackageDescription + ( readGenericPackageDescription + ) +import Distribution.Simple.PreProcess + ( ppUnlit + , runSimplePreProcessor + ) +import Distribution.Simple.Program + ( ProgramDb + , emptyProgramDb + , getDbProgramOutput + , getProgramSearchPath + , ghcProgram + , ghcjsProgram + , runDbProgram + ) +import Distribution.Simple.Program.Db + ( appendProgramSearchPath + ) +import Distribution.Simple.Program.Find + ( programSearchPathAsPATHVar + ) +import Distribution.Simple.Program.Run + ( getEffectiveEnvironment + ) +import qualified Distribution.Simple.Program.Strip as Strip +import Distribution.Types.ModuleRenaming (defaultRenaming) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Version ( Version, mkVersion, versionNumbers, VersionRange, anyVersion , intersectVersionRanges, orLaterVersion @@ -443,6 +489,7 @@ invoke verbosity path args options = do Nothing -> return () Just logHandle -> info verbosity $ "Redirecting build log to " ++ show logHandle +<<<<<<< HEAD searchpath <- programSearchPathAsPATHVar (map ProgramSearchPathDir (useExtraPathEnv options) ++ getProgramSearchPath (useProgramDb options)) @@ -450,6 +497,19 @@ invoke verbosity path args options = do [ ("PATH", Just searchpath) , ("HASKELL_DIST_DIR", Just (useDistPref options)) ] ++ useExtraEnvOverrides options +======= + progDb <- appendProgramSearchPath verbosity (useExtraPathEnv options) (useProgramDb options) + + searchpath <- + programSearchPathAsPATHVar $ getProgramSearchPath progDb + + env <- + getEffectiveEnvironment $ + [ ("PATH", Just searchpath) + , ("HASKELL_DIST_DIR", Just (useDistPref options)) + ] + ++ useExtraEnvOverrides options +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) let loggingHandle = case useLoggingHandle options of Nothing -> Inherit diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs index aca3f4b109f..0c0a9a2e0b3 100644 --- a/cabal-install/src/Distribution/Client/VCS.hs +++ b/cabal-install/src/Distribution/Client/VCS.hs @@ -37,6 +37,32 @@ module Distribution.Client.VCS ( import Prelude () import Distribution.Client.Compat.Prelude +<<<<<<< HEAD +======= +import Distribution.Client.RebuildMonad + ( MonitorFilePath + , Rebuild + , monitorDirectoryExistence + , monitorFiles + ) +import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy) +import qualified Distribution.PackageDescription as PD +import Distribution.Simple.Program + ( ConfiguredProgram (programVersion) + , Program (programFindVersion) + , ProgramInvocation (..) + , emptyProgramDb + , findProgramVersion + , getProgramInvocationOutput + , programInvocation + , requireProgram + , runProgramInvocation + , simpleProgram + ) +import Distribution.Simple.Program.Db + ( appendProgramSearchPath + ) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Types.SourceRepo ( RepoType(..), KnownRepoType (..) ) import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy) @@ -167,19 +193,41 @@ validateSourceRepos rs = validateSourceRepo' r = either (Left . (,) r) Right (validateSourceRepo r) +<<<<<<< HEAD configureVCS :: Verbosity -> VCS Program -> IO (VCS ConfiguredProgram) configureVCS verbosity vcs@VCS{vcsProgram = prog} = asVcsConfigured <$> requireProgram verbosity prog emptyProgramDb +======= +configureVCS + :: Verbosity + -> [FilePath] + -- ^ Extra prog paths + -> VCS Program + -> IO (VCS ConfiguredProgram) +configureVCS verbosity progPaths vcs@VCS{vcsProgram = prog} = do + progPath <- appendProgramSearchPath verbosity progPaths emptyProgramDb + asVcsConfigured <$> requireProgram verbosity prog progPath +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where asVcsConfigured (prog', _) = vcs { vcsProgram = prog' } +<<<<<<< HEAD configureVCSs :: Verbosity -> Map RepoType (VCS Program) -> IO (Map RepoType (VCS ConfiguredProgram)) configureVCSs verbosity = traverse (configureVCS verbosity) +======= +configureVCSs + :: Verbosity + -> [FilePath] + -- ^ Extra prog paths + -> Map RepoType (VCS Program) + -> IO (Map RepoType (VCS ConfiguredProgram)) +configureVCSs verbosity progPaths = traverse (configureVCS verbosity progPaths) +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- ------------------------------------------------------------ diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs index e5527a63647..375b1081ac4 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs @@ -61,18 +61,32 @@ pkgidfoo = PackageIdentifier (mkPackageName "foo") (mkVersion [1,0]) testNoRepos :: Assertion testNoRepos = do +<<<<<<< HEAD e <- assertException $ clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos e @?= ClonePackageNoSourceRepos pkgidfoo +======= + e <- + assertException $ + clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos + e @?= ClonePackageNoSourceRepos pkgidfoo +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [])] testNoReposOfKind :: Assertion testNoReposOfKind = do +<<<<<<< HEAD e <- assertException $ clonePackagesFromSourceRepo verbosity "." repokind pkgrepos e @?= ClonePackageNoSourceReposOfKind pkgidfoo repokind +======= + e <- + assertException $ + clonePackagesFromSourceRepo verbosity "." repokind [] pkgrepos + e @?= ClonePackageNoSourceReposOfKind pkgidfoo repokind +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = emptySourceRepo RepoHead @@ -81,9 +95,16 @@ testNoReposOfKind = do testNoRepoType :: Assertion testNoRepoType = do +<<<<<<< HEAD e <- assertException $ clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos e @?= ClonePackageNoRepoType pkgidfoo repo +======= + e <- + assertException $ + clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos + e @?= ClonePackageNoRepoType pkgidfoo repo +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = emptySourceRepo RepoHead @@ -91,9 +112,16 @@ testNoRepoType = do testUnsupportedRepoType :: Assertion testUnsupportedRepoType = do +<<<<<<< HEAD e <- assertException $ clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos e @?= ClonePackageUnsupportedRepoType pkgidfoo repo' repotype +======= + e <- + assertException $ + clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos + e @?= ClonePackageUnsupportedRepoType pkgidfoo repo' repotype +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = (emptySourceRepo RepoHead) @@ -113,9 +141,16 @@ testUnsupportedRepoType = do testNoRepoLocation :: Assertion testNoRepoLocation = do +<<<<<<< HEAD e <- assertException $ clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos e @?= ClonePackageNoRepoLocation pkgidfoo repo +======= + e <- + assertException $ + clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos + e @?= ClonePackageNoRepoLocation pkgidfoo repo +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = (emptySourceRepo RepoHead) { @@ -130,12 +165,22 @@ testSelectRepoKind = [ do e <- test requestedRepoType pkgrepos e @?= ClonePackageNoRepoType pkgidfoo expectedRepo +<<<<<<< HEAD e' <- test requestedRepoType (reverse pkgrepos) e' @?= ClonePackageNoRepoType pkgidfoo expectedRepo | let test rt rs = assertException $ clonePackagesFromSourceRepo verbosity "." rt rs , (requestedRepoType, expectedRepo) <- cases ] +======= + e' <- test requestedRepoType (reverse pkgrepos) + e' @?= ClonePackageNoRepoType pkgidfoo expectedRepo + | let test rt rs = + assertException $ + clonePackagesFromSourceRepo verbosity "." rt [] rs + , (requestedRepoType, expectedRepo) <- cases + ] +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo1, repo2, repo3])] repo1 = emptySourceRepo RepoThis @@ -150,6 +195,7 @@ testSelectRepoKind = testRepoDestinationExists :: Assertion testRepoDestinationExists = +<<<<<<< HEAD withTestDir verbosity "repos" $ \tmpdir -> do let pkgdir = tmpdir "foo" createDirectory pkgdir @@ -163,6 +209,22 @@ testRepoDestinationExists = e2 <- assertException $ clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos e2 @?= ClonePackageDestinationExists pkgidfoo pkgdir False {- isfile -} +======= + withTestDir verbosity "repos" $ \tmpdir -> do + let pkgdir = tmpdir "foo" + createDirectory pkgdir + e1 <- + assertException $ + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos + e1 @?= ClonePackageDestinationExists pkgidfoo pkgdir True {- isdir -} + removeDirectory pkgdir + + writeFile pkgdir "" + e2 <- + assertException $ + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos + e2 @?= ClonePackageDestinationExists pkgidfoo pkgdir False {- isfile -} +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = (emptySourceRepo RepoHead) { @@ -173,6 +235,7 @@ testRepoDestinationExists = testGitFetchFailed :: Assertion testGitFetchFailed = +<<<<<<< HEAD withTestDir verbosity "repos" $ \tmpdir -> do let srcdir = tmpdir "src" repo = (emptySourceRepo RepoHead) { @@ -220,6 +283,72 @@ testNetworkGitClone = clonePackagesFromSourceRepo verbosity tmpdir Nothing [(mkpkgid "zlib3", [repo3])] assertFileContains (tmpdir "zlib3/zlib.cabal") ["version:", "0.5.0.0"] +======= + withTestDir verbosity "repos" $ \tmpdir -> do + let srcdir = tmpdir "src" + repo = + (emptySourceRepo RepoHead) + { repoType = Just (KnownRepoType Git) + , repoLocation = Just srcdir + } + repo' = + SourceRepositoryPackage + { srpType = KnownRepoType Git + , srpLocation = srcdir + , srpTag = Nothing + , srpBranch = Nothing + , srpSubdir = Proxy + , srpCommand = [] + } + pkgrepos = [(pkgidfoo, [repo])] + e1 <- + assertException $ + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos + e1 @?= ClonePackageFailedWithExitCode pkgidfoo repo' "git" (ExitFailure 128) + +testNetworkGitClone :: Assertion +testNetworkGitClone = + withTestDir verbosity "repos" $ \tmpdir -> do + let repo1 = + (emptySourceRepo RepoHead) + { repoType = Just (KnownRepoType Git) + , repoLocation = Just "https://github.com/haskell/zlib.git" + } + clonePackagesFromSourceRepo + verbosity + tmpdir + Nothing + [] + [(mkpkgid "zlib1", [repo1])] + assertFileContains (tmpdir "zlib1/zlib.cabal") ["name:", "zlib"] + + let repo2 = + (emptySourceRepo RepoHead) + { repoType = Just (KnownRepoType Git) + , repoLocation = Just (tmpdir "zlib1") + } + clonePackagesFromSourceRepo + verbosity + tmpdir + Nothing + [] + [(mkpkgid "zlib2", [repo2])] + assertFileContains (tmpdir "zlib2/zlib.cabal") ["name:", "zlib"] + + let repo3 = + (emptySourceRepo RepoHead) + { repoType = Just (KnownRepoType Git) + , repoLocation = Just (tmpdir "zlib1") + , repoTag = Just "0.5.0.0" + } + clonePackagesFromSourceRepo + verbosity + tmpdir + Nothing + [] + [(mkpkgid "zlib3", [repo3])] + assertFileContains (tmpdir "zlib3/zlib.cabal") ["version:", "0.5.0.0"] +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where mkpkgid nm = PackageIdentifier (mkPackageName nm) (mkVersion []) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs index b361bdd8ff3..896d53f2812 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs @@ -49,12 +49,47 @@ import UnitTests.TempTestDir (withTestDir, removeDirectoryRecursiveHack) -- checks that the working state is as expected (given the pure representation). -- tests :: MTimeChange -> [TestTree] +<<<<<<< HEAD tests mtimeChange = map (localOption $ QuickCheckTests 10) [ ignoreInWindows "See issue #8048" $ testGroup "git" [ testProperty "check VCS test framework" prop_framework_git , testProperty "cloneSourceRepo" prop_cloneRepo_git , testProperty "syncSourceRepos" prop_syncRepos_git +======= +tests mtimeChange = + map + (localOption $ QuickCheckTests 10) + [ ignoreInWindows "See issue #8048 and #9519" $ + testGroup + "git" + [ testProperty "check VCS test framework" prop_framework_git + , testProperty "cloneSourceRepo" prop_cloneRepo_git + , testProperty "syncSourceRepos" prop_syncRepos_git + ] + , -- + ignoreTestBecause "for the moment they're not yet working" $ + testGroup + "darcs" + [ testProperty "check VCS test framework" $ prop_framework_darcs mtimeChange + , testProperty "cloneSourceRepo" $ prop_cloneRepo_darcs mtimeChange + , testProperty "syncSourceRepos" $ prop_syncRepos_darcs mtimeChange + ] + , ignoreTestBecause "for the moment they're not yet working" $ + testGroup + "pijul" + [ testProperty "check VCS test framework" prop_framework_pijul + , testProperty "cloneSourceRepo" prop_cloneRepo_pijul + , testProperty "syncSourceRepos" prop_syncRepos_pijul + ] + , ignoreTestBecause "for the moment they're not yet working" $ + testGroup + "mercurial" + [ testProperty "check VCS test framework" prop_framework_hg + , testProperty "cloneSourceRepo" prop_cloneRepo_hg + , testProperty "syncSourceRepos" prop_syncRepos_hg + ] +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) ] -- @@ -178,6 +213,7 @@ testSetup :: VCS Program -> (VCSTestDriver -> FilePath -> RepoState -> IO a) -> IO a testSetup vcs mkVCSTestDriver repoRecipe theTest = do +<<<<<<< HEAD -- test setup vcs' <- configureVCS verbosity vcs withTestDir verbosity "vcstest" $ \tmpdir -> do @@ -185,6 +221,15 @@ testSetup vcs mkVCSTestDriver repoRecipe theTest = do submodulesPath = tmpdir "submodules" vcsDriver = mkVCSTestDriver verbosity vcs' submodulesPath srcRepoPath repoState <- createRepo vcsDriver repoRecipe +======= + -- test setup + vcs' <- configureVCS verbosity [] vcs + withTestDir verbosity "vcstest" $ \tmpdir -> do + let srcRepoPath = tmpdir "src" + submodulesPath = tmpdir "submodules" + vcsDriver = mkVCSTestDriver verbosity vcs' submodulesPath srcRepoPath + repoState <- createRepo vcsDriver repoRecipe +>>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- actual test result <- theTest vcsDriver tmpdir repoState diff --git a/changelog.d/propagate-extra-prog-path b/changelog.d/propagate-extra-prog-path new file mode 100644 index 00000000000..9938736f7a1 --- /dev/null +++ b/changelog.d/propagate-extra-prog-path @@ -0,0 +1,13 @@ +synopsis: Fix extra-prog-path propagation +packages: cabal-install Cabal +prs: #9527 +issues: #7649 #9519 + +description: { + +- extra-prog-paths are now propagated to all commands. This in particular helps + when running a MinGW cabal in the PowerShell, where the MSYS2 paths are + usually not available in the PowerShell PATH. GHCup already sets them up for + us but they were sometimes lost on the way. + +} From e2b045fa5870edc98da9bb76f2352a08e09ca2ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Sat, 21 Oct 2023 22:24:04 +0200 Subject: [PATCH 2/3] Honor build-tool-depends in CmdRun Similarly to CmdExec and CmdTest, get paths to all dependency binaries and add those to PATH. Unlike CmdExec, add just the explicitly required paths. (cherry picked from commit f06195d3a533bccaced37ebfa95f4071d132c643) # Conflicts: # cabal-install/src/Distribution/Client/CmdExec.hs --- cabal-install/src/Distribution/Client/CmdExec.hs | 5 +++++ cabal-install/src/Distribution/Client/CmdRun.hs | 13 ++++++++----- changelog.d/pr-9341 | 11 +++++++++++ 3 files changed, 24 insertions(+), 5 deletions(-) create mode 100644 changelog.d/pr-9341 diff --git a/cabal-install/src/Distribution/Client/CmdExec.hs b/cabal-install/src/Distribution/Client/CmdExec.hs index 961de878a49..519d9794265 100644 --- a/cabal-install/src/Distribution/Client/CmdExec.hs +++ b/cabal-install/src/Distribution/Client/CmdExec.hs @@ -268,6 +268,7 @@ withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do buildStatus action envOverrides) +<<<<<<< HEAD <<<<<<< HEAD pathAdditions :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO [FilePath] pathAdditions verbosity ProjectBaseContext{..}ProjectBuildContext{..} = do @@ -278,6 +279,9 @@ pathAdditions verbosity ProjectBaseContext{..}ProjectBuildContext{..} = do paths = S.toList $ binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute ======= +======= +-- | Get paths to all dependency executables to be included in PATH. +>>>>>>> f06195d3a (Honor build-tool-depends in CmdRun) pathAdditions :: ProjectBaseContext -> ProjectBuildContext -> [FilePath] pathAdditions ProjectBaseContext{..} ProjectBuildContext{..} = paths ++ cabalConfigPaths @@ -292,6 +296,7 @@ pathAdditions ProjectBaseContext{..} ProjectBuildContext{..} = binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute >>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) +-- | Get paths to all dependency executables to be included in PATH. binDirectories :: DistDirLayout -> ElaboratedSharedConfig diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs index 2fa71410b86..5d651bc7eee 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -107,6 +107,7 @@ import Distribution.Client.ProjectPlanning ) import Distribution.Client.ProjectPlanning.Types ( dataDirsEnvironmentForPlan + , elabExeDependencyPaths ) import Distribution.Client.ScriptUtils ( AcceptNoTargets (..) @@ -335,11 +336,13 @@ runAction flags@NixStyleFlags {..} targetAndArgs globalFlags || buildSettingOnlyDownload (buildSettings baseCtx) let extraPath = - fromNubList - . projectConfigProgPathExtra - . projectConfigShared - . projectConfig - $ baseCtx + elabExeDependencyPaths pkg + ++ ( fromNubList + . projectConfigProgPathExtra + . projectConfigShared + . projectConfig + $ baseCtx + ) logExtraProgramSearchPath verbosity extraPath diff --git a/changelog.d/pr-9341 b/changelog.d/pr-9341 new file mode 100644 index 00000000000..dc6c65a802d --- /dev/null +++ b/changelog.d/pr-9341 @@ -0,0 +1,11 @@ +synopsis: Fix run command environment +packages: cabal-install +prs: #9341 +issues: #8391 + +description: { + +- The Run command will now add binary paths of dependencies + (build-tool-depends) to PATH, just like Exec and Test commands. + +} \ No newline at end of file From f8be89159bd985da3a29474e6326ac4dec9168af Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 19 Jan 2024 00:57:05 +0100 Subject: [PATCH 3/3] Resolve backporting conflicts --- Cabal/src/Distribution/Simple/Configure.hs | 68 ++------ .../Distribution/Simple/ConfigureScript.hs | 12 +- Cabal/src/Distribution/Simple/GHC.hs | 11 +- Cabal/src/Distribution/Simple/GHCJS.hs | 9 +- Cabal/src/Distribution/Simple/Program/Db.hs | 49 +----- Cabal/src/Distribution/Simple/Program/Find.hs | 67 +++----- Cabal/src/Distribution/Simple/Program/GHC.hs | 34 +--- Cabal/src/Distribution/Simple/Program/Run.hs | 119 +------------- .../src/Distribution/Simple/Program/Types.hs | 21 --- .../src/Distribution/Client/CmdExec.hs | 41 +---- .../src/Distribution/Client/CmdInstall.hs | 120 +------------- .../src/Distribution/Client/CmdRun.hs | 137 ++-------------- .../src/Distribution/Client/Config.hs | 41 +---- cabal-install/src/Distribution/Client/Get.hs | 60 +------ .../src/Distribution/Client/HttpUtils.hs | 89 +--------- .../src/Distribution/Client/ProjectConfig.hs | 12 +- .../Client/ProjectOrchestration.hs | 15 +- .../Distribution/Client/ProjectPlanning.hs | 51 +----- .../src/Distribution/Client/SetupWrapper.hs | 72 +-------- cabal-install/src/Distribution/Client/VCS.hs | 55 +------ .../UnitTests/Distribution/Client/Get.hs | 153 ++---------------- .../UnitTests/Distribution/Client/VCS.hs | 47 +----- 22 files changed, 117 insertions(+), 1166 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 8e8a0acca47..35f38a75a8a 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -73,23 +73,16 @@ import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Check hiding (doesFileExist) import Distribution.Simple.BuildToolDepends import Distribution.Simple.Program -<<<<<<< HEAD import Distribution.Simple.Setup as Setup import Distribution.Simple.BuildTarget import Distribution.Simple.LocalBuildInfo -import Distribution.Types.PackageVersionConstraint -import Distribution.Types.LocalBuildInfo -======= -import Distribution.Simple.Program.Db (appendProgramSearchPath, lookupProgramByName) -import Distribution.Simple.Setup.Common as Setup -import Distribution.Simple.Setup.Config as Setup +import Distribution.Simple.Program.Db (appendProgramSearchPath) import Distribution.Simple.Utils import Distribution.System ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) +import Distribution.Types.PackageVersionConstraint +import Distribution.Types.LocalBuildInfo import Distribution.Types.ComponentRequestedSpec import Distribution.Types.GivenComponent -import Distribution.Simple.Utils -import Distribution.System import Distribution.Version import Distribution.Verbosity import qualified Distribution.Compat.Graph as Graph @@ -375,18 +368,19 @@ configure (pkg_descr0, pbi) cfg = do (fromFlag (configUserInstall cfg)) (configPackageDBs cfg) + programDbPre <- mkProgramDb cfg (configPrograms cfg) -- comp: the compiler we're building with -- compPlatform: the platform we're building for -- programDb: location and args of all programs we're -- building with - (comp :: Compiler, + (comp :: Compiler, compPlatform :: Platform, - programDb :: ProgramDb) + programDb :: ProgramDb) <- configCompilerEx (flagToMaybe (configHcFlavor cfg)) (flagToMaybe (configHcPath cfg)) (flagToMaybe (configHcPkg cfg)) - (mkProgramDb cfg (configPrograms cfg)) + programDbPre (lessVerbose verbosity) -- The InstalledPackageIndex of all installed packages @@ -399,7 +393,6 @@ configure (pkg_descr0, pbi) cfg = do let internalPackageSet :: Set LibraryName internalPackageSet = getInternalLibraries pkg_descr0 -<<<<<<< HEAD -- Make a data structure describing what components are enabled. let enabled :: ComponentRequestedSpec enabled = case mb_cname of @@ -421,23 +414,6 @@ configure (pkg_descr0, pbi) cfg = do die' verbosity $ "--enable-tests/--enable-benchmarks are incompatible with" ++ " explicitly specifying a component to configure." -======= - programDbPre <- mkProgramDb cfg (configPrograms cfg) - -- comp: the compiler we're building with - -- compPlatform: the platform we're building for - -- programDb: location and args of all programs we're - -- building with - ( comp :: Compiler - , compPlatform :: Platform - , programDb00 :: ProgramDb - ) <- - configCompilerEx - (flagToMaybe (configHcFlavor cfg)) - (flagToMaybe (configHcPath cfg)) - (flagToMaybe (configHcPkg cfg)) - programDbPre - (lessVerbose verbosity) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Some sanity checks related to dynamic/static linking. when (fromFlag (configDynExe cfg) && fromFlag (configFullyStaticExe cfg)) $ @@ -880,15 +856,6 @@ mkProgramDb cfg initialProgramDb = do . userSpecifyPaths (configProgramPaths cfg) $ programDb where -<<<<<<< HEAD - programDb = userSpecifyArgss (configProgramArgs cfg) - . userSpecifyPaths (configProgramPaths cfg) - . setProgramSearchPath searchpath - $ initialProgramDb - searchpath = map ProgramSearchPathDir - (fromNubList $ configProgramPathExtra cfg) - ++ getProgramSearchPath initialProgramDb -======= searchpath = fromNubList $ configProgramPathExtra cfg -- Note. We try as much as possible to _prepend_ rather than postpend the extra-prog-path @@ -897,7 +864,6 @@ mkProgramDb cfg initialProgramDb = do -- so for v2 builds adding it again is entirely unnecessary. However, it needs to get added again _anyway_ -- so as to take effect for v1 builds or standalone calls to Setup.hs -- In this instance, the lesser evil is to not allow it to override the system path. ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- ----------------------------------------------------------------------------- -- Helper functions for configure @@ -1745,29 +1711,15 @@ ccLdOptionsBuildInfo cflags ldflags ldflags_static = -- ----------------------------------------------------------------------------- -- Determining the compiler details -<<<<<<< HEAD configCompilerAuxEx :: ConfigFlags -> IO (Compiler, Platform, ProgramDb) -configCompilerAuxEx cfg = configCompilerEx (flagToMaybe $ configHcFlavor cfg) +configCompilerAuxEx cfg = do + programDb <- mkProgramDb cfg defaultProgramDb + configCompilerEx (flagToMaybe $ configHcFlavor cfg) (flagToMaybe $ configHcPath cfg) (flagToMaybe $ configHcPkg cfg) programDb (fromFlag (configVerbosity cfg)) - where - programDb = mkProgramDb cfg defaultProgramDb -======= -configCompilerAuxEx - :: ConfigFlags - -> IO (Compiler, Platform, ProgramDb) -configCompilerAuxEx cfg = do - programDb <- mkProgramDb cfg defaultProgramDb - configCompilerEx - (flagToMaybe $ configHcFlavor cfg) - (flagToMaybe $ configHcPath cfg) - (flagToMaybe $ configHcPkg cfg) - programDb - (fromFlag (configVerbosity cfg)) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> Verbosity diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs index 91eff3b06b4..9d5e363585d 100644 --- a/Cabal/src/Distribution/Simple/ConfigureScript.hs +++ b/Cabal/src/Distribution/Simple/ConfigureScript.hs @@ -137,17 +137,9 @@ runConfigureScript verbosity flags lbi = do maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)] args' = configureFile':args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag shProg = simpleProgram "sh" -<<<<<<< HEAD - progDb = modifyProgramSearchPath - (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb - shConfiguredProg <- lookupProgram shProg - `fmap` configureProgram verbosity shProg progDb -======= progDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb - shConfiguredProg <- - lookupProgram shProg - `fmap` configureProgram verbosity shProg progDb ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + shConfiguredProg <- lookupProgram shProg + `fmap` configureProgram verbosity shProg progDb case shConfiguredProg of Just sh -> runProgramInvocation verbosity $ (programInvocation (sh {programOverrideEnv = overEnv}) args') diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index a9e3f1e7867..177727b587f 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -1889,17 +1889,8 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do | otherwise = error "libAbiHash: Can't find an enabled library way" (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) -<<<<<<< HEAD hash <- getProgramInvocationOutput verbosity - (ghcInvocation ghcProg comp platform ghcArgs) -======= - - hash <- - getProgramInvocationOutput - verbosity - =<< ghcInvocation verbosity ghcProg comp platform ghcArgs - ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + =<< ghcInvocation verbosity ghcProg comp platform ghcArgs return (takeWhile (not . isSpace) hash) componentGhcOptions :: Verbosity -> LocalBuildInfo diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index 5aed74f5bcb..3cc6c544434 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -1601,15 +1601,8 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do | otherwise = error "libAbiHash: Can't find an enabled library way" (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) -<<<<<<< HEAD hash <- getProgramInvocationOutput verbosity - (ghcInvocation ghcjsProg comp platform ghcArgs) -======= - hash <- - getProgramInvocationOutput - verbosity - =<< ghcInvocation verbosity ghcjsProg comp platform ghcArgs ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + =<< ghcInvocation verbose ghcjsProg comp platform ghcArgs return (takeWhile (not . isSpace) hash) componentGhcOptions :: Verbosity -> LocalBuildInfo diff --git a/Cabal/src/Distribution/Simple/Program/Db.hs b/Cabal/src/Distribution/Simple/Program/Db.hs index 8399d9c247f..b9fb61a7913 100644 --- a/Cabal/src/Distribution/Simple/Program/Db.hs +++ b/Cabal/src/Distribution/Simple/Program/Db.hs @@ -32,9 +32,9 @@ module Distribution.Simple.Program.Db ( restoreProgramDb, -- ** Query and manipulate the program db -<<<<<<< HEAD addKnownProgram, addKnownPrograms, + appendProgramSearchPath, lookupKnownProgram, knownPrograms, getProgramSearchPath, @@ -49,26 +49,6 @@ module Distribution.Simple.Program.Db ( lookupProgram, updateProgram, configuredPrograms, -======= - , addKnownProgram - , addKnownPrograms - , appendProgramSearchPath - , lookupKnownProgram - , knownPrograms - , getProgramSearchPath - , setProgramSearchPath - , modifyProgramSearchPath - , userSpecifyPath - , userSpecifyPaths - , userMaybeSpecifyPath - , userSpecifyArgs - , userSpecifyArgss - , userSpecifiedArgs - , lookupProgram - , lookupProgramByName - , updateProgram - , configuredPrograms ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- ** Query and manipulate the program db configureProgram, @@ -243,15 +223,6 @@ modifyProgramSearchPath :: (ProgramSearchPath -> ProgramSearchPath) modifyProgramSearchPath f db = setProgramSearchPath (f $ getProgramSearchPath db) db -<<<<<<< HEAD --- |User-specify this path. Basically override any path information --- for this program in the configuration. If it's not a known --- program ignore it. --- -userSpecifyPath :: String -- ^Program name - -> FilePath -- ^user-specified path to the program - -> ProgramDb -> ProgramDb -======= -- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb' -- by appending the provided extra paths. Also logs the added paths -- in info verbosity. @@ -267,17 +238,13 @@ appendProgramSearchPath verbosity extraPaths db = pure $ modifyProgramSearchPath (map ProgramSearchPathDir extraPaths ++) db else pure 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. -userSpecifyPath - :: String - -- ^ Program name - -> FilePath - -- ^ user-specified path to the program - -> ProgramDb - -> ProgramDb ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) +-- |User-specify this path. Basically override any path information +-- for this program in the configuration. If it's not a known +-- program ignore it. +-- +userSpecifyPath :: String -- ^Program name + -> FilePath -- ^user-specified path to the program + -> ProgramDb -> ProgramDb userSpecifyPath name path = updateUnconfiguredProgs $ flip Map.update name $ \(prog, _, args) -> Just (prog, Just path, args) diff --git a/Cabal/src/Distribution/Simple/Program/Find.hs b/Cabal/src/Distribution/Simple/Program/Find.hs index 5602d354fdf..b53de5cab65 100644 --- a/Cabal/src/Distribution/Simple/Program/Find.hs +++ b/Cabal/src/Distribution/Simple/Program/Find.hs @@ -24,7 +24,6 @@ -- So we need an extension of the usual 'findExecutable' that can look in -- additional locations, either before, after or instead of the normal OS -- locations. -<<<<<<< HEAD -- module Distribution.Simple.Program.Find ( -- * Program search path @@ -33,26 +32,17 @@ module Distribution.Simple.Program.Find ( defaultProgramSearchPath, findProgramOnSearchPath, programSearchPathAsPATHVar, + logExtraProgramSearchPath, getSystemSearchPath, -======= -module Distribution.Simple.Program.Find - ( -- * Program search path - ProgramSearchPath - , ProgramSearchPathEntry (..) - , defaultProgramSearchPath - , findProgramOnSearchPath - , programSearchPathAsPATHVar - , logExtraProgramSearchPath - , getSystemSearchPath - , getExtraPathEnv - , simpleProgram ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + getExtraPathEnv, + simpleProgram ) where import Prelude () import Distribution.Compat.Prelude import Distribution.Verbosity +import Distribution.Simple.Program.Types import Distribution.Simple.Utils import Distribution.System import Distribution.Compat.Environment @@ -66,34 +56,9 @@ import System.FilePath as FilePath import qualified System.Win32 as Win32 #endif --- | A search path to use when locating executables. This is analogous --- to the unix @$PATH@ or win32 @%PATH%@ but with the ability to use --- the system default method for finding executables ('findExecutable' which --- on unix is simply looking on the @$PATH@ but on win32 is a bit more --- complicated). --- --- The default to use is @[ProgSearchPathDefault]@ but you can add extra dirs --- either before, after or instead of the default, e.g. here we add an extra --- dir to search after the usual ones. --- --- > ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir] --- -type ProgramSearchPath = [ProgramSearchPathEntry] -data ProgramSearchPathEntry = - ProgramSearchPathDir FilePath -- ^ A specific dir - | ProgramSearchPathDefault -- ^ The system default - deriving (Eq, Generic, Typeable) - -instance Binary ProgramSearchPathEntry -instance Structured ProgramSearchPathEntry - defaultProgramSearchPath :: ProgramSearchPath defaultProgramSearchPath = [ProgramSearchPathDefault] -<<<<<<< HEAD -findProgramOnSearchPath :: Verbosity -> ProgramSearchPath - -> FilePath -> IO (Maybe (FilePath, [FilePath])) -======= logExtraProgramSearchPath :: Verbosity -> [FilePath] @@ -103,12 +68,8 @@ logExtraProgramSearchPath verbosity extraPaths = "Including the following directories in PATH:" : map ("- " ++) extraPaths -findProgramOnSearchPath - :: Verbosity - -> ProgramSearchPath - -> FilePath - -> IO (Maybe (FilePath, [FilePath])) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) +findProgramOnSearchPath :: Verbosity -> ProgramSearchPath + -> FilePath -> IO (Maybe (FilePath, [FilePath])) findProgramOnSearchPath verbosity searchpath prog = do debug verbosity $ "Searching for " ++ prog ++ " in path." res <- tryPathElems [] searchpath @@ -246,3 +207,19 @@ findExecutable prog = do _ -> return mExe #endif + +-- | Make a simple named program. +-- +-- By default we'll just search for it in the path and not try to find the +-- version name. You can override these behaviours if necessary, eg: +-- +-- > (simpleProgram "foo") { programFindLocation = ... , programFindVersion ... } +-- +simpleProgram :: String -> Program +simpleProgram name = Program { + programName = name, + programFindLocation = \v p -> findProgramOnSearchPath v p name, + programFindVersion = \_ _ -> return Nothing, + programPostConf = \_ p -> return p, + programNormaliseArgs = \_ _ -> id + } diff --git a/Cabal/src/Distribution/Simple/Program/GHC.hs b/Cabal/src/Distribution/Simple/Program/GHC.hs index ee3f8d8bc3f..3025eee7372 100644 --- a/Cabal/src/Distribution/Simple/Program/GHC.hs +++ b/Cabal/src/Distribution/Simple/Program/GHC.hs @@ -31,14 +31,9 @@ import Distribution.PackageDescription import Distribution.ModuleName import Distribution.Simple.Compiler import Distribution.Simple.Flag -<<<<<<< HEAD -======= -import Distribution.Simple.GHC.ImplInfo import Distribution.Simple.Program.Find (getExtraPathEnv) import Distribution.Simple.Program.Run ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Simple.Program.Types -import Distribution.Simple.Program.Run import Distribution.System import Distribution.Pretty import Distribution.Types.ComponentId @@ -535,21 +530,11 @@ data GhcOptions = GhcOptions { -- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag. ghcOptVerbosity :: Flag Verbosity, -<<<<<<< HEAD -- | Put the extra folders in the PATH environment variable we invoke -- GHC with ghcOptExtraPath :: NubListR FilePath, -- | Let GHC know that it is Cabal that's calling it. -======= - ghcOptVerbosity :: Flag Verbosity - -- ^ Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag. - , ghcOptExtraPath :: NubListR FilePath - -- ^ 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. ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Modifies some of the GHC error messages. ghcOptCabal :: Flag Bool @@ -587,22 +572,8 @@ runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> Platform -> GhcOptions runGHC verbosity ghcProg comp platform opts = do runProgramInvocation verbosity =<< ghcInvocation verbosity ghcProg comp platform opts -<<<<<<< HEAD - -ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions - -> ProgramInvocation -ghcInvocation prog comp platform opts = - (programInvocation prog (renderGhcOptions comp platform opts)) { - progInvokePathEnv = fromNubListR (ghcOptExtraPath opts) - } -======= -ghcInvocation - :: Verbosity - -> ConfiguredProgram - -> Compiler - -> Platform - -> GhcOptions - -> IO ProgramInvocation +ghcInvocation :: Verbosity -> ConfiguredProgram -> Compiler -> Platform -> GhcOptions + -> IO ProgramInvocation ghcInvocation verbosity ghcProg comp platform opts = do -- NOTE: GHC is the only program whose path we modify with more values than -- the standard @extra-prog-path@, namely the folders of the executables in @@ -612,7 +583,6 @@ ghcInvocation verbosity ghcProg comp platform opts = do let ghcProg' = ghcProg{programOverrideEnv = envOverrides ++ extraPath} pure $ programInvocation ghcProg' (renderGhcOptions comp platform opts) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String] renderGhcOptions comp _platform@(Platform _arch os) opts diff --git a/Cabal/src/Distribution/Simple/Program/Run.hs b/Cabal/src/Distribution/Simple/Program/Run.hs index 8a765582be4..ef6e8972b86 100644 --- a/Cabal/src/Distribution/Simple/Program/Run.hs +++ b/Cabal/src/Distribution/Simple/Program/Run.hs @@ -37,11 +37,6 @@ import Distribution.Simple.Program.Types import Distribution.Simple.Utils import Distribution.Utils.Generic import Distribution.Verbosity -<<<<<<< HEAD - -import System.FilePath (searchPathSeparator) -======= ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map @@ -52,31 +47,16 @@ import qualified Data.Map as Map -- and actually doing it. This provides the opportunity to the caller to -- adjust how the program will be called. These invocations can either be run -- directly or turned into shell or batch scripts. -<<<<<<< HEAD -- data ProgramInvocation = ProgramInvocation { progInvokePath :: FilePath, progInvokeArgs :: [String], progInvokeEnv :: [(String, Maybe String)], - -- Extra paths to add to PATH - progInvokePathEnv :: [FilePath], progInvokeCwd :: Maybe FilePath, progInvokeInput :: Maybe IOData, progInvokeInputEncoding :: IOEncoding, -- ^ TODO: remove this, make user decide when constructing 'progInvokeInput'. progInvokeOutputEncoding :: IOEncoding } -======= -data ProgramInvocation = ProgramInvocation - { progInvokePath :: FilePath - , progInvokeArgs :: [String] - , progInvokeEnv :: [(String, Maybe String)] - , progInvokeCwd :: Maybe FilePath - , progInvokeInput :: Maybe IOData - , progInvokeInputEncoding :: IOEncoding - -- ^ TODO: remove this, make user decide when constructing 'progInvokeInput'. - , progInvokeOutputEncoding :: IOEncoding - } ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) data IOEncoding = IOEncodingText -- locale mode text | IOEncodingUTF8 -- always utf8 @@ -88,28 +68,15 @@ encodeToIOData IOEncodingUTF8 (IODataText str) = IODataBinary (toUTF8LBS str emptyProgramInvocation :: ProgramInvocation emptyProgramInvocation = -<<<<<<< HEAD ProgramInvocation { progInvokePath = "", progInvokeArgs = [], progInvokeEnv = [], - progInvokePathEnv = [], progInvokeCwd = Nothing, progInvokeInput = Nothing, progInvokeInputEncoding = IOEncodingText, progInvokeOutputEncoding = IOEncodingText } -======= - ProgramInvocation - { progInvokePath = "" - , progInvokeArgs = [] - , progInvokeEnv = [] - , progInvokeCwd = Nothing - , progInvokeInput = Nothing - , progInvokeInputEncoding = IOEncodingText - , progInvokeOutputEncoding = IOEncodingText - } ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation simpleProgramInvocation path args = @@ -130,13 +97,11 @@ programInvocation prog args = runProgramInvocation :: Verbosity -> ProgramInvocation -> IO () -<<<<<<< HEAD runProgramInvocation verbosity ProgramInvocation { progInvokePath = path, progInvokeArgs = args, progInvokeEnv = [], - progInvokePathEnv = [], progInvokeCwd = Nothing, progInvokeInput = Nothing } = @@ -147,12 +112,10 @@ runProgramInvocation verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = envOverrides, - progInvokePathEnv = extraPath, progInvokeCwd = mcwd, progInvokeInput = Nothing } = do - pathOverride <- getExtraPathEnv envOverrides extraPath - menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) + menv <- getEffectiveEnvironment envOverrides maybeExit $ rawSystemIOWithEnv verbosity path args mcwd menv @@ -163,69 +126,15 @@ runProgramInvocation verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = envOverrides, - progInvokePathEnv = extraPath, progInvokeCwd = mcwd, progInvokeInput = Just inputStr, progInvokeInputEncoding = encoding } = do - pathOverride <- getExtraPathEnv envOverrides extraPath - menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) + menv <- getEffectiveEnvironment envOverrides (_, errors, exitCode) <- rawSystemStdInOut verbosity path args mcwd menv (Just input) IODataModeBinary -======= -runProgramInvocation - verbosity - ProgramInvocation - { progInvokePath = path - , progInvokeArgs = args - , progInvokeEnv = [] - , progInvokeCwd = Nothing - , progInvokeInput = Nothing - } = - rawSystemExit verbosity path args -runProgramInvocation - verbosity - ProgramInvocation - { progInvokePath = path - , progInvokeArgs = args - , progInvokeEnv = envOverrides - , progInvokeCwd = mcwd - , progInvokeInput = Nothing - } = do - menv <- getEffectiveEnvironment envOverrides - maybeExit $ - rawSystemIOWithEnv - verbosity - path - args - mcwd - menv - Nothing - Nothing - Nothing -runProgramInvocation - verbosity - ProgramInvocation - { progInvokePath = path - , progInvokeArgs = args - , progInvokeEnv = envOverrides - , progInvokeCwd = mcwd - , progInvokeInput = Just inputStr - , progInvokeInputEncoding = encoding - } = do - menv <- getEffectiveEnvironment envOverrides - (_, errors, exitCode) <- - rawSystemStdInOut - verbosity - path - args - mcwd - menv - (Just input) - IODataModeBinary ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) when (exitCode /= ExitSuccess) $ die' verbosity $ "'" ++ path ++ "' exited with an error:\n" ++ errors where @@ -261,20 +170,11 @@ getProgramInvocationIODataAndErrors getProgramInvocationIODataAndErrors verbosity ProgramInvocation -<<<<<<< HEAD { progInvokePath = path , progInvokeArgs = args , progInvokeEnv = envOverrides - , progInvokePathEnv = extraPath , progInvokeCwd = mcwd , progInvokeInput = minputStr -======= - { progInvokePath = path - , progInvokeArgs = args - , progInvokeEnv = envOverrides - , progInvokeCwd = mcwd - , progInvokeInput = minputStr ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) , progInvokeInputEncoding = encoding } mode = do @@ -283,21 +183,6 @@ getProgramInvocationIODataAndErrors where input = encodeToIOData encoding <$> minputStr -<<<<<<< HEAD -getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> IO [(String, Maybe String)] -getExtraPathEnv _ [] = return [] -getExtraPathEnv env extras = do - mb_path <- case lookup "PATH" env of - Just x -> return x - Nothing -> lookupEnv "PATH" - let extra = intercalate [searchPathSeparator] extras - path' = case mb_path of - Nothing -> extra - Just path -> extra ++ searchPathSeparator : path - return [("PATH", Just path')] - -======= ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- | Return the current environment extended with the given overrides. -- If an entry is specified twice in @overrides@, the second entry takes -- precedence. diff --git a/Cabal/src/Distribution/Simple/Program/Types.hs b/Cabal/src/Distribution/Simple/Program/Types.hs index f2684922161..e90290d77ee 100644 --- a/Cabal/src/Distribution/Simple/Program/Types.hs +++ b/Cabal/src/Distribution/Simple/Program/Types.hs @@ -25,7 +25,6 @@ module Distribution.Simple.Program.Types ( Program(..), ProgramSearchPath, ProgramSearchPathEntry(..), - simpleProgram, -- * Configured program and related functions ConfiguredProgram(..), @@ -40,7 +39,6 @@ import Prelude () import Distribution.Compat.Prelude import Distribution.PackageDescription -import Distribution.Simple.Program.Find import Distribution.Version import Distribution.Verbosity @@ -87,8 +85,6 @@ instance Show Program where type ProgArg = String -<<<<<<< HEAD -======= -- | A search path to use when locating executables. This is analogous -- to the unix @$PATH@ or win32 @%PATH%@ but with the ability to use -- the system default method for finding executables ('findExecutable' which @@ -119,7 +115,6 @@ data ProgramSearchPathEntry instance Binary ProgramSearchPathEntry instance Structured ProgramSearchPathEntry ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- | Represents a program which has been configured and is thus ready to be run. -- -- These are usually made by configuring a 'Program', but if you have to @@ -190,22 +185,6 @@ programPath = locationPath . programLocation suppressOverrideArgs :: ConfiguredProgram -> ConfiguredProgram suppressOverrideArgs prog = prog { programOverrideArgs = [] } --- | Make a simple named program. --- --- By default we'll just search for it in the path and not try to find the --- version name. You can override these behaviours if necessary, eg: --- --- > (simpleProgram "foo") { programFindLocation = ... , programFindVersion ... } --- -simpleProgram :: String -> Program -simpleProgram name = Program { - programName = name, - programFindLocation = \v p -> findProgramOnSearchPath v p name, - programFindVersion = \_ _ -> return Nothing, - programPostConf = \_ p -> return p, - programNormaliseArgs = \_ _ -> id - } - -- | Make a simple 'ConfiguredProgram'. -- -- > simpleConfiguredProgram "foo" (FoundOnSystem path) diff --git a/cabal-install/src/Distribution/Client/CmdExec.hs b/cabal-install/src/Distribution/Client/CmdExec.hs index 519d9794265..4c0ea639ded 100644 --- a/cabal-install/src/Distribution/Client/CmdExec.hs +++ b/cabal-install/src/Distribution/Client/CmdExec.hs @@ -58,21 +58,13 @@ import Distribution.Client.ProjectPlanning import Distribution.Simple.Command ( CommandUI(..) ) import Distribution.Simple.Program.Db -<<<<<<< HEAD - ( modifyProgramSearchPath -======= ( appendProgramSearchPath , configuredPrograms ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) , requireProgram , configuredPrograms ) -<<<<<<< HEAD import Distribution.Simple.Program.Find - ( ProgramSearchPathEntry(..) - ) -======= ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + ( simpleProgram ) import Distribution.Simple.Program.Run ( programInvocation , runProgramInvocation @@ -81,7 +73,6 @@ import Distribution.Simple.Program.Types ( programOverrideEnv , programDefaultArgs , programPath - , simpleProgram , ConfiguredProgram ) import Distribution.Simple.GHC @@ -91,15 +82,8 @@ import Distribution.Simple.Flag ( fromFlagOrDefault ) import Distribution.Simple.Utils -<<<<<<< HEAD ( die' - , info , createDirectoryIfMissingVerbose -======= - ( createDirectoryIfMissingVerbose - , dieWithException - , notice ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) , withTempDirectory , wrapText , notice @@ -168,14 +152,6 @@ execAction flags@NixStyleFlags {..} extraArgs globalFlags = do mempty -- Some dependencies may have executables. Let's put those on the PATH. -<<<<<<< HEAD - extraPaths <- pathAdditions verbosity baseCtx buildCtx - let programDb = modifyProgramSearchPath - (map ProgramSearchPathDir extraPaths ++) - . pkgConfigCompilerProgs - . elaboratedShared - $ buildCtx -======= let extraPaths = pathAdditions baseCtx buildCtx programDb <- @@ -185,7 +161,6 @@ execAction flags@NixStyleFlags {..} extraArgs globalFlags = do . pkgConfigCompilerProgs . elaboratedShared $ buildCtx ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Now that we have the packages, set up the environment. We accomplish this -- by creating an environment file that selects the databases and packages we @@ -268,20 +243,7 @@ withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do buildStatus action envOverrides) -<<<<<<< HEAD -<<<<<<< HEAD -pathAdditions :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO [FilePath] -pathAdditions verbosity ProjectBaseContext{..}ProjectBuildContext{..} = do - info verbosity . unlines $ "Including the following directories in PATH:" - : paths - return paths - where - paths = S.toList - $ binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute -======= -======= -- | Get paths to all dependency executables to be included in PATH. ->>>>>>> f06195d3a (Honor build-tool-depends in CmdRun) pathAdditions :: ProjectBaseContext -> ProjectBuildContext -> [FilePath] pathAdditions ProjectBaseContext{..} ProjectBuildContext{..} = paths ++ cabalConfigPaths @@ -294,7 +256,6 @@ pathAdditions ProjectBaseContext{..} ProjectBuildContext{..} = paths = S.toList $ binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- | Get paths to all dependency executables to be included in PATH. binDirectories diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 4231ddfb490..203b90c6b60 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -39,88 +39,7 @@ import Distribution.Client.Types , SourcePackageDb(..) ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Package -<<<<<<< HEAD ( Package(..), PackageName, mkPackageName, unPackageName ) -======= - ( Package (..) - , PackageName - , mkPackageName - , unPackageName - ) -import Distribution.Simple.BuildPaths - ( exeExtension - ) -import Distribution.Simple.Command - ( CommandUI (..) - , optionName - , usageAlternatives - ) -import Distribution.Simple.Compiler - ( Compiler (..) - , CompilerFlavor (..) - , CompilerId (..) - , PackageDB (..) - , PackageDBStack - ) -import Distribution.Simple.Configure - ( configCompilerEx - ) -import Distribution.Simple.Flag - ( flagElim - , flagToMaybe - , fromFlagOrDefault - ) -import Distribution.Simple.GHC - ( GhcEnvironmentFileEntry (..) - , GhcImplInfo (..) - , ParseErrorExc - , getGhcAppDir - , getImplInfo - , ghcPlatformAndVersionString - , readGhcEnvironmentFile - , renderGhcEnvironmentFile - ) -import qualified Distribution.Simple.InstallDirs as InstallDirs -import qualified Distribution.Simple.PackageIndex as PI -import Distribution.Simple.Program.Db - ( appendProgramSearchPath - , defaultProgramDb - , userSpecifyArgss - , userSpecifyPaths - ) -import Distribution.Simple.Setup - ( Flag (..) - , installDirsOptions - ) -import Distribution.Simple.Utils - ( createDirectoryIfMissingVerbose - , dieWithException - , notice - , ordNub - , safeHead - , warn - , withTempDirectory - , wrapText - ) -import Distribution.Solver.Types.PackageConstraint - ( PackageProperty (..) - ) -import Distribution.Solver.Types.PackageIndex - ( lookupPackageName - , searchByName - ) -import Distribution.Solver.Types.SourcePackage - ( SourcePackage (..) - ) -import Distribution.System - ( OS (Windows) - , Platform - , buildOS - ) -import Distribution.Types.InstalledPackageInfo - ( InstalledPackageInfo (..) - ) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Types.PackageId ( PackageIdentifier(..) ) import Distribution.Client.ProjectConfig @@ -140,11 +59,9 @@ import Distribution.Client.ProjectConfig.Types , projectConfigConfigFile ) import Distribution.Simple.Program.Db ( userSpecifyPaths, userSpecifyArgss, defaultProgramDb - , modifyProgramSearchPath ) + , appendProgramSearchPath ) import Distribution.Simple.BuildPaths ( exeExtension ) -import Distribution.Simple.Program.Find - ( ProgramSearchPathEntry(..) ) import Distribution.Client.Config ( defaultInstallPath, loadConfig, SavedConfig(..) ) import qualified Distribution.Simple.PackageIndex as PI @@ -397,7 +314,6 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject withoutProject let -<<<<<<< HEAD ProjectConfig { projectConfigBuildOnly = ProjectConfigBuildOnly { projectConfigLogsDir @@ -406,7 +322,8 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg, - projectConfigStoreDir + projectConfigStoreDir, + projectConfigProgPathExtra }, projectConfigLocalPackages = PackageConfig { packageConfigProgramPaths, @@ -414,28 +331,6 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe packageConfigProgramPathExtra } } = config -======= - ProjectConfig - { projectConfigBuildOnly = - ProjectConfigBuildOnly - { projectConfigLogsDir - } - , projectConfigShared = - ProjectConfigShared - { projectConfigHcFlavor - , projectConfigHcPath - , projectConfigHcPkg - , projectConfigStoreDir - , projectConfigProgPathExtra - } - , projectConfigLocalPackages = - PackageConfig - { packageConfigProgramPaths - , packageConfigProgramArgs - , packageConfigProgramPathExtra - } - } = config ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) hcFlavor = flagToMaybe projectConfigHcFlavor hcPath = flagToMaybe projectConfigHcPath @@ -445,18 +340,9 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe let -- ProgramDb with directly user specified paths preProgDb = -<<<<<<< HEAD - userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) - . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs)) - . modifyProgramSearchPath - (++ [ ProgramSearchPathDir dir - | dir <- fromNubList packageConfigProgramPathExtra ]) - $ defaultProgramDb -======= userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs)) $ configProgDb ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- progDb is a program database with compiler tools configured properly (compiler@Compiler { compilerId = diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs index 5d651bc7eee..e416e7e2948 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -34,12 +34,14 @@ import Distribution.Client.InstallPlan ( toList, foldPlanPackage ) import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) +import Distribution.Client.ProjectConfig.Types import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning ( ElaboratedConfiguredPackage(..) - , ElaboratedInstallPlan, binDirectoryFor ) + , ElaboratedInstallPlan, binDirectoryFor + ) import Distribution.Client.ProjectPlanning.Types - ( dataDirsEnvironmentForPlan ) + ( dataDirsEnvironmentForPlan, elabExeDependencyPaths ) import Distribution.Client.ScriptUtils ( AcceptNoTargets(..), TargetContext(..) , updateContextAndWriteProjectFile, withContextAndSelectors @@ -52,6 +54,10 @@ import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Simple.Flag ( fromFlagOrDefault ) +import Distribution.Simple.Program.Find + ( ProgramSearchPathEntry(..), defaultProgramSearchPath, + programSearchPathAsPATHVar, logExtraProgramSearchPath + ) import Distribution.Simple.Program.Run ( runProgramInvocation, ProgramInvocation(..), emptyProgramInvocation ) @@ -61,6 +67,8 @@ import Distribution.Types.ComponentName ( componentNameRaw ) import Distribution.Types.UnitId ( UnitId ) +import Distribution.Utils.NubList + ( fromNubList ) import Distribution.Types.UnqualComponentName ( UnqualComponentName, unUnqualComponentName ) @@ -69,111 +77,7 @@ import Distribution.Verbosity import Data.List (group) import qualified Data.Set as Set -<<<<<<< HEAD -======= -import Distribution.Client.CmdErrorMessages - ( plural - , renderListCommaAnd - , renderListPretty - , renderTargetProblem - , renderTargetProblemNoTargets - , renderTargetSelector - , showTargetSelector - , targetSelectorFilter - , targetSelectorPluralPkgs - ) -import Distribution.Client.Errors -import Distribution.Client.GlobalFlags - ( defaultGlobalFlags - ) -import Distribution.Client.InstallPlan - ( foldPlanPackage - , toList - ) -import Distribution.Client.NixStyleOptions - ( NixStyleFlags (..) - , defaultNixStyleFlags - , nixStyleOptions - ) -import Distribution.Client.ProjectConfig.Types - ( ProjectConfig (projectConfigShared) - , ProjectConfigShared (projectConfigProgPathExtra) - ) -import Distribution.Client.ProjectOrchestration -import Distribution.Client.ProjectPlanning - ( ElaboratedConfiguredPackage (..) - , ElaboratedInstallPlan - , binDirectoryFor - ) -import Distribution.Client.ProjectPlanning.Types - ( dataDirsEnvironmentForPlan - , elabExeDependencyPaths - ) -import Distribution.Client.ScriptUtils - ( AcceptNoTargets (..) - , TargetContext (..) - , movedExePath - , updateContextAndWriteProjectFile - , withContextAndSelectors - ) -import Distribution.Client.Setup - ( ConfigFlags (..) - , GlobalFlags (..) - ) -import Distribution.Client.TargetProblem - ( TargetProblem (..) - ) -import Distribution.Client.Utils - ( giveRTSWarning - , occursOnlyOrBefore - ) -import Distribution.Simple.Command - ( CommandUI (..) - , usageAlternatives - ) -import Distribution.Simple.Flag - ( fromFlagOrDefault - ) -import Distribution.Simple.Program.Find - ( ProgramSearchPathEntry (ProgramSearchPathDir) - , defaultProgramSearchPath - , logExtraProgramSearchPath - , programSearchPathAsPATHVar - ) -import Distribution.Simple.Program.Run - ( ProgramInvocation (..) - , emptyProgramInvocation - , runProgramInvocation - ) -import Distribution.Simple.Utils - ( dieWithException - , info - , notice - , safeHead - , warn - , wrapText - ) -import Distribution.Types.ComponentName - ( componentNameRaw - ) -import Distribution.Types.UnitId - ( UnitId - ) -import Distribution.Types.UnqualComponentName - ( UnqualComponentName - , unUnqualComponentName - ) -import Distribution.Utils.NubList - ( fromNubList - ) -import Distribution.Verbosity - ( normal - , silent - ) -import GHC.Environment - ( getFullArgs - ) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + import System.Directory ( doesFileExist ) import System.FilePath @@ -349,7 +253,6 @@ runAction flags@NixStyleFlags {..} targetAndArgs globalFlags progPath <- programSearchPathAsPATHVar (map ProgramSearchPathDir extraPath ++ defaultProgramSearchPath) if dryRun -<<<<<<< HEAD then notice verbosity "Running of executable suppressed by flag(s)" else runProgramInvocation @@ -357,25 +260,11 @@ runAction flags@NixStyleFlags {..} targetAndArgs globalFlags emptyProgramInvocation { progInvokePath = exePath, progInvokeArgs = args, - progInvokeEnv = dataDirsEnvironmentForPlan + progInvokeEnv = ("PATH", Just $ progPath) + : dataDirsEnvironmentForPlan (distDirLayout baseCtx) elaboratedPlan } -======= - then notice verbosity "Running of executable suppressed by flag(s)" - else - runProgramInvocation - verbosity - emptyProgramInvocation - { progInvokePath = exePath - , progInvokeArgs = args - , progInvokeEnv = - ("PATH", Just $ progPath) - : dataDirsEnvironmentForPlan - (distDirLayout baseCtx) - elaboratedPlan - } ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where (targetStr, args) = splitAt 1 targetAndArgs diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 7890b2c8e26..0dc3079f5e4 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -1262,7 +1262,6 @@ parseConfig src initial = \str -> do -- This is a fixup, pending a full config parser rewrite, to -- ensure that config fields which can be comma-separated lists -- actually parse as comma-separated lists. -<<<<<<< HEAD fixConfigMultilines conf = conf { savedConfigureFlags = let scf = savedConfigureFlags conf @@ -1281,43 +1280,15 @@ parseConfig src initial = \str -> do , configConfigureArgs = splitMultiPath (configConfigureArgs scf) } - } -======= - fixConfigMultilines conf = - conf - { savedConfigureFlags = - let scf = savedConfigureFlags conf - in scf - { configProgramPathExtra = - toNubList $ - splitMultiPath - (fromNubList $ configProgramPathExtra scf) - , configExtraLibDirs = - splitMultiPath - (configExtraLibDirs scf) - , configExtraLibDirsStatic = - splitMultiPath - (configExtraLibDirsStatic scf) - , configExtraFrameworkDirs = - splitMultiPath - (configExtraFrameworkDirs scf) - , configExtraIncludeDirs = - splitMultiPath - (configExtraIncludeDirs scf) - , configConfigureArgs = - splitMultiPath - (configConfigureArgs scf) - } - , savedGlobalFlags = - let sgf = savedGlobalFlags conf - in sgf - { globalProgPathExtra = + , savedGlobalFlags = + let sgf = savedGlobalFlags conf + in sgf { + globalProgPathExtra = toNubList $ splitMultiPath (fromNubList $ globalProgPathExtra sgf) - } - } ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + } + } parse = parseFields (configFieldDescriptions src ++ deprecatedFieldDescriptions) initial diff --git a/cabal-install/src/Distribution/Client/Get.hs b/cabal-install/src/Distribution/Client/Get.hs index 2e16d68055e..c35b1ebd473 100644 --- a/cabal-install/src/Distribution/Client/Get.hs +++ b/cabal-install/src/Distribution/Client/Get.hs @@ -37,6 +37,8 @@ import Distribution.Simple.Program ( programName ) import Distribution.Types.SourceRepo (RepoKind (..)) import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy, srpToProxy) +import Distribution.Utils.NubList + ( fromNubList ) import Distribution.Client.Setup ( GlobalFlags(..), GetFlags(..), RepoContext(..) ) @@ -53,14 +55,8 @@ import Distribution.PackageDescription.PrettyPrint ( writeGenericPackageDescription ) import qualified Data.Map as Map -<<<<<<< HEAD import Control.Monad ( mapM_ ) -======= -import Distribution.Client.Errors -import Distribution.Utils.NubList - ( fromNubList - ) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + import System.Directory ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist ) import System.FilePath @@ -75,14 +71,9 @@ get :: Verbosity -> [UserTarget] -> IO () get verbosity _ _ _ [] = -<<<<<<< HEAD notice verbosity "No packages requested. Nothing to do." -get verbosity repoCtxt _ getFlags userTargets = do -======= - notice verbosity "No packages requested. Nothing to do." get verbosity repoCtxt globalFlags getFlags userTargets = do ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) let useSourceRepo = case getSourceRepository getFlags of NoFlag -> False _ -> True @@ -133,14 +124,8 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do prefix = fromFlagOrDefault "" (getDestDir getFlags) clone :: [UnresolvedSourcePackage] -> IO () -<<<<<<< HEAD - clone = clonePackagesFromSourceRepo verbosity prefix kind + clone = clonePackagesFromSourceRepo verbosity prefix kind (fromNubList $ globalProgPathExtra globalFlags) . map (\pkg -> (packageId pkg, packageSourceRepos pkg)) -======= - clone = - clonePackagesFromSourceRepo verbosity prefix kind (fromNubList $ globalProgPathExtra globalFlags) - . map (\pkg -> (packageId pkg, packageSourceRepos pkg)) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where kind :: Maybe RepoKind kind = fromFlag . getSourceRepository $ getFlags @@ -292,54 +277,25 @@ instance Exception ClonePackageException where -- | Given a bunch of package ids and their corresponding available -- 'SourceRepo's, pick a single 'SourceRepo' for each one and clone into -- new subdirs of the given directory. -<<<<<<< HEAD -- clonePackagesFromSourceRepo :: Verbosity -> FilePath -- ^ destination dir prefix -> Maybe RepoKind -- ^ preferred 'RepoKind' + -> [FilePath] -- ^ Extra prog paths -> [(PackageId, [PD.SourceRepo])] -- ^ the packages and their -- available 'SourceRepo's -> IO () clonePackagesFromSourceRepo verbosity destDirPrefix - preferredRepoKind pkgrepos = do - -======= -clonePackagesFromSourceRepo - :: Verbosity - -> FilePath - -- ^ destination dir prefix - -> Maybe RepoKind - -- ^ preferred 'RepoKind' - -> [FilePath] - -- ^ Extra prog paths - -> [(PackageId, [PD.SourceRepo])] - -- ^ the packages and their - -- available 'SourceRepo's - -> IO () -clonePackagesFromSourceRepo - verbosity - destDirPrefix - preferredRepoKind - progPaths - pkgrepos = do ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + 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 -<<<<<<< HEAD - vcss <- configureVCSs verbosity $ + vcss <- configureVCSs verbosity progPaths $ Map.fromList [ (vcsRepoType vcs, vcs) | (_, _, vcs, _) <- pkgrepos' ] -======= - vcss <- - configureVCSs verbosity progPaths $ - Map.fromList - [ (vcsRepoType vcs, vcs) - | (_, _, vcs, _) <- pkgrepos' - ] ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- Now execute all the required commands for each repo sequence_ diff --git a/cabal-install/src/Distribution/Client/HttpUtils.hs b/cabal-install/src/Distribution/Client/HttpUtils.hs index 6fbd819b074..67aa55a18ee 100644 --- a/cabal-install/src/Distribution/Client/HttpUtils.hs +++ b/cabal-install/src/Distribution/Client/HttpUtils.hs @@ -19,67 +19,6 @@ import Prelude () import Distribution.Client.Compat.Prelude hiding (Proxy (..)) import Distribution.Utils.Generic -<<<<<<< HEAD -======= -import qualified Control.Exception as Exception -import Distribution.Client.Types - ( RemoteRepo (..) - , unRepoName - ) -import Distribution.Client.Types.Credentials (Auth) -import Distribution.Client.Utils - ( withTempFileName - ) -import Distribution.Client.Version - ( cabalInstallVersion - ) -import Distribution.Simple.Program - ( ConfiguredProgram - , Program - , ProgramInvocation (..) - , getProgramInvocationOutput - , programInvocation - , programPath - , simpleProgram - ) -import Distribution.Simple.Program.Db - ( ProgramDb - , addKnownPrograms - , appendProgramSearchPath - , configureAllKnownPrograms - , emptyProgramDb - , lookupProgram - , requireProgram - ) -import Distribution.Simple.Program.Run - ( getProgramInvocationOutputAndErrors - ) -import Distribution.Simple.Utils - ( IOData (..) - , copyFileVerbose - , debug - , dieWithException - , info - , notice - , warn - , withTempFile - ) -import Distribution.System - ( buildArch - , buildOS - ) -import Distribution.Utils.String (trim) -import Network.Browser - ( browse - , request - , setAllowBasicAuth - , setAuthorityGen - , setErrHandler - , setOutHandler - , setProxy - , setUserAgent - ) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Network.HTTP ( Request (..), Response (..), RequestMethod (..) , Header(..), HeaderName(..), lookupHeader ) @@ -115,13 +54,12 @@ import System.IO.Error import Distribution.Simple.Program ( Program, simpleProgram, ConfiguredProgram, programPath , ProgramInvocation(..), programInvocation - , ProgramSearchPathEntry(..) , getProgramInvocationOutput ) import Distribution.Simple.Program.Db ( ProgramDb, emptyProgramDb, addKnownPrograms , configureAllKnownPrograms , requireProgram, lookupProgram - , modifyProgramSearchPath ) + , appendProgramSearchPath ) import Distribution.Simple.Program.Run ( getProgramInvocationOutputAndErrors ) import Numeric (showHex) @@ -394,11 +332,10 @@ configureTransport verbosity extraPath (Just name) = -- the user specifically selected a transport by name so we'll try and -- configure that one -<<<<<<< HEAD case find (\(name',_,_,_) -> name' == name) supportedTransports of Just (_, mprog, _tls, mkTrans) -> do - let baseProgDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb + baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb progdb <- case mprog of Nothing -> return emptyProgramDb Just prog -> snd <$> requireProgram verbosity prog baseProgDb @@ -411,38 +348,18 @@ configureTransport verbosity extraPath (Just name) = ++ ". The supported transports are " ++ intercalate ", " [ name' | (name', _, _, _ ) <- supportedTransports ] -======= - case find (\(name', _, _, _) -> name' == name) supportedTransports of - Just (_, mprog, _tls, mkTrans) -> do - baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb - progdb <- case mprog of - Nothing -> return emptyProgramDb - Just prog -> snd <$> requireProgram verbosity prog baseProgDb - -- ^^ if it fails, it'll fail here ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) configureTransport verbosity extraPath Nothing = do -- the user hasn't selected a transport, so we'll pick the first one we -- can configure successfully, provided that it supports tls -<<<<<<< HEAD -- for all the transports except plain-http we need to try and find -- their external executable - let baseProgDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb + baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb progdb <- configureAllKnownPrograms verbosity $ addKnownPrograms [ prog | (_, Just prog, _, _) <- supportedTransports ] baseProgDb -======= - -- for all the transports except plain-http we need to try and find - -- their external executable - baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb - progdb <- - configureAllKnownPrograms verbosity $ - addKnownPrograms - [prog | (_, Just prog, _, _) <- supportedTransports] - baseProgDb ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) let availableTransports = [ (name, transport) diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 86b71209ca0..9d15c4d5137 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -1149,18 +1149,10 @@ syncAndReadSourcePackagesRemoteRepos verbosity [ ((rtype, rloc), [(repo, vcsRepoType vcs)]) | (repo, rloc, rtype, vcs) <- repos' ] -<<<<<<< HEAD - --TODO: pass progPathExtra on to 'configureVCS' - let _progPathExtra = fromNubList projectConfigProgPathExtra - getConfiguredVCS <- delayInitSharedResources $ \repoType -> - let vcs = Map.findWithDefault (error $ "Unknown VCS: " ++ prettyShow repoType) repoType knownVCSs in - configureVCS verbosity {-progPathExtra-} vcs -======= let progPathExtra = fromNubList projectConfigProgPathExtra getConfiguredVCS <- delayInitSharedResources $ \repoType -> - let vcs = Map.findWithDefault (error $ "Unknown VCS: " ++ prettyShow repoType) repoType knownVCSs - in configureVCS verbosity progPathExtra vcs ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + let vcs = Map.findWithDefault (error $ "Unknown VCS: " ++ prettyShow repoType) repoType knownVCSs in + configureVCS verbosity progPathExtra vcs concat <$> sequenceA [ rerunIfChanged verbosity monitor repoGroup' $ do diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 257ff4b5051..3e77ae346ca 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -190,8 +190,7 @@ data CurrentCommand = InstallCommand | HaddockCommand | BuildCommand | ReplComma deriving (Show, Eq) -- | This holds the context of a project prior to solving: the content of the -<<<<<<< HEAD --- @cabal.project@ and all the local package @.cabal@ files. +-- @cabal.project@, @cabal/config@ and all the local package @.cabal@ files. -- data ProjectBaseContext = ProjectBaseContext { distDirLayout :: DistDirLayout, @@ -202,18 +201,6 @@ data ProjectBaseContext = ProjectBaseContext { currentCommand :: CurrentCommand, installedPackages :: Maybe InstalledPackageIndex } -======= --- @cabal.project@, @cabal/config@ and all the local package @.cabal@ files. -data ProjectBaseContext = ProjectBaseContext - { distDirLayout :: DistDirLayout - , cabalDirLayout :: CabalDirLayout - , projectConfig :: ProjectConfig - , localPackages :: [PackageSpecifier UnresolvedSourcePackage] - , buildSettings :: BuildTimeSettings - , currentCommand :: CurrentCommand - , installedPackages :: Maybe InstalledPackageIndex - } ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) establishProjectBaseContext :: Verbosity diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 356f31e1215..2126c942803 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -385,7 +385,6 @@ rebuildProjectConfig verbosity projectConfigBuildOnly } = do -<<<<<<< HEAD pkgLocations <- findProjectPackages distDirLayout projectConfig -- Create folder only if findProjectPackages did not throw a -- BadPackageLocations exception. @@ -427,35 +426,12 @@ configureCompiler verbosity packageConfigProgramPathExtra) $ do liftIO $ info verbosity "Compiler settings changed, reconfiguring..." - result@(_, _, progdb') <- liftIO $ + progdb <- liftIO $ appendProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb + let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb + result@(_, _, progdb'') <- liftIO $ Cabal.configCompilerEx hcFlavor hcPath hcPkg - progdb verbosity -======= - progsearchpath <- liftIO $ getSystemSearchPath - rerunIfChanged - verbosity - fileMonitorCompiler - ( hcFlavor - , hcPath - , hcPkg - , progsearchpath - , packageConfigProgramPaths - , packageConfigProgramPathExtra - ) - $ do - liftIO $ info verbosity "Compiler settings changed, reconfiguring..." - progdb <- liftIO $ appendProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb - let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb - result@(_, _, progdb'') <- - liftIO $ - Cabal.configCompilerEx - hcFlavor - hcPath - hcPkg - progdb' - verbosity ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + progdb' verbosity -- Note that we added the user-supplied program locations and args -- for /all/ programs, not just those for the compiler prog and @@ -463,29 +439,14 @@ configureCompiler verbosity -- the compiler will configure (and it does vary between compilers). -- We do know however that the compiler will only configure the -- programs it cares about, and those are the ones we monitor here. -<<<<<<< HEAD - monitorFiles (programsMonitorFiles progdb') + monitorFiles (programsMonitorFiles progdb'') return result where hcFlavor = flagToMaybe projectConfigHcFlavor hcPath = flagToMaybe projectConfigHcPath hcPkg = flagToMaybe projectConfigHcPkg - progdb = - userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) - . modifyProgramSearchPath - ([ ProgramSearchPathDir dir - | dir <- fromNubList packageConfigProgramPathExtra ] ++) - $ defaultProgramDb -======= - monitorFiles (programsMonitorFiles progdb'') - - return result - where - hcFlavor = flagToMaybe projectConfigHcFlavor - hcPath = flagToMaybe projectConfigHcPath - hcPkg = flagToMaybe projectConfigHcPkg ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + -- | Return an up-to-date elaborated install plan. diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 7639d9bd658..23a788a8997 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -29,52 +29,7 @@ import Distribution.Client.Compat.Prelude import Distribution.CabalSpecVersion (cabalSpecMinimumLibraryVersion) import qualified Distribution.Make as Make import qualified Distribution.Simple as Simple -<<<<<<< HEAD -======= -import Distribution.Simple.Build.Macros - ( generatePackageVersionMacros - ) -import Distribution.Simple.BuildPaths - ( defaultDistPref - , exeExtension - ) -import Distribution.Simple.Compiler - ( Compiler (compilerId) - , PackageDB (..) - , PackageDBStack - , compilerFlavor - ) -import Distribution.Simple.Configure - ( configCompilerEx - ) -import Distribution.Simple.PackageDescription - ( readGenericPackageDescription - ) -import Distribution.Simple.PreProcess - ( ppUnlit - , runSimplePreProcessor - ) -import Distribution.Simple.Program - ( ProgramDb - , emptyProgramDb - , getDbProgramOutput - , getProgramSearchPath - , ghcProgram - , ghcjsProgram - , runDbProgram - ) -import Distribution.Simple.Program.Db - ( appendProgramSearchPath - ) -import Distribution.Simple.Program.Find - ( programSearchPathAsPATHVar - ) -import Distribution.Simple.Program.Run - ( getEffectiveEnvironment - ) -import qualified Distribution.Simple.Program.Strip as Strip -import Distribution.Types.ModuleRenaming (defaultRenaming) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + import Distribution.Version ( Version, mkVersion, versionNumbers, VersionRange, anyVersion , intersectVersionRanges, orLaterVersion @@ -105,9 +60,10 @@ import Distribution.Simple.Program ( ProgramDb, emptyProgramDb , getProgramSearchPath, getDbProgramOutput, runDbProgram, ghcProgram , ghcjsProgram ) +import Distribution.Simple.Program.Db + ( appendProgramSearchPath ) import Distribution.Simple.Program.Find - ( programSearchPathAsPATHVar - , ProgramSearchPathEntry(ProgramSearchPathDir) ) + ( programSearchPathAsPATHVar ) import Distribution.Simple.Program.Run ( getEffectiveEnvironment ) import qualified Distribution.Simple.Program.Strip as Strip @@ -489,27 +445,13 @@ invoke verbosity path args options = do Nothing -> return () Just logHandle -> info verbosity $ "Redirecting build log to " ++ show logHandle -<<<<<<< HEAD - searchpath <- programSearchPathAsPATHVar - (map ProgramSearchPathDir (useExtraPathEnv options) ++ - getProgramSearchPath (useProgramDb options)) + progDb <- appendProgramSearchPath verbosity (useExtraPathEnv options) (useProgramDb options) + + searchpath <- programSearchPathAsPATHVar $ getProgramSearchPath progDb env <- getEffectiveEnvironment $ [ ("PATH", Just searchpath) , ("HASKELL_DIST_DIR", Just (useDistPref options)) ] ++ useExtraEnvOverrides options -======= - progDb <- appendProgramSearchPath verbosity (useExtraPathEnv options) (useProgramDb options) - - searchpath <- - programSearchPathAsPATHVar $ getProgramSearchPath progDb - - env <- - getEffectiveEnvironment $ - [ ("PATH", Just searchpath) - , ("HASKELL_DIST_DIR", Just (useDistPref options)) - ] - ++ useExtraEnvOverrides options ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) let loggingHandle = case useLoggingHandle options of Nothing -> Inherit diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs index 0c0a9a2e0b3..04803c6a4f5 100644 --- a/cabal-install/src/Distribution/Client/VCS.hs +++ b/cabal-install/src/Distribution/Client/VCS.hs @@ -37,32 +37,6 @@ module Distribution.Client.VCS ( import Prelude () import Distribution.Client.Compat.Prelude -<<<<<<< HEAD -======= -import Distribution.Client.RebuildMonad - ( MonitorFilePath - , Rebuild - , monitorDirectoryExistence - , monitorFiles - ) -import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy) -import qualified Distribution.PackageDescription as PD -import Distribution.Simple.Program - ( ConfiguredProgram (programVersion) - , Program (programFindVersion) - , ProgramInvocation (..) - , emptyProgramDb - , findProgramVersion - , getProgramInvocationOutput - , programInvocation - , requireProgram - , runProgramInvocation - , simpleProgram - ) -import Distribution.Simple.Program.Db - ( appendProgramSearchPath - ) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) import Distribution.Types.SourceRepo ( RepoType(..), KnownRepoType (..) ) import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy) @@ -76,6 +50,8 @@ import Distribution.Simple.Program , simpleProgram, findProgramVersion , ProgramInvocation(..), programInvocation, runProgramInvocation, getProgramInvocationOutput , emptyProgramDb, requireProgram ) +import Distribution.Simple.Program.Db + ( appendProgramSearchPath ) import Distribution.Version ( mkVersion ) import qualified Distribution.PackageDescription as PD @@ -193,41 +169,22 @@ validateSourceRepos rs = validateSourceRepo' r = either (Left . (,) r) Right (validateSourceRepo r) -<<<<<<< HEAD configureVCS :: Verbosity + -> [FilePath] -- ^ Extra prog paths -> VCS Program -> IO (VCS ConfiguredProgram) -configureVCS verbosity vcs@VCS{vcsProgram = prog} = - asVcsConfigured <$> requireProgram verbosity prog emptyProgramDb -======= -configureVCS - :: Verbosity - -> [FilePath] - -- ^ Extra prog paths - -> VCS Program - -> IO (VCS ConfiguredProgram) configureVCS verbosity progPaths vcs@VCS{vcsProgram = prog} = do - progPath <- appendProgramSearchPath verbosity progPaths emptyProgramDb - asVcsConfigured <$> requireProgram verbosity prog progPath ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) + progPath <- appendProgramSearchPath verbosity progPaths emptyProgramDb + asVcsConfigured <$> requireProgram verbosity prog progPath where asVcsConfigured (prog', _) = vcs { vcsProgram = prog' } -<<<<<<< HEAD configureVCSs :: Verbosity + -> [FilePath] -- ^ Extra prog paths -> Map RepoType (VCS Program) -> IO (Map RepoType (VCS ConfiguredProgram)) -configureVCSs verbosity = traverse (configureVCS verbosity) -======= -configureVCSs - :: Verbosity - -> [FilePath] - -- ^ Extra prog paths - -> Map RepoType (VCS Program) - -> IO (Map RepoType (VCS ConfiguredProgram)) configureVCSs verbosity progPaths = traverse (configureVCS verbosity progPaths) ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- ------------------------------------------------------------ diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs index 375b1081ac4..eae8f76dc65 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs @@ -61,32 +61,18 @@ pkgidfoo = PackageIdentifier (mkPackageName "foo") (mkVersion [1,0]) testNoRepos :: Assertion testNoRepos = do -<<<<<<< HEAD e <- assertException $ - clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos + clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos e @?= ClonePackageNoSourceRepos pkgidfoo -======= - e <- - assertException $ - clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos - e @?= ClonePackageNoSourceRepos pkgidfoo ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [])] testNoReposOfKind :: Assertion testNoReposOfKind = do -<<<<<<< HEAD e <- assertException $ - clonePackagesFromSourceRepo verbosity "." repokind pkgrepos + clonePackagesFromSourceRepo verbosity "." repokind [] pkgrepos e @?= ClonePackageNoSourceReposOfKind pkgidfoo repokind -======= - e <- - assertException $ - clonePackagesFromSourceRepo verbosity "." repokind [] pkgrepos - e @?= ClonePackageNoSourceReposOfKind pkgidfoo repokind ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = emptySourceRepo RepoHead @@ -95,16 +81,9 @@ testNoReposOfKind = do testNoRepoType :: Assertion testNoRepoType = do -<<<<<<< HEAD e <- assertException $ - clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos + clonePackagesFromSourceRepo verbosity "." Nothing []pkgrepos e @?= ClonePackageNoRepoType pkgidfoo repo -======= - e <- - assertException $ - clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos - e @?= ClonePackageNoRepoType pkgidfoo repo ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = emptySourceRepo RepoHead @@ -112,16 +91,9 @@ testNoRepoType = do testUnsupportedRepoType :: Assertion testUnsupportedRepoType = do -<<<<<<< HEAD e <- assertException $ - clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos + clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos e @?= ClonePackageUnsupportedRepoType pkgidfoo repo' repotype -======= - e <- - assertException $ - clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos - e @?= ClonePackageUnsupportedRepoType pkgidfoo repo' repotype ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = (emptySourceRepo RepoHead) @@ -141,16 +113,9 @@ testUnsupportedRepoType = do testNoRepoLocation :: Assertion testNoRepoLocation = do -<<<<<<< HEAD e <- assertException $ - clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos + clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos e @?= ClonePackageNoRepoLocation pkgidfoo repo -======= - e <- - assertException $ - clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos - e @?= ClonePackageNoRepoLocation pkgidfoo repo ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = (emptySourceRepo RepoHead) { @@ -165,22 +130,12 @@ testSelectRepoKind = [ do e <- test requestedRepoType pkgrepos e @?= ClonePackageNoRepoType pkgidfoo expectedRepo -<<<<<<< HEAD e' <- test requestedRepoType (reverse pkgrepos) e' @?= ClonePackageNoRepoType pkgidfoo expectedRepo | let test rt rs = assertException $ - clonePackagesFromSourceRepo verbosity "." rt rs + clonePackagesFromSourceRepo verbosity "." rt [] rs , (requestedRepoType, expectedRepo) <- cases ] -======= - e' <- test requestedRepoType (reverse pkgrepos) - e' @?= ClonePackageNoRepoType pkgidfoo expectedRepo - | let test rt rs = - assertException $ - clonePackagesFromSourceRepo verbosity "." rt [] rs - , (requestedRepoType, expectedRepo) <- cases - ] ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo1, repo2, repo3])] repo1 = emptySourceRepo RepoThis @@ -195,36 +150,19 @@ testSelectRepoKind = testRepoDestinationExists :: Assertion testRepoDestinationExists = -<<<<<<< HEAD withTestDir verbosity "repos" $ \tmpdir -> do let pkgdir = tmpdir "foo" createDirectory pkgdir e1 <- assertException $ - clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos e1 @?= ClonePackageDestinationExists pkgidfoo pkgdir True {- isdir -} removeDirectory pkgdir writeFile pkgdir "" e2 <- assertException $ - clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos e2 @?= ClonePackageDestinationExists pkgidfoo pkgdir False {- isfile -} -======= - withTestDir verbosity "repos" $ \tmpdir -> do - let pkgdir = tmpdir "foo" - createDirectory pkgdir - e1 <- - assertException $ - clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos - e1 @?= ClonePackageDestinationExists pkgidfoo pkgdir True {- isdir -} - removeDirectory pkgdir - - writeFile pkgdir "" - e2 <- - assertException $ - clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos - e2 @?= ClonePackageDestinationExists pkgidfoo pkgdir False {- isfile -} ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where pkgrepos = [(pkgidfoo, [repo])] repo = (emptySourceRepo RepoHead) { @@ -235,7 +173,6 @@ testRepoDestinationExists = testGitFetchFailed :: Assertion testGitFetchFailed = -<<<<<<< HEAD withTestDir verbosity "repos" $ \tmpdir -> do let srcdir = tmpdir "src" repo = (emptySourceRepo RepoHead) { @@ -252,7 +189,7 @@ testGitFetchFailed = } pkgrepos = [(pkgidfoo, [repo])] e1 <- assertException $ - clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos e1 @?= ClonePackageFailedWithExitCode pkgidfoo repo' "git" (ExitFailure 128) @@ -263,7 +200,7 @@ testNetworkGitClone = repoType = Just (KnownRepoType Git), repoLocation = Just "https://github.com/haskell/zlib.git" } - clonePackagesFromSourceRepo verbosity tmpdir Nothing + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] [(mkpkgid "zlib1", [repo1])] assertFileContains (tmpdir "zlib1/zlib.cabal") ["name:", "zlib"] @@ -271,7 +208,7 @@ testNetworkGitClone = repoType = Just (KnownRepoType Git), repoLocation = Just (tmpdir "zlib1") } - clonePackagesFromSourceRepo verbosity tmpdir Nothing + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] [(mkpkgid "zlib2", [repo2])] assertFileContains (tmpdir "zlib2/zlib.cabal") ["name:", "zlib"] @@ -280,75 +217,9 @@ testNetworkGitClone = repoLocation = Just (tmpdir "zlib1"), repoTag = Just "0.5.0.0" } - clonePackagesFromSourceRepo verbosity tmpdir Nothing + clonePackagesFromSourceRepo verbosity tmpdir Nothing [] [(mkpkgid "zlib3", [repo3])] assertFileContains (tmpdir "zlib3/zlib.cabal") ["version:", "0.5.0.0"] -======= - withTestDir verbosity "repos" $ \tmpdir -> do - let srcdir = tmpdir "src" - repo = - (emptySourceRepo RepoHead) - { repoType = Just (KnownRepoType Git) - , repoLocation = Just srcdir - } - repo' = - SourceRepositoryPackage - { srpType = KnownRepoType Git - , srpLocation = srcdir - , srpTag = Nothing - , srpBranch = Nothing - , srpSubdir = Proxy - , srpCommand = [] - } - pkgrepos = [(pkgidfoo, [repo])] - e1 <- - assertException $ - clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos - e1 @?= ClonePackageFailedWithExitCode pkgidfoo repo' "git" (ExitFailure 128) - -testNetworkGitClone :: Assertion -testNetworkGitClone = - withTestDir verbosity "repos" $ \tmpdir -> do - let repo1 = - (emptySourceRepo RepoHead) - { repoType = Just (KnownRepoType Git) - , repoLocation = Just "https://github.com/haskell/zlib.git" - } - clonePackagesFromSourceRepo - verbosity - tmpdir - Nothing - [] - [(mkpkgid "zlib1", [repo1])] - assertFileContains (tmpdir "zlib1/zlib.cabal") ["name:", "zlib"] - - let repo2 = - (emptySourceRepo RepoHead) - { repoType = Just (KnownRepoType Git) - , repoLocation = Just (tmpdir "zlib1") - } - clonePackagesFromSourceRepo - verbosity - tmpdir - Nothing - [] - [(mkpkgid "zlib2", [repo2])] - assertFileContains (tmpdir "zlib2/zlib.cabal") ["name:", "zlib"] - - let repo3 = - (emptySourceRepo RepoHead) - { repoType = Just (KnownRepoType Git) - , repoLocation = Just (tmpdir "zlib1") - , repoTag = Just "0.5.0.0" - } - clonePackagesFromSourceRepo - verbosity - tmpdir - Nothing - [] - [(mkpkgid "zlib3", [repo3])] - assertFileContains (tmpdir "zlib3/zlib.cabal") ["version:", "0.5.0.0"] ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) where mkpkgid nm = PackageIdentifier (mkPackageName nm) (mkVersion []) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs index 896d53f2812..9b4cd6e4511 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs @@ -49,47 +49,12 @@ import UnitTests.TempTestDir (withTestDir, removeDirectoryRecursiveHack) -- checks that the working state is as expected (given the pure representation). -- tests :: MTimeChange -> [TestTree] -<<<<<<< HEAD tests mtimeChange = map (localOption $ QuickCheckTests 10) [ ignoreInWindows "See issue #8048" $ testGroup "git" [ testProperty "check VCS test framework" prop_framework_git , testProperty "cloneSourceRepo" prop_cloneRepo_git , testProperty "syncSourceRepos" prop_syncRepos_git -======= -tests mtimeChange = - map - (localOption $ QuickCheckTests 10) - [ ignoreInWindows "See issue #8048 and #9519" $ - testGroup - "git" - [ testProperty "check VCS test framework" prop_framework_git - , testProperty "cloneSourceRepo" prop_cloneRepo_git - , testProperty "syncSourceRepos" prop_syncRepos_git - ] - , -- - ignoreTestBecause "for the moment they're not yet working" $ - testGroup - "darcs" - [ testProperty "check VCS test framework" $ prop_framework_darcs mtimeChange - , testProperty "cloneSourceRepo" $ prop_cloneRepo_darcs mtimeChange - , testProperty "syncSourceRepos" $ prop_syncRepos_darcs mtimeChange - ] - , ignoreTestBecause "for the moment they're not yet working" $ - testGroup - "pijul" - [ testProperty "check VCS test framework" prop_framework_pijul - , testProperty "cloneSourceRepo" prop_cloneRepo_pijul - , testProperty "syncSourceRepos" prop_syncRepos_pijul - ] - , ignoreTestBecause "for the moment they're not yet working" $ - testGroup - "mercurial" - [ testProperty "check VCS test framework" prop_framework_hg - , testProperty "cloneSourceRepo" prop_cloneRepo_hg - , testProperty "syncSourceRepos" prop_syncRepos_hg - ] ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) ] -- @@ -213,23 +178,13 @@ testSetup :: VCS Program -> (VCSTestDriver -> FilePath -> RepoState -> IO a) -> IO a testSetup vcs mkVCSTestDriver repoRecipe theTest = do -<<<<<<< HEAD -- test setup - vcs' <- configureVCS verbosity vcs + vcs' <- configureVCS verbosity [] vcs withTestDir verbosity "vcstest" $ \tmpdir -> do let srcRepoPath = tmpdir "src" submodulesPath = tmpdir "submodules" vcsDriver = mkVCSTestDriver verbosity vcs' submodulesPath srcRepoPath repoState <- createRepo vcsDriver repoRecipe -======= - -- test setup - vcs' <- configureVCS verbosity [] vcs - withTestDir verbosity "vcstest" $ \tmpdir -> do - let srcRepoPath = tmpdir "src" - submodulesPath = tmpdir "submodules" - vcsDriver = mkVCSTestDriver verbosity vcs' submodulesPath srcRepoPath - repoState <- createRepo vcsDriver repoRecipe ->>>>>>> 46df8ba71 (Fix extra-prog-path propagation in the codebase.) -- actual test result <- theTest vcsDriver tmpdir repoState