Cabal 3.10.2.1 → 3.10.3.0

raw patch · 15 files changed

+278/−176 lines, 15 filesdep ~Win32dep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Win32, containers

API changes (from Hackage documentation)

Files

• Cabal.cabal +5/−5
• ChangeLog.md +4/−1
• src/Distribution/PackageDescription/Check.hs +13/−3
• src/Distribution/Simple.hs +6/−4
• src/Distribution/Simple/Configure.hs +53/−45
• src/Distribution/Simple/ConfigureScript.hs +2/−3
• src/Distribution/Simple/GHC.hs +4/−10
• src/Distribution/Simple/GHC/Internal.hs +3/−1
• src/Distribution/Simple/GHCJS.hs +2/−8
• src/Distribution/Simple/Program/Builtin.hs +51/−7
• src/Distribution/Simple/Program/Db.hs +21/−1
• src/Distribution/Simple/Program/Find.hs +48/−21
• src/Distribution/Simple/Program/GHC.hs +13/−8
• src/Distribution/Simple/Program/Run.hs +23/−41
• src/Distribution/Simple/Program/Types.hs +30/−18

@@ -1,6 +1,6 @@ cabal-version: 2.2 name:          Cabal-version:       3.10.2.1+version:       3.10.3.0 copyright:     2003-2023, Cabal Development Team (see AUTHORS file) license:       BSD-3-Clause license-file:  LICENSE@@ -21,7 +21,7 @@ -- If we use a new Cabal feature, this needs to be changed to Custom so -- we can bootstrap. -extra-source-files:+extra-doc-files:   README.md ChangeLog.md  source-repository head@@ -38,16 +38,16 @@     array      >= 0.4.0.1  && < 0.6,     base       >= 4.9      && < 5,     bytestring >= 0.10.0.0 && < 0.13,-    containers >= 0.5.0.0  && < 0.7,+    containers >= 0.5.0.0  && < 0.8,     deepseq    >= 1.3.0.1  && < 1.6,     directory  >= 1.2      && < 1.4,-    filepath   >= 1.3.0.1  && < 1.5,+    filepath   >= 1.3.0.1  && < 1.6,     pretty     >= 1.1.1    && < 1.2,     process    >= 1.2.1.0  && < 1.7,     time       >= 1.4.0.1  && < 1.13    if os(windows)-    build-depends: Win32 >= 2.3.0.0 && < 2.14+    build-depends: Win32 >= 2.3.0.0 && < 2.15   else     build-depends: unix  >= 2.6.0.0 && < 2.9 

@@ -1,4 +1,7 @@-# 3.10.2.1 [Hécate] (mailto:hecate+github@glitchbra.in) October 2023+# 3.10.3.0 [Hécate](mailto:hecate+github@glitchbra.in) January 2024+* See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.10.3.0.md++# 3.10.2.1 [Hécate](mailto:hecate+github@glitchbra.in) October 2023 * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.10.2.1.md  # 3.10.2.0 [Hécate](mailto:hecate+github@glitchbra.in) August 2023

@@ -224,6 +224,7 @@         | CVExpliticDepsCustomSetup         | CVAutogenPaths         | CVAutogenPackageInfo+        | CVAutogenPackageInfoGuard         | GlobNoMatch String String         | GlobExactMatch String String FilePath         | GlobNoDir String String FilePath@@ -664,6 +665,11 @@       ++ "the module does not come with the package and is generated on "       ++ "setup. Modules built with a custom Setup.hs script also go here "       ++ "to ensure that commands like sdist don't fail."+ppExplanation CVAutogenPackageInfoGuard =+    "To use the autogenerated module PackageInfo_* you need to specify "+      ++ "`cabal-version: 3.12` or higher. This is not possible in `cabal "+      ++ "3.10`. To use this feature and be able to upload your package to "+      ++ "Hackage, download `cabal 3.12`!" ppExplanation (GlobNoMatch field glob) =     "In '" ++ field ++ "': the pattern '" ++ glob ++ "' does not"       ++ " match any files."@@ -1193,9 +1199,10 @@     unknownCompilers  = [ name | (OtherCompiler name, _) <- testedWith pkg ]     unknownLanguages  = [ name | bi <- allBuildInfo pkg                                , UnknownLanguage name <- allLanguages bi ]-    unknownExtensions = [ name | bi <- allBuildInfo pkg-                               , UnknownExtension name <- allExtensions bi-                               , name `notElem` map prettyShow knownLanguages ]+    unknownExtensions = filter (/= "TypeAbstractions")+                          [ name | bi <- allBuildInfo pkg+                                 , UnknownExtension name <- allExtensions bi+                                 , name `notElem` map prettyShow knownLanguages ]     ourDeprecatedExtensions = nub $ catMaybes       [ find ((==ext) . fst) deprecatedExtensions       | bi <- allBuildInfo pkg@@ -1813,6 +1820,9 @@            && not (elem (autogenPackageInfoModuleName pkg) allModuleNamesAutogen) ) $       PackageDistInexcusable CVAutogenPackageInfo +  , check+      (elem (autogenPackageInfoModuleName pkg) allModuleNames)+      (PackageDistInexcusable CVAutogenPackageInfoGuard)   ]   where     -- Perform a check on packages that use a version of the spec less than

@@ -576,8 +576,7 @@ -- -- * 'postConf' runs @.\/configure@, if present. ----- * the pre-hooks 'preBuild', 'preClean', 'preCopy', 'preInst',---   'preReg' and 'preUnreg' read additional build information from+-- * the pre-hooks, except for pre-conf, read additional build information from --   /package/@.buildinfo@, if present. -- -- Thus @configure@ can use local system information to generate@@ -588,14 +587,17 @@     = simpleUserHooks       {        postConf    = defaultPostConf,-       preBuild    = readHookWithArgs buildVerbosity buildDistPref, -- buildCabalFilePath,+       preBuild = readHookWithArgs buildVerbosity buildDistPref,+       preRepl = readHookWithArgs replVerbosity replDistPref,        preCopy     = readHookWithArgs copyVerbosity copyDistPref,        preClean    = readHook cleanVerbosity cleanDistPref,        preInst     = readHook installVerbosity installDistPref,        preHscolour = readHook hscolourVerbosity hscolourDistPref,        preHaddock  = readHookWithArgs haddockVerbosity haddockDistPref,        preReg      = readHook regVerbosity regDistPref,-       preUnreg    = readHook regVerbosity regDistPref+       preUnreg    = readHook regVerbosity regDistPref,+       preTest     = readHookWithArgs testVerbosity testDistPref,+       preBench    = readHookWithArgs benchmarkVerbosity benchmarkDistPref       }     where defaultPostConf :: Args -> ConfigFlags -> PackageDescription                           -> LocalBuildInfo -> IO ()

@@ -76,12 +76,13 @@ import Distribution.Simple.Setup as Setup import Distribution.Simple.BuildTarget import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Program.Db (appendProgramSearchPath, modifyProgramSearchPath, lookupProgramByName)+import Distribution.Simple.Utils+import Distribution.System 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@@ -101,7 +102,8 @@ import Control.Exception     ( try ) import Distribution.Utils.Structured ( structuredDecodeOrFailIO, structuredEncode )-import Distribution.Compat.Directory ( listDirectory )+import Distribution.Compat.Directory+    ( listDirectory, doesPathExist ) import Data.ByteString.Lazy          ( ByteString ) import qualified Data.ByteString            as BS import qualified Data.ByteString.Lazy.Char8 as BLC8@@ -114,8 +116,6 @@     , getTemporaryDirectory, removeFile) import System.FilePath     ( (</>), isAbsolute, takeDirectory )-import Distribution.Compat.Directory-    ( doesPathExist ) import qualified System.Info     ( compilerName, compilerVersion ) import System.IO@@ -367,18 +367,19 @@             (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@@ -637,21 +638,16 @@                                       "--enable-split-objs; ignoring")                                 return False -    let compilerSupportsGhciLibs :: Bool-        compilerSupportsGhciLibs =-          case compilerId comp of-            CompilerId GHC version-              | version > mkVersion [9,3] && windows ->-                False-            CompilerId GHC _ ->-                True-            CompilerId GHCJS _ ->-                True-            _ -> False-          where-            windows = case compPlatform of-              Platform _ Windows -> True-              Platform _ _ -> False+    -- Basically yes/no/unknown.+    let linkerSupportsRelocations :: Maybe Bool+        linkerSupportsRelocations =+          case lookupProgramByName "ld" programDb'' of+            Nothing -> Nothing+            Just ld ->+              case Map.lookup "Supports relocatable output" $ programProperties ld of+                Just "YES" -> Just True+                Just "NO" -> Just False+                _other -> Nothing      let ghciLibByDefault =           case compilerId comp of@@ -671,10 +667,12 @@      withGHCiLib_ <-       case fromFlagOrDefault ghciLibByDefault (configGHCiLib cfg) of-        True | not compilerSupportsGhciLibs -> do+        -- NOTE: If linkerSupportsRelocations is Nothing this may still fail if the+        -- linker does not support -r.+        True | not (fromMaybe True linkerSupportsRelocations) -> do           warn verbosity $-                "--enable-library-for-ghci is no longer supported on Windows with"-              ++ " GHC 9.4 and later; ignoring..."+            "--enable-library-for-ghci is not supported with the current"+            ++ "  linker; ignoring..."           return False         v -> return v @@ -843,17 +841,28 @@     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 <-+    modifyProgramSearchPath (getProgramSearchPath initialProgramDb ++)+      <$> appendProgramSearchPath (fromFlagOrDefault normal (configVerbosity cfg)) searchpath initialProgramDb+  pure+    . userSpecifyArgss (configProgramArgs cfg)+    . userSpecifyPaths (configProgramPaths cfg)+    $ programDb   where-    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+-- 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.+ -- ----------------------------------------------------------------------------- -- Helper functions for configure @@ -938,11 +947,11 @@         then internalDepSatisfiable         else           -- Backward compatibility for the old sublibrary syntax-          (sublibs == mainLibSet+          sublibs == mainLibSet             && Map.member                  (pn, CLibName $ LSubLibName $                       packageNameToUnqualComponentName depName)-                 requiredDepsMap)+                 requiredDepsMap            || all visible sublibs @@ -969,7 +978,7 @@     internalDepSatisfiable =         Set.isSubsetOf (NES.toSet sublibs) packageLibraries     internalDepSatisfiableExternally =-        all (\ln -> not $ null $ PackageIndex.lookupInternalDependency installedPackageSet pn vr ln) sublibs+        all (not . null . PackageIndex.lookupInternalDependency installedPackageSet pn vr) sublibs      -- Check whether a library exists and is visible.     -- We don't disambiguate between dependency on non-existent or private@@ -1438,8 +1447,7 @@ -- flag into a single package db stack. -- interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack-interpretPackageDbFlags userInstall specificDBs =-    extra initialStack specificDBs+interpretPackageDbFlags userInstall = extra initialStack   where     initialStack | userInstall = [GlobalPackageDB, UserPackageDB]                  | otherwise   = [GlobalPackageDB]@@ -1685,8 +1693,8 @@   let (includeDirs',  cflags')   = partition ("-I" `isPrefixOf`) cflags       (extraLibs',    ldflags')  = partition ("-l" `isPrefixOf`) ldflags       (extraLibDirs', ldflags'') = partition ("-L" `isPrefixOf`) ldflags'-      (extraLibsStatic')         = filter ("-l" `isPrefixOf`) ldflags_static-      (extraLibDirsStatic')      = filter ("-L" `isPrefixOf`) ldflags_static+      extraLibsStatic'         = filter ("-l" `isPrefixOf`) ldflags_static+      extraLibDirsStatic'      = filter ("-L" `isPrefixOf`) ldflags_static   in mempty {        includeDirs  = map (drop 2) includeDirs',        extraLibs    = map (drop 2) extraLibs',@@ -1702,13 +1710,13 @@  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  configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath                  -> ProgramDb -> Verbosity

@@ -137,10 +137,9 @@       maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)]       args' = configureFile':args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag       shProg = simpleProgram "sh"-      progDb = modifyProgramSearchPath-               (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb+  progDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb   shConfiguredProg <- lookupProgram shProg-                      `fmap` configureProgram  verbosity shProg progDb+                      `fmap` configureProgram verbosity shProg progDb   case shConfiguredProg of       Just sh -> runProgramInvocation verbosity $                  (programInvocation (sh {programOverrideEnv = overEnv}) args')

@@ -935,7 +935,7 @@                 ghcOptLinkFrameworks     = toNubListR $ PD.frameworks libBi,                 ghcOptLinkFrameworkDirs  =                   toNubListR $ PD.extraFrameworkDirs libBi,-                ghcOptRPaths             = rpaths+                ghcOptRPaths             = rpaths <> toNubListR (extraLibDirs libBi)               }           ghcStaticLinkArgs =               mempty {@@ -1436,7 +1436,7 @@                                              [tmpDir </> x | x <- cLikeObjs ++ cxxObjs]                     }       dynLinkerOpts = mempty {-                      ghcOptRPaths         = rpaths,+                      ghcOptRPaths         = rpaths <> toNubListR (extraLibDirs bnfo),                       ghcOptInputFiles     = toNubListR                                              [tmpDir </> x | x <- cLikeObjs ++ cxxObjs]                    }@@ -1861,18 +1861,12 @@       libBi = libBuildInfo lib       comp        = compiler lbi       platform    = hostPlatform lbi-      vanillaArgs0 =+      vanillaArgs =         (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))         `mappend` mempty {           ghcOptMode         = toFlag GhcModeAbiHash,           ghcOptInputModules = toNubListR $ exposedModules lib         }-      vanillaArgs =-          -- Package DBs unnecessary, and break ghc-cabal. See #3633-          -- BUT, put at least the global database so that 7.4 doesn't-          -- break.-          vanillaArgs0 { ghcOptPackageDBs = [GlobalPackageDB]-                       , ghcOptPackages = mempty }       sharedArgs = vanillaArgs `mappend` mempty {                        ghcOptDynLinkMode = toFlag GhcDynamicOnly,                        ghcOptFPic        = toFlag True,@@ -1896,7 +1890,7 @@    (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)   hash <- getProgramInvocationOutput verbosity-          (ghcInvocation ghcProg comp platform ghcArgs)+          =<< ghcInvocation verbosity ghcProg comp platform ghcArgs   return (takeWhile (not . isSpace) hash)  componentGhcOptions :: Verbosity -> LocalBuildInfo

@@ -101,7 +101,9 @@     }   . addKnownProgram ldProgram {       programFindLocation = findProg ldProgramName extraLdPath,-      programPostConf     = configureLd+      programPostConf = \v cp ->+        -- Call any existing configuration first and then add any new configuration+        configureLd v =<< programPostConf ldProgram v cp     }   . addKnownProgram arProgram {       programFindLocation = findProg arProgramName extraArPath

@@ -1573,18 +1573,12 @@       libBi = libBuildInfo lib       comp        = compiler lbi       platform    = hostPlatform lbi-      vanillaArgs0 =+      vanillaArgs =         (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))         `mappend` mempty {           ghcOptMode         = toFlag GhcModeAbiHash,           ghcOptInputModules = toNubListR $ exposedModules lib         }-      vanillaArgs =-          -- Package DBs unnecessary, and break ghc-cabal. See #3633-          -- BUT, put at least the global database so that 7.4 doesn't-          -- break.-          vanillaArgs0 { ghcOptPackageDBs = [GlobalPackageDB]-                       , ghcOptPackages = mempty }       sharedArgs = vanillaArgs `mappend` mempty {                        ghcOptDynLinkMode = toFlag GhcDynamicOnly,                        ghcOptFPic        = toFlag True,@@ -1608,7 +1602,7 @@    (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)   hash <- getProgramInvocationOutput verbosity-          (ghcInvocation ghcjsProg comp platform ghcArgs)+          =<< ghcInvocation verbose ghcjsProg comp platform ghcArgs   return (takeWhile (not . isSpace) hash)  componentGhcOptions :: Verbosity -> LocalBuildInfo

@@ -256,8 +256,7 @@  stripProgram :: Program stripProgram = (simpleProgram "strip") {-    programFindVersion = \verbosity ->-      findProgramVersion "--version" stripExtractVersion (lessVerbose verbosity)+    programFindVersion = findProgramVersion "--version" stripExtractVersion . lessVerbose   }  hsc2hsProgram :: Program@@ -322,8 +321,45 @@ greencardProgram = simpleProgram "greencard"  ldProgram :: Program-ldProgram = simpleProgram "ld"+ldProgram = (simpleProgram "ld")+    { programPostConf = \verbosity ldProg -> do+        -- The `lld` linker cannot create merge (relocatable) objects so we+        -- want to detect this.+        -- If the linker does support relocatable objects, we want to use that+        -- to create partially pre-linked objects for GHCi, so we get much+        -- faster loading as we do not have to do the separate loading and+        -- in-memory linking the static linker in GHC does, but can offload+        -- parts of this process to a pre-linking step.+        -- However this requires the linker to support this features. Not all+        -- linkers do, and notably as of this writing `lld` which is a popular+        -- choice for windows linking does not support this feature. However+        -- if using binutils ld or another linker that supports --relocatable,+        -- we should still be good to generate pre-linked objects.+        ldHelpOutput <-+          getProgramInvocationOutput+            verbosity+            (programInvocation ldProg ["--help"])+            -- In case the linker does not support '--help'. Eg the LLVM linker,+            -- `lld` only accepts `-help`.+            `catchIO` (\_ -> return "")+        let k = "Supports relocatable output"+            -- Standard GNU `ld` uses `--relocatable` while `ld.gold` uses+            -- `-relocatable` (single `-`).+            v+              | "-relocatable" `isInfixOf` ldHelpOutput = "YES"+              -- ld64 on macOS has this lovely response for "--help"+              --+              --   ld64: For information on command line options please use 'man ld'.+              --+              -- it does however support -r, if you read the manpage+              -- (e.g. https://www.manpagez.com/man/1/ld64/)+              | "ld64:" `isPrefixOf` ldHelpOutput = "YES"+              | otherwise = "NO" +            m = Map.insert k v (programProperties ldProg)+        return $ ldProg{programProperties = m}+    }+ tarProgram :: Program tarProgram = (simpleProgram "tar") {   -- See #1901. Some versions of 'tar' (OpenBSD, NetBSD, ...) don't support the@@ -334,7 +370,7 @@                       -- Some versions of tar don't support '--help'.                       `catchIO` (\_ -> return "")      let k = "Supports --format"-         v = if ("--format" `isInfixOf` tarHelpOutput) then "YES" else "NO"+         v = if "--format" `isInfixOf` tarHelpOutput then "YES" else "NO"          m = Map.insert k v (programProperties tarProg)      return $ tarProg { programProperties = m }   }@@ -343,6 +379,14 @@ cppProgram = simpleProgram "cpp"  pkgConfigProgram :: Program-pkgConfigProgram = (simpleProgram "pkg-config") {-    programFindVersion = findProgramVersion "--version" id-  }+pkgConfigProgram =+  (simpleProgram "pkg-config")+    { programFindVersion = findProgramVersion "--version" id+    , programPostConf = \_ pkgConfProg ->+        let programOverrideEnv' =+              programOverrideEnv pkgConfProg+                ++ [ ("PKG_CONFIG_ALLOW_SYSTEM_CFLAGS", Just "1")+                   , ("PKG_CONFIG_ALLOW_SYSTEM_LIBS", Just "1")+                   ]+         in pure $ pkgConfProg{programOverrideEnv = programOverrideEnv'}+    }

@@ -34,6 +34,7 @@     -- ** Query and manipulate the program db     addKnownProgram,     addKnownPrograms,+    appendProgramSearchPath,     lookupKnownProgram,     knownPrograms,     getProgramSearchPath,@@ -46,6 +47,7 @@     userSpecifyArgss,     userSpecifiedArgs,     lookupProgram,+    lookupProgramByName,     updateProgram,     configuredPrograms, @@ -222,6 +224,21 @@ modifyProgramSearchPath f db =   setProgramSearchPath (f $ getProgramSearchPath db) db +-- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'+-- by appending the provided extra paths. Also logs the added paths+-- in info verbosity.+appendProgramSearchPath+  :: Verbosity+  -> [FilePath]+  -> ProgramDb+  -> IO ProgramDb+appendProgramSearchPath verbosity extraPaths db =+  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.@@ -293,8 +310,11 @@  -- | Try to find a configured program lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram-lookupProgram prog = Map.lookup (programName prog) . configuredProgs+lookupProgram = lookupProgramByName . programName +-- | Try to find a configured program+lookupProgramByName :: String -> ProgramDb -> Maybe ConfiguredProgram+lookupProgramByName name = Map.lookup name . configuredProgs  -- | Update a configured program in the database. updateProgram :: ConfiguredProgram -> ProgramDb

@@ -32,13 +32,17 @@     defaultProgramSearchPath,     findProgramOnSearchPath,     programSearchPathAsPATHVar,+    logExtraProgramSearchPath,     getSystemSearchPath,+    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@@ -52,30 +56,18 @@ 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] +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])) findProgramOnSearchPath verbosity searchpath prog = do@@ -141,6 +133,25 @@         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%@.@@ -196,3 +207,19 @@         _     -> 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+  }

@@ -31,8 +31,9 @@ import Distribution.ModuleName import Distribution.Simple.Compiler import Distribution.Simple.Flag-import Distribution.Simple.Program.Types+import Distribution.Simple.Program.Find (getExtraPathEnv) import Distribution.Simple.Program.Run+import Distribution.Simple.Program.Types import Distribution.System import Distribution.Pretty import Distribution.Types.ComponentId@@ -569,15 +570,19 @@ 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 +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} -ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions-              -> ProgramInvocation-ghcInvocation prog comp platform opts =-    (programInvocation prog (renderGhcOptions comp platform opts)) {-        progInvokePathEnv = fromNubListR (ghcOptExtraPath opts)-    }+  pure $ programInvocation ghcProg' (renderGhcOptions comp platform opts)  renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String] renderGhcOptions comp _platform@(Platform _arch os) opts

@@ -13,20 +13,19 @@ -- This module provides a data type for program invocations and functions to -- run them. -module Distribution.Simple.Program.Run (-    ProgramInvocation(..),-    IOEncoding(..),-    emptyProgramInvocation,-    simpleProgramInvocation,-    programInvocation,-    multiStageProgramInvocation,--    runProgramInvocation,-    getProgramInvocationOutput,-    getProgramInvocationLBS,-    getProgramInvocationOutputAndErrors,--    getEffectiveEnvironment,+module Distribution.Simple.Program.Run+  ( ProgramInvocation (..)+  , IOEncoding (..)+  , emptyProgramInvocation+  , simpleProgramInvocation+  , programInvocation+  , multiStageProgramInvocation+  , runProgramInvocation+  , getProgramInvocationOutput+  , getProgramInvocationLBS+  , getProgramInvocationOutputAndErrors+  , getProgramInvocationLBSAndErrors+  , getEffectiveEnvironment   ) where  import Distribution.Compat.Prelude@@ -38,8 +37,6 @@ import Distribution.Utils.Generic import Distribution.Verbosity -import System.FilePath (searchPathSeparator)- import qualified Data.ByteString.Lazy as LBS import qualified Data.Map             as Map @@ -54,8 +51,6 @@        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'.@@ -76,7 +71,6 @@     progInvokePath  = "",     progInvokeArgs  = [],     progInvokeEnv   = [],-    progInvokePathEnv = [],     progInvokeCwd   = Nothing,     progInvokeInput = Nothing,     progInvokeInputEncoding  = IOEncodingText,@@ -107,7 +101,6 @@     progInvokePath  = path,     progInvokeArgs  = args,     progInvokeEnv   = [],-    progInvokePathEnv = [],     progInvokeCwd   = Nothing,     progInvokeInput = Nothing   } =@@ -118,12 +111,10 @@     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@@ -134,13 +125,11 @@     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@@ -174,6 +163,13 @@         (output', errors, exitCode) <- getProgramInvocationIODataAndErrors verbosity inv IODataModeBinary         return (normaliseLineEndings (fromUTF8LBS output'), errors, exitCode) +getProgramInvocationLBSAndErrors+  :: Verbosity+  -> ProgramInvocation+  -> IO (LBS.ByteString, String, ExitCode)+getProgramInvocationLBSAndErrors verbosity inv =+  getProgramInvocationIODataAndErrors verbosity inv IODataModeBinary+ getProgramInvocationIODataAndErrors     :: KnownIODataMode mode => Verbosity -> ProgramInvocation -> IODataMode mode     -> IO (mode, String, ExitCode)@@ -183,29 +179,15 @@     { progInvokePath          = path     , progInvokeArgs          = args     , progInvokeEnv           = envOverrides-    , progInvokePathEnv       = extraPath     , progInvokeCwd           = mcwd     , progInvokeInput         = minputStr     , 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--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')]  -- | Return the current environment extended with the given overrides. -- If an entry is specified twice in @overrides@, the second entry takes

@@ -25,7 +25,6 @@     Program(..),     ProgramSearchPath,     ProgramSearchPathEntry(..),-    simpleProgram,      -- * Configured program and related functions     ConfiguredProgram(..),@@ -40,7 +39,6 @@ import Distribution.Compat.Prelude  import Distribution.PackageDescription-import Distribution.Simple.Program.Find import Distribution.Version import Distribution.Verbosity @@ -87,6 +85,36 @@  type ProgArg = String +-- | 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+ -- | 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@@ -156,22 +184,6 @@ -- | Suppress any extra arguments added by the user. 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'. --