cabal-install 3.8.1.0 → 3.10.1.0

raw patch · 79 files changed

+1595/−685 lines, 79 filesdep ~Cabaldep ~Cabal-syntaxdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Cabal, Cabal-syntax, base, cabal-install-solver, directory, mtl, process, resolv

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• cabal-install.cabal +18/−11
• changelog +8/−5
• main/Main.hs +40/−10
• src/Distribution/Client/BuildReports/Anonymous.hs +1/−1
• src/Distribution/Client/Check.hs +5/−4
• src/Distribution/Client/CmdBench.hs +1/−1
• src/Distribution/Client/CmdBuild.hs +4/−1
• src/Distribution/Client/CmdClean.hs +3/−3
• src/Distribution/Client/CmdErrorMessages.hs +7/−0
• src/Distribution/Client/CmdFreeze.hs +1/−1
• src/Distribution/Client/CmdHaddock.hs +27/−4
• src/Distribution/Client/CmdHaddockProject.hs +337/−0
• src/Distribution/Client/CmdInstall.hs +78/−52
• src/Distribution/Client/CmdInstall/ClientInstallFlags.hs +1/−1
• src/Distribution/Client/CmdListBin.hs +14/−3
• src/Distribution/Client/CmdOutdated.hs +2/−2
• src/Distribution/Client/CmdRepl.hs +8/−3
• src/Distribution/Client/CmdRun.hs +13/−12
• src/Distribution/Client/CmdSdist.hs +2/−1
• src/Distribution/Client/CmdUpdate.hs +1/−1
• src/Distribution/Client/Compat/Process.hs +0/−48
• src/Distribution/Client/Config.hs +86/−28
• src/Distribution/Client/Configure.hs +7/−16
• src/Distribution/Client/Dependency.hs +12/−7
• src/Distribution/Client/Dependency/Types.hs +7/−0
• src/Distribution/Client/DistDirLayout.hs +13/−14
• src/Distribution/Client/FetchUtils.hs +41/−5
• src/Distribution/Client/GenBounds.hs +14/−18
• src/Distribution/Client/Get.hs +34/−4
• src/Distribution/Client/Haddock.hs +1/−1
• src/Distribution/Client/HttpUtils.hs +1/−1
• src/Distribution/Client/Init/Format.hs +6/−6
• src/Distribution/Client/Init/Interactive/Command.hs +3/−9
• src/Distribution/Client/Init/NonInteractive/Command.hs +2/−2
• src/Distribution/Client/Init/NonInteractive/Heuristics.hs +3/−21
• src/Distribution/Client/Init/Simple.hs +2/−2
• src/Distribution/Client/Init/Types.hs +2/−2
• src/Distribution/Client/Init/Utils.hs +22/−6
• src/Distribution/Client/Install.hs +4/−4
• src/Distribution/Client/Manpage.hs +19/−23
• src/Distribution/Client/PackageHash.hs +9/−1
• src/Distribution/Client/ProjectConfig.hs +7/−6
• src/Distribution/Client/ProjectConfig/Legacy.hs +46/−19
• src/Distribution/Client/ProjectConfig/Types.hs +11/−7
• src/Distribution/Client/ProjectOrchestration.hs +32/−27
• src/Distribution/Client/ProjectPlanning.hs +55/−21
• src/Distribution/Client/ProjectPlanning/Types.hs +3/−0
• src/Distribution/Client/Sandbox/PackageEnvironment.hs +4/−4
• src/Distribution/Client/ScriptUtils.hs +14/−19
• src/Distribution/Client/Setup.hs +102/−46
• src/Distribution/Client/SetupWrapper.hs +54/−98
• src/Distribution/Client/Signal.hs +49/−0
• src/Distribution/Client/SourceFiles.hs +3/−2
• src/Distribution/Client/TargetSelector.hs +15/−10
• src/Distribution/Client/Types/ConfiguredPackage.hs +0/−2
• src/Distribution/Client/Upload.hs +2/−2
• src/Distribution/Client/Utils.hs +28/−20
• src/Distribution/Client/VCS.hs +6/−2
• src/Distribution/Client/Version.hs +5/−5
• src/Distribution/Deprecated/ViewAsFieldDescr.hs +0/−1
• tests/IntegrationTests2.hs +12/−3
• tests/UnitTests/Distribution/Client/Configure.hs +11/−11
• tests/UnitTests/Distribution/Client/Get.hs +2/−2
• tests/UnitTests/Distribution/Client/IndexUtils.hs +0/−0
• tests/UnitTests/Distribution/Client/Init/FileCreators.hs +2/−2
• tests/UnitTests/Distribution/Client/Init/Golden.hs +6/−5
• tests/UnitTests/Distribution/Client/Init/Interactive.hs +15/−4
• tests/UnitTests/Distribution/Client/Init/NonInteractive.hs +142/−3
• tests/UnitTests/Distribution/Client/Init/Simple.hs +11/−6
• tests/UnitTests/Distribution/Client/Init/Utils.hs +1/−2
• tests/UnitTests/Distribution/Client/InstallPlan.hs +1/−1
• tests/UnitTests/Distribution/Client/ProjectConfig.hs +21/−2
• tests/UnitTests/Distribution/Client/TreeDiffInstances.hs +1/−0
• tests/UnitTests/Distribution/Client/VCS.hs +1/−1
• tests/UnitTests/Distribution/Solver/Modular/DSL.hs +23/−7
• tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs +8/−1
• tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs +20/−8
• tests/UnitTests/Distribution/Solver/Modular/Solver.hs +22/−1

@@ -1,4 +1,4 @@-Copyright (c) 2003-2022, Cabal Development Team.+Copyright (c) 2003-2023, Cabal Development Team. See the AUTHORS file for the full list of copyright holders.  See */LICENSE for the copyright holders of the subcomponents.

@@ -1,7 +1,7 @@ Cabal-Version:      2.2  Name:               cabal-install-Version:            3.8.1.0+Version:            3.10.1.0 Synopsis:           The command-line interface for Cabal and Hackage. Description:     The \'cabal\' command-line program simplifies the process of managing@@ -13,7 +13,7 @@ License-File:       LICENSE Author:             Cabal Development Team (see AUTHORS file) Maintainer:         Cabal Development Team <cabal-devel@haskell.org>-Copyright:          2003-2022, Cabal Development Team+Copyright:          2003-2023, Cabal Development Team Category:           Distribution Build-type:         Simple Extra-Source-Files:@@ -46,20 +46,21 @@       ghc-options: -Wunused-packages  common base-dep-    build-depends: base >=4.10 && <4.17+    build-depends: base >=4.10 && <4.18  common cabal-dep-    build-depends: Cabal ^>=3.8+    build-depends: Cabal ^>=3.10  common cabal-syntax-dep-    build-depends: Cabal-syntax ^>=3.8+    build-depends: Cabal-syntax ^>=3.10  common cabal-install-solver-dep-    build-depends: cabal-install-solver ^>=3.8+    build-depends: cabal-install-solver ^>=3.10  library     import: warnings, base-dep, cabal-dep, cabal-syntax-dep, cabal-install-solver-dep     default-language: Haskell2010+    default-extensions: TypeOperators      hs-source-dirs:   src     exposed-modules:@@ -83,6 +84,7 @@         Distribution.Client.CmdExec         Distribution.Client.CmdFreeze         Distribution.Client.CmdHaddock+        Distribution.Client.CmdHaddockProject         Distribution.Client.CmdInstall         Distribution.Client.CmdInstall.ClientInstallFlags         Distribution.Client.CmdInstall.ClientInstallTargetSelector@@ -98,7 +100,6 @@         Distribution.Client.Compat.ExecutablePath         Distribution.Client.Compat.Orphans         Distribution.Client.Compat.Prelude-        Distribution.Client.Compat.Process         Distribution.Client.Compat.Semaphore         Distribution.Client.Config         Distribution.Client.Configure@@ -166,6 +167,7 @@         Distribution.Client.Security.HTTP         Distribution.Client.Setup         Distribution.Client.SetupWrapper+        Distribution.Client.Signal         Distribution.Client.SolverInstallPlan         Distribution.Client.SourceFiles         Distribution.Client.SrcDist@@ -206,24 +208,24 @@         bytestring >= 0.10.6.0 && < 0.12,         containers >= 0.5.6.2  && < 0.7,         cryptohash-sha256 >= 0.11 && < 0.12,-        directory  >= 1.2.2.0  && < 1.4,+        directory  >= 1.3.7.0  && < 1.4,         echo       >= 0.1.3    && < 0.2,         edit-distance >= 0.2.2 && < 0.3,         exceptions >= 0.10.4   && < 0.11,         filepath   >= 1.4.0.0  && < 1.5,         hashable   >= 1.0      && < 1.5,         HTTP       >= 4000.1.5 && < 4000.5,-        mtl        >= 2.0      && < 2.3,+        mtl        >= 2.0      && < 2.4,         network-uri >= 2.6.0.2 && < 2.7,         pretty     >= 1.1      && < 1.2,         process    >= 1.2.3.0  && < 1.7,         random     >= 1.2      && < 1.3,         stm        >= 2.0      && < 2.6,         tar        >= 0.5.0.3  && < 0.6,-        time       >= 1.5.0.1  && < 1.12,+        time       >= 1.5.0.1  && < 1.13,         zlib       >= 0.5.3    && < 0.7,         hackage-security >= 0.6.2.0 && < 0.7,-        text       >= 1.2.3    && < 1.3,+        text       >= 1.2.3    && < 1.3 || >= 2.0 && < 2.1,         parsec     >= 3.1.13.0 && < 3.2,         regex-base  >= 0.94.0.0 && <0.95,         regex-posix >= 0.96.0.0 && <0.97,@@ -244,7 +246,11 @@     if flag(lukko)       build-depends: lukko >= 0.1 && <0.2 +   -- pull in process version with fixed waitForProcess error+   if impl(ghc >=8.2)+     build-depends: process >= 1.6.15.0 + executable cabal     import: warnings, base-dep, cabal-dep, cabal-syntax-dep     main-is: Main.hs@@ -267,6 +273,7 @@ test-suite unit-tests     import: warnings, base-dep, cabal-dep, cabal-syntax-dep, cabal-install-solver-dep     default-language: Haskell2010+    default-extensions: TypeOperators     ghc-options: -rtsopts -threaded      type: exitcode-stdio-1.0

@@ -1,5 +1,8 @@ -*-change-log-*- +3.10.1.0 Mikolaj Konarski <mikolaj@well-typed.com> March 2023+	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.1.0.md+ 3.8.1.0 Mikolaj Konarski <mikolaj@well-typed.com> August 2022 	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.8.1.0.md @@ -169,7 +172,7 @@ 	* Default changelog generated by 'cabal init' is now named 	  'CHANGELOG.md' (#5441). 	* Align output of 'new-build' command phases (#4040).-	* Add suport for specifying remote VCS dependencies via new+	* Add support for specifying remote VCS dependencies via new 	  'source-repository-package' stanzas in 'cabal.project' files 	  (#5351). @@ -206,7 +209,7 @@ 	* Use [lfxtb] letters to differentiate component kind instead of 	opaque "c" in dist-dir layout. 	* 'cabal configure' now supports '--enable-static', which can be-	used to build static libaries with GHC via GHC's `-staticlib`+	used to build static libraries with GHC via GHC's `-staticlib` 	flag. 	* 'cabal user-config now supports '--augment' which can append 	additional lines to a new or updated cabal config file.@@ -226,7 +229,7 @@ 	when it wasn't necessary (#4444). 	* Packages installed in sandboxes via 'add-source' now have 	their timestamps updated correctly and so will not be reinstalled-	unncecessarily if the main install command fails (#1375).+	unnecessarily if the main install command fails (#1375). 	* Add Windows device path support for copyFile, renameFile. Allows cabal 	new-build to use temporary store path of up to 32k length 	(#3972, #4914, #4515).@@ -577,9 +580,9 @@ 	* Improved bootstrap.sh  0.5.2 Duncan Coutts <duncan@haskell.org> Aug 2008-	* Suport building haddock documentaion+	* Support building haddock documentation 	* Self-reinstall now works on Windows-	* Allow adding symlinks to excutables into a separate bindir+	* Allow adding symlinks to executables into a separate bindir 	* New self-documenting config file 	* New install --reinstall flag 	* More helpful status messages in a couple places

@@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -78,6 +80,7 @@ import qualified Distribution.Client.CmdRepl      as CmdRepl import qualified Distribution.Client.CmdFreeze    as CmdFreeze import qualified Distribution.Client.CmdHaddock   as CmdHaddock+import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject import qualified Distribution.Client.CmdInstall   as CmdInstall import qualified Distribution.Client.CmdRun       as CmdRun import qualified Distribution.Client.CmdTest      as CmdTest@@ -113,6 +116,8 @@ import Distribution.Client.ManpageFlags       (ManpageFlags (..)) import Distribution.Client.Utils          ( determineNumJobs, relaxEncodingErrors )+import Distribution.Client.Signal+         ( installTerminationHandler ) import Distribution.Client.Version          ( cabalInstallVersion ) @@ -159,20 +164,22 @@ import System.FilePath          ( dropExtension, splitExtension                                 , takeExtension, (</>), (<.>) ) import System.IO                ( BufferMode(LineBuffering), hSetBuffering-                                , stderr, stdout )+                                , hPutStrLn, stderr, stdout ) import System.Directory         ( doesFileExist, getCurrentDirectory                                 , withCurrentDirectory) import Data.Monoid              (Any(..))-import Control.Exception        (try)+import Control.Exception        (AssertionFailed, assert, try)   -- | Entry point -- main :: IO () main = do+  installTerminationHandler   -- Enable line buffering so that we can get fast feedback even when piped.   -- This is especially important for CI and build systems.   hSetBuffering stdout LineBuffering+   -- If the locale encoding for CLI doesn't support all Unicode characters,   -- printing to it may fail unless we relax the handling of encoding errors   -- when writing to stderr and stdout.@@ -181,12 +188,20 @@   (args0, args1) <- break (== "--") <$> getArgs   mainWorker =<< (++ args1) <$> expandResponse args0 +-- | Check whether assertions are enabled and print a warning in that case.+warnIfAssertionsAreEnabled :: IO ()+warnIfAssertionsAreEnabled =+  assert False (return ()) `catch`+  (\(_e :: AssertionFailed) -> hPutStrLn stderr assertionsEnabledMsg)+    -- Andreas, 2022-12-30, issue #8654:+    -- The verbosity machinery is not in place at this point (option -v not parsed),+    -- so instead of using function @warn@, we print straight to stderr.+  where+    assertionsEnabledMsg =+      "Warning: this is a debug build of cabal-install with assertions enabled."+ mainWorker :: [String] -> IO () mainWorker args = do-  maybeScriptAndArgs <- case args of-    []     -> return Nothing-    (h:tl) -> (\b -> if b then Just (h:|tl) else Nothing) <$> CmdRun.validScript h-   topHandler $     case commandsRun (globalCommand commands) commands args of       CommandHelp   help                 -> printGlobalHelp help@@ -200,10 +215,23 @@               -> printNumericVersion           CommandHelp     help           -> printCommandHelp help           CommandList     opts           -> printOptionsList opts-          CommandErrors   errs           -> maybe (printErrors errs) go maybeScriptAndArgs where-            go (script:|scriptArgs) = CmdRun.handleShebang script scriptArgs-          CommandReadyToGo action        -> action globalFlags +          CommandErrors   errs           -> do+            -- Check whether cabal is called from a script, like #!/path/to/cabal.+            case args of+              []      -> printErrors errs+              script : scriptArgs -> CmdRun.validScript script >>= \case+                False -> printErrors errs+                True  -> do+                  -- In main operation (not help, version etc.) print warning if assertions are on.+                  warnIfAssertionsAreEnabled+                  CmdRun.handleShebang script scriptArgs++          CommandReadyToGo action        -> do+            -- In main operation (not help, version etc.) print warning if assertions are on.+            warnIfAssertionsAreEnabled+            action globalFlags+   where     printCommandHelp help = do       pname <- getProgName@@ -254,6 +282,8 @@       , newCmd  CmdRepl.replCommand           CmdRepl.replAction       , newCmd  CmdFreeze.freezeCommand       CmdFreeze.freezeAction       , newCmd  CmdHaddock.haddockCommand     CmdHaddock.haddockAction+      , newCmd  CmdHaddockProject.haddockProjectCommand+                                              CmdHaddockProject.haddockProjectAction       , newCmd  CmdInstall.installCommand     CmdInstall.installAction       , newCmd  CmdRun.runCommand             CmdRun.runAction       , newCmd  CmdTest.testCommand           CmdTest.testAction@@ -409,7 +439,7 @@       buildNumJobs = NoFlag       }     buildFlags_latest     = buildFlags {-      -- Take the 'jobs' setting '~/.cabal/config' into account.+      -- Take the 'jobs' setting config file into account.       buildNumJobs = Flag . Just . determineNumJobs $                      (numJobsConfigFlag `mappend` numJobsCmdLineFlag)       }

@@ -37,7 +37,7 @@ import Distribution.Client.Version            (cabalInstallVersion) import Distribution.Compiler                  (CompilerId (..)) import Distribution.FieldGrammar-import Distribution.Fields                   +import Distribution.Fields import Distribution.Package                   (PackageIdentifier (..), mkPackageName) import Distribution.PackageDescription        (FlagAssignment) import Distribution.Parsec

@@ -26,7 +26,7 @@ import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.PackageDescription.Parsec        (parseGenericPackageDescription, runParseResult)-import Distribution.Parsec                           (PWarning (..), showPError, showPWarning)+import Distribution.Parsec                           (PWarning (..), showPError) import Distribution.Simple.Utils                     (defaultPackageDesc, die', notice, warn) import System.IO                                     (hPutStr, stderr) @@ -55,8 +55,7 @@     pdfile <- defaultPackageDesc verbosity     (ws, ppd) <- readGenericPackageDescriptionCheck verbosity pdfile     -- convert parse warnings into PackageChecks-    -- Note: we /could/ pick different levels, based on warning type.-    let ws' = [ PackageDistSuspicious (showPWarning pdfile w) | w <- ws ]+    let ws' = map (wrapParseWarning pdfile) ws     -- flatten the generic package description into a regular package     -- description     -- TODO: this may give more warnings than it should give;@@ -111,4 +110,6 @@     return (not . any isCheckError $ packageChecks)    where-    printCheckMessages = traverse_ (warn verbosity . explanation)+    printCheckMessages :: [PackageCheck] -> IO ()+    printCheckMessages = traverse_ (warn verbosity) . map show+        -- xxx mapM_ o traverse?

@@ -118,7 +118,7 @@     runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes   where     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)-    cliConfig = commandLineFlagsToProjectConfig globalFlags flags +    cliConfig = commandLineFlagsToProjectConfig globalFlags flags                   mempty -- ClientInstallFlags, not needed here  -- | This defines what a 'TargetSelector' means for the @bench@ command.

@@ -6,6 +6,9 @@     buildCommand,     buildAction, +    BuildFlags(..),+    defaultBuildFlags,+     -- * Internals exposed for testing     selectPackageTargets,     selectComponentTarget@@ -98,7 +101,7 @@ -- buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO () buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings globalFlags-  = withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do+  = withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do     -- TODO: This flags defaults business is ugly     let onlyConfigure = fromFlag (buildOnlyConfigure defaultBuildFlags                                  <> buildOnlyConfigure buildFlags)

@@ -4,12 +4,12 @@ import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Client.Config+    ( defaultScriptBuildsDir ) import Distribution.Client.DistDirLayout     ( DistDirLayout(..), defaultDistDirLayout ) import Distribution.Client.ProjectConfig     ( findProjectRoot )-import Distribution.Client.ScriptUtils-    ( getScriptCacheDirectoryRoot ) import Distribution.Client.Setup     ( GlobalFlags ) import Distribution.ReadE ( succeedReadE )@@ -121,7 +121,7 @@     -- There is currently no good way to specify to only clean orphaned caches.     -- It would be better as part of an explicit gc step (see issue #3333)     toClean  <- Set.fromList <$> mapM canonicalizePath extraArgs-    cacheDir <- getScriptCacheDirectoryRoot+    cacheDir <- defaultScriptBuildsDir     existsCD <- doesDirectoryExist cacheDir     caches   <- if existsCD then listDirectory cacheDir else return []     paths    <- fmap concat . forM caches $ \cache -> do

@@ -72,6 +72,13 @@ renderListCommaAnd [x,x'] = x ++ " and " ++ x' renderListCommaAnd (x:xs) = x ++ ", " ++ renderListCommaAnd xs +renderListTabular :: [String] -> String+renderListTabular = ("\n"++) . unlines . map ("| * "++)++renderListPretty :: [String] -> String+renderListPretty xs = if length xs > 5 then renderListTabular xs+                                       else renderListCommaAnd xs+ -- | Render a list of things in the style @blah blah; this that; and the other@ renderListSemiAnd :: [String] -> String renderListSemiAnd []     = ""

@@ -115,6 +115,7 @@                          distDirLayout cabalDirLayout                          projectConfig                          localPackages+                         Nothing      let freezeConfig = projectFreezeConfig elaboratedPlan totalIndexState activeRepos         dryRun = buildSettingDryRun buildSettings@@ -233,4 +234,3 @@         | InstallPlan.Configured elab <- InstallPlan.toList plan         , elabLocalToProject elab         ]-

@@ -7,6 +7,8 @@     haddockCommand,     haddockAction, +    ClientHaddockFlags(..),+     -- * Internals exposed for testing     selectPackageTargets,     selectComponentTarget@@ -16,17 +18,23 @@ import Prelude ()  import Distribution.Client.ProjectOrchestration+import Distribution.Client.ProjectPlanning+         ( ElaboratedSharedConfig(..) ) import Distribution.Client.CmdErrorMessages import Distribution.Client.TargetProblem          ( TargetProblem (..), TargetProblem' ) import Distribution.Client.NixStyleOptions          ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.Setup-         ( GlobalFlags, ConfigFlags(..) )+         ( GlobalFlags, ConfigFlags(..), InstallFlags (..)) import Distribution.Simple.Setup          ( HaddockFlags(..), fromFlagOrDefault, trueArg ) import Distribution.Simple.Command          ( CommandUI(..), usageAlternatives, ShowOrParseArgs, OptionField, option )+import Distribution.Simple.Program.Builtin+         ( haddockProgram )+import Distribution.Simple.Program.Db+         ( addKnownProgram, reconfigurePrograms ) import Distribution.Verbosity          ( normal ) import Distribution.Simple.Utils@@ -118,11 +126,26 @@      printPlan verbosity baseCtx buildCtx -    buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx-    runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes+    progs <- reconfigurePrograms verbosity+               (haddockProgramPaths haddockFlags)+               (haddockProgramArgs haddockFlags)+             -- we need to insert 'haddockProgram' before we reconfigure it,+             -- otherwise 'set+           . addKnownProgram haddockProgram+           . pkgConfigCompilerProgs+           . elaboratedShared+           $ buildCtx+    let buildCtx' = buildCtx { elaboratedShared =+                               (elaboratedShared buildCtx)+                               { pkgConfigCompilerProgs = progs } }++    buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx'+    runProjectPostBuildPhase verbosity baseCtx buildCtx' buildOutcomes   where     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)-    cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here+    installDoc = fromFlagOrDefault True (installDocumentation installFlags)+    flags' = flags { installFlags = installFlags { installDocumentation = Flag installDoc } }+    cliConfig = commandLineFlagsToProjectConfig globalFlags flags' mempty -- ClientInstallFlags, not needed here  -- | This defines what a 'TargetSelector' means for the @haddock@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,

@@ -0,0 +1,337 @@+module Distribution.Client.CmdHaddockProject+  ( haddockProjectCommand+  , haddockProjectAction+  ) where++import Prelude ()+import Data.Bool (bool)+import Distribution.Client.Compat.Prelude hiding (get)++import qualified Distribution.Client.CmdBuild   as CmdBuild+import qualified Distribution.Client.CmdHaddock as CmdHaddock++import Distribution.Client.DistDirLayout      (DistDirLayout(..)+                                              ,CabalDirLayout(..)+                                              ,StoreDirLayout(..))+import Distribution.Client.InstallPlan        (foldPlanPackage)+import qualified Distribution.Client.InstallPlan as InstallPlan+import qualified Distribution.Client.NixStyleOptions as NixStyleOptions+import Distribution.Client.ProjectOrchestration+                                              (AvailableTarget(..)+                                              ,AvailableTargetStatus(..)+                                              ,CurrentCommand(..)+                                              ,ProjectBaseContext(..)+                                              ,ProjectBuildContext(..)+                                              ,TargetSelector(..)+                                              ,printPlan+                                              ,pruneInstallPlanToTargets+                                              ,resolveTargets+                                              ,runProjectPreBuildPhase+                                              ,selectComponentTargetBasic)+import Distribution.Client.ProjectPlanning    (ElaboratedConfiguredPackage(..)+                                              ,ElaboratedInstallPlan+                                              ,ElaboratedSharedConfig(..)+                                              ,TargetAction(..))+import Distribution.Client.ProjectPlanning.Types+                                              (elabDistDirParams)+import Distribution.Client.Setup              (GlobalFlags(..)+                                              ,ConfigFlags(..))+import Distribution.Client.ScriptUtils        (AcceptNoTargets(..)+                                              ,TargetContext(..)+                                              ,updateContextAndWriteProjectFile+                                              ,withContextAndSelectors)+import Distribution.Client.TargetProblem      (TargetProblem(..))++import Distribution.Types.PackageId (pkgName)+import Distribution.Types.PackageName (unPackageName)+import Distribution.Types.Version (mkVersion)+import Distribution.Types.VersionRange (orLaterVersion)+import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (..))+import Distribution.Simple.Command+         ( CommandUI(..) )+import Distribution.Simple.Compiler+         ( Compiler (..) )+import Distribution.Simple.Flag+        ( Flag(..)+        , flagElim+        , flagToList+        , fromFlag+        , fromFlagOrDefault+        )+import Distribution.Simple.InstallDirs+         ( toPathTemplate )+import Distribution.Simple.Haddock (createHaddockIndex)+import Distribution.Simple.Utils+         ( die', createDirectoryIfMissingVerbose+         , copyDirectoryRecursive, warn )+import Distribution.Simple.Program.Builtin+         ( haddockProgram )+import Distribution.Simple.Program.Db+         ( addKnownProgram, reconfigurePrograms, requireProgramVersion )+import Distribution.Simple.Setup+         ( HaddockFlags(..), defaultHaddockFlags+         , HaddockProjectFlags(..)+         , Visibility(..)+         , haddockProjectCommand+         )+import Distribution.Verbosity as Verbosity+         ( normal )++import System.FilePath          ( takeDirectory, normalise, (</>), (<.>) )+import System.Directory         ( doesDirectoryExist, doesFileExist )++haddockProjectAction :: HaddockProjectFlags -> [String] -> GlobalFlags -> IO ()+haddockProjectAction flags _extraArgs globalFlags = do+    -- create destination directory if it does not exist+    let outputDir = normalise $ fromFlag (haddockProjectDir flags)+    createDirectoryIfMissingVerbose verbosity True outputDir++    when ((2::Int) <=+            ( flagElim 0 (bool 0 1) (haddockProjectHackage flags)+            + flagElim 0 (bool 0 1) (haddockProjectLocal flags)+            + flagElim 0 (const 1)  (haddockProjectHtmlLocation flags)+            )) $+      die' verbosity "Options `--local`, `--hackage` and `--html-location` are mutually exclusive`"++    warn verbosity "haddock-project command is experimental, it might break in the future"++    -- build all packages with appropriate haddock flags+    let haddockFlags = defaultHaddockFlags+          { haddockHtml         = Flag True+          -- one can either use `--haddock-base-url` or+          -- `--haddock-html-location`.+          , haddockBaseUrl      = if localStyle+                                  then Flag ".."+                                  else NoFlag+          , haddockProgramPaths = haddockProjectProgramPaths  flags+          , haddockProgramArgs  = haddockProjectProgramArgs   flags+          , haddockHtmlLocation = if fromFlagOrDefault False (haddockProjectHackage flags)+                                  then Flag "https://hackage.haskell.org/package/$pkg-$version/docs"+                                  else haddockProjectHtmlLocation flags+          , haddockHoogle       = haddockProjectHoogle        flags+          , haddockExecutables  = haddockProjectExecutables   flags+          , haddockTestSuites   = haddockProjectTestSuites    flags+          , haddockBenchmarks   = haddockProjectBenchmarks    flags+          , haddockForeignLibs  = haddockProjectForeignLibs   flags+          , haddockInternal     = haddockProjectInternal      flags+          , haddockCss          = haddockProjectCss           flags+          , haddockLinkedSource = if localOrHackage+                                  then Flag True+                                  else haddockProjectLinkedSource flags+          , haddockQuickJump    = if localOrHackage+                                  then Flag True+                                  else haddockProjectQuickJump flags+          , haddockHscolourCss  = haddockProjectHscolourCss    flags+          , haddockContents     = if localStyle then Flag (toPathTemplate "../index.html")+                                                else NoFlag+          , haddockIndex        = if localStyle then Flag (toPathTemplate "../doc-index.html")+                                                else NoFlag+          , haddockKeepTempFiles= haddockProjectKeepTempFiles flags+          , haddockVerbosity    = haddockProjectVerbosity     flags+          , haddockLib          = haddockProjectLib           flags+          }+        nixFlags = (commandDefaultFlags CmdHaddock.haddockCommand)+                   { NixStyleOptions.haddockFlags = haddockFlags+                   , NixStyleOptions.configFlags  =+                       (NixStyleOptions.configFlags (commandDefaultFlags CmdBuild.buildCommand))+                       { configVerbosity = haddockProjectVerbosity flags }+                   }++    --+    -- Construct the build plan and infer the list of packages which haddocks+    -- we need.+    --++    withContextAndSelectors RejectNoTargets Nothing nixFlags ["all"] globalFlags HaddockCommand $ \targetCtx ctx targetSelectors -> do+      baseCtx <- case targetCtx of+        ProjectContext             -> return ctx+        GlobalContext              -> return ctx+        ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta+      let distLayout  = distDirLayout baseCtx+          cabalLayout = cabalDirLayout baseCtx+      buildCtx <-+        runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do+              -- Interpret the targets on the command line as build targets+              -- (as opposed to say repl or haddock targets).+              targets <- either reportTargetProblems return+                       $ resolveTargets+                           selectPackageTargets+                           selectComponentTargetBasic+                           elaboratedPlan+                           Nothing+                           targetSelectors++              let elaboratedPlan' = pruneInstallPlanToTargets+                                      TargetActionBuild+                                      targets+                                      elaboratedPlan+              return (elaboratedPlan', targets)++      printPlan verbosity baseCtx buildCtx++      let elaboratedPlan :: ElaboratedInstallPlan+          elaboratedPlan = elaboratedPlanOriginal buildCtx++          sharedConfig :: ElaboratedSharedConfig+          sharedConfig = elaboratedShared buildCtx++          pkgs :: [Either InstalledPackageInfo ElaboratedConfiguredPackage ]+          pkgs = matchingPackages elaboratedPlan++      progs <- reconfigurePrograms verbosity+                 (haddockProjectProgramPaths flags)+                 (haddockProjectProgramArgs flags)+               -- we need to insert 'haddockProgram' before we reconfigure it,+               -- otherwise 'set+             . addKnownProgram haddockProgram+             . pkgConfigCompilerProgs+             $ sharedConfig+      let sharedConfig' = sharedConfig { pkgConfigCompilerProgs = progs }++      _ <- requireProgramVersion+             verbosity haddockProgram+             (orLaterVersion (mkVersion [2,26,1])) progs++      --+      -- Build haddocks of each components+      --++      CmdHaddock.haddockAction+        nixFlags+        ["all"]+        globalFlags++      --+      -- Copy haddocks to the destination folder+      --++      packageInfos <- fmap (nub . concat) $ for pkgs $ \pkg ->+        case pkg of+          Left _ | not localStyle ->+            return []+          Left package -> do+            let packageName = unPackageName (pkgName $ sourcePackageId package)+                destDir = outputDir </> packageName+            fmap catMaybes $ for (haddockInterfaces package) $ \interfacePath -> do+              let docDir = takeDirectory interfacePath+              a <- doesFileExist interfacePath+              case a of+                True -> copyDirectoryRecursive verbosity docDir destDir+                     >> return (Just ( packageName+                                     , interfacePath+                                     , Hidden+                                     ))+                False -> return Nothing++          Right package ->+            case elabLocalToProject package of+              True -> do+                let distDirParams = elabDistDirParams sharedConfig' package+                    buildDir = distBuildDirectory distLayout distDirParams+                    packageName = unPackageName (pkgName $ elabPkgSourceId package)+                let docDir = buildDir+                         </> "doc" </> "html"+                         </> packageName+                    destDir = outputDir </> packageName+                    interfacePath = destDir+                                </> packageName <.> "haddock"+                a <- doesDirectoryExist docDir+                case a of+                  True  -> copyDirectoryRecursive verbosity docDir destDir+                        >> return [( packageName+                                   , interfacePath+                                   , Visible+                                   )]+                  False -> return []+              False | not localStyle ->+                return []+              False -> do+                let packageName = unPackageName (pkgName $ elabPkgSourceId package)+                    packageDir = storePackageDirectory (cabalStoreDirLayout cabalLayout)+                                   (compilerId (pkgConfigCompiler sharedConfig'))+                                   (elabUnitId package)+                    docDir = packageDir </> "share" </> "doc" </> "html"+                    destDir = outputDir </> packageName+                    interfacePath = destDir+                                </> packageName <.> "haddock"+                a <- doesDirectoryExist docDir+                case a of+                  True  -> copyDirectoryRecursive verbosity docDir destDir+                        -- non local packages will be hidden in haddock's+                        -- generated contents page+                        >> return [( packageName+                                   , interfacePath+                                   , Hidden+                                   )]+                  False -> return []++      --+      -- generate index, content, etc.+      --++      let flags' = flags+            { haddockProjectDir         = Flag outputDir+            , haddockProjectGenIndex    = if localOrHackage+                                          then Flag True+                                          else haddockProjectGenIndex flags+            , haddockProjectGenContents = if localOrHackage+                                          then Flag True+                                          else haddockProjectGenContents flags+            , haddockProjectQuickJump   = if localOrHackage+                                          then Flag True+                                          else haddockProjectQuickJump flags+            , haddockProjectLinkedSource = haddockLinkedSource haddockFlags+            , haddockProjectInterfaces  = Flag+                [ ( interfacePath+                  , Just packageName+                  , Just packageName+                  , visibility+                  )+                | (packageName, interfacePath, visibility) <- packageInfos+                ]+            }+      createHaddockIndex verbosity+                         (pkgConfigCompilerProgs sharedConfig')+                         (pkgConfigCompiler sharedConfig')+                         (pkgConfigPlatform sharedConfig')+                         flags'+  where+    verbosity = fromFlagOrDefault normal (haddockProjectVerbosity flags)++    -- Build a self contained directory which contains haddocks of all+    -- transitive dependencies; or depend on `--haddocks-html-location` to+    -- provide location of the documentation of dependencies.+    localStyle =+      let local    = fromFlagOrDefault False (haddockProjectLocal flags)+          hackage  = fromFlagOrDefault False (haddockProjectHackage flags)+          location = fromFlagOrDefault False (const True <$> haddockProjectHtmlLocation flags)+      in        local && not hackage && not location+         -- or if none of the flags is given set `localStyle` to `True`+         || not local && not hackage && not location+++    localOrHackage =+      any id $ flagToList (haddockProjectLocal flags)+            ++ flagToList (haddockProjectHackage flags)++    reportTargetProblems :: Show x => [x] -> IO a+    reportTargetProblems =+        die' verbosity . unlines . map show++    -- TODO: this is just a sketch+    selectPackageTargets :: TargetSelector+                         -> [AvailableTarget k]+                         -> Either (TargetProblem ()) [k]+    selectPackageTargets _ ts = Right $+      mapMaybe+        (\t -> case availableTargetStatus t of+            TargetBuildable k _ | availableTargetLocalToProject t+                                -> Just k+            _                   -> Nothing)+        ts++    matchingPackages :: ElaboratedInstallPlan+                     -> [Either InstalledPackageInfo ElaboratedConfiguredPackage]+    matchingPackages =+        fmap (foldPlanPackage Left Right)+      . InstallPlan.toList

@@ -33,7 +33,7 @@ import Distribution.Client.CmdInstall.ClientInstallTargetSelector  import Distribution.Client.Setup-         ( GlobalFlags(..), ConfigFlags(..) )+         ( GlobalFlags(..), ConfigFlags(..), InstallFlags(..) ) import Distribution.Client.Types          ( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage          , SourcePackageDb(..) )@@ -53,18 +53,19 @@ import Distribution.Client.ProjectConfig.Types          ( ProjectConfig(..), ProjectConfigShared(..)          , ProjectConfigBuildOnly(..), PackageConfig(..)+         , MapMappend(..)          , getMapLast, getMapMappend, projectConfigLogsDir          , projectConfigStoreDir, projectConfigBuildOnly          , projectConfigConfigFile ) import Distribution.Simple.Program.Db          ( userSpecifyPaths, userSpecifyArgss, defaultProgramDb-         , modifyProgramSearchPath, ProgramDb )+         , modifyProgramSearchPath ) import Distribution.Simple.BuildPaths          ( exeExtension ) import Distribution.Simple.Program.Find          ( ProgramSearchPathEntry(..) ) import Distribution.Client.Config-         ( defaultInstallPath, getCabalDir, loadConfig, SavedConfig(..) )+         ( defaultInstallPath, loadConfig, SavedConfig(..) ) import qualified Distribution.Simple.PackageIndex as PI import Distribution.Solver.Types.PackageIndex          ( lookupPackageName, searchByName )@@ -96,11 +97,11 @@ import Distribution.Simple.Flag          ( fromFlagOrDefault, flagToMaybe, flagElim ) import Distribution.Simple.Setup-         ( Flag(..) )+         ( Flag(..), installDirsOptions ) import Distribution.Solver.Types.SourcePackage          ( SourcePackage(..) ) import Distribution.Simple.Command-         ( CommandUI(..), usageAlternatives )+         ( CommandUI(..), usageAlternatives, optionName ) import Distribution.Simple.Configure          ( configCompilerEx ) import Distribution.Simple.Compiler@@ -124,12 +125,11 @@          , withTempDirectory, createDirectoryIfMissingVerbose          , ordNub ) import Distribution.Utils.Generic-         ( safeHead, writeFileAtomic )+         ( writeFileAtomic )  import qualified Data.ByteString.Lazy.Char8 as BS-import Data.Ord-         ( Down(..) ) import qualified Data.Map as Map+import qualified Data.Set as S import qualified Data.List.NonEmpty as NE import Distribution.Utils.NubList          ( fromNubList )@@ -150,7 +150,7 @@   , commandDescription  = Just $ \_ -> wrapText $     "Installs one or more packages. This is done by installing them "     ++ "in the store and symlinking/copying the executables in the directory "-    ++ "specified by the --installdir flag (`~/.cabal/bin/` by default). "+    ++ "specified by the --installdir flag (`~/.local/bin/` by default). "     ++ "If you want the installed executables to be available globally, "     ++ "make sure that the PATH environment variable contains that directory. "     ++ "\n\n"@@ -168,10 +168,15 @@       ++ "  " ++ pname ++ " v2-install ./pkgfoo\n"       ++ "    Install the package in the ./pkgfoo directory\n" -  , commandOptions      = nixStyleOptions clientInstallOptions+  , commandOptions      = \x -> filter notInstallDirOpt $ nixStyleOptions clientInstallOptions x   , commandDefaultFlags = defaultNixStyleFlags defaultClientInstallFlags   }+ where+  -- install doesn't take installDirs flags, since it always installs into the store in a fixed way.+  notInstallDirOpt x = not $ optionName x `elem` installDirOptNames+  installDirOptNames = map optionName installDirsOptions + -- | The @install@ command actually serves four different needs. It installs: -- * exes: --   For example a program from hackage. The behavior is similar to the old@@ -204,6 +209,15 @@     targetFilter   = if installLibs then Just LibKind else Just ExeKind     targetStrings' = if null targetStrings then ["."] else targetStrings +    -- Note the logic here is rather goofy. Target selectors of the form "foo:bar" also parse as uris.+    -- However, we want install to also take uri arguments. Hence, we only parse uri arguments in the case where+    -- no project file is present (including an implicit one derived from being in a package directory)+    -- or where the --ignore-project flag is passed explicitly. In such a case we only parse colon-free target selectors+    -- as selectors, and otherwise parse things as URIs.++    -- However, in the special case where --ignore-project is passed with no selectors, we want to act as though this is+    -- a "normal" ignore project that actually builds and installs the selected package.+     withProject :: IO ([PackageSpecifier UnresolvedSourcePackage], [URI], [TargetSelector], ProjectConfig)     withProject = do       let reducedVerbosity = lessVerbose verbosity@@ -233,7 +247,7 @@         packageTargets =           flip TargetPackageNamed targetFilter . pkgName <$> packageIds -      if null targetStrings'+      if null targetStrings'' -- if every selector is already resolved as a packageid, return without further parsing.         then return (packageSpecifiers, [], packageTargets, projectConfig localBaseCtx)         else do           targetSelectors <-@@ -250,11 +264,10 @@                  , selectors ++ packageTargets                  , projectConfig localBaseCtx ) -    withoutProject :: ProjectConfig -> IO ([PackageSpecifier pkg], [URI], [TargetSelector], ProjectConfig)+    withoutProject :: ProjectConfig -> IO ([PackageSpecifier UnresolvedSourcePackage], [URI], [TargetSelector], ProjectConfig)+    withoutProject _ | null targetStrings = withProject -- if there's no targets, we don't parse specially, but treat it as install in a standard cabal package dir     withoutProject globalConfig = do       tss <- traverse (parseWithoutProjectTargetSelector verbosity) targetStrings'--      cabalDir <- getCabalDir       let         projectConfig = globalConfig <> cliConfig @@ -268,8 +281,9 @@          mlogsDir = flagToMaybe projectConfigLogsDir         mstoreDir = flagToMaybe projectConfigStoreDir-        cabalDirLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir+      cabalDirLayout <- mkCabalDirLayout mstoreDir mlogsDir +      let         buildSettings = resolveBuildTimeSettings                           verbosity cabalDirLayout                           projectConfig@@ -363,14 +377,37 @@       (projectConfigBuildOnly config)       [ ProjectPackageRemoteTarball uri | uri <- uris ] +    -- check for targets already in env+    let getPackageName :: PackageSpecifier UnresolvedSourcePackage -> PackageName+        getPackageName (NamedPackage pn _) = pn+        getPackageName (SpecificSourcePackage (SourcePackage pkgId _ _ _)) = pkgName pkgId+        targetNames = S.fromList $ map getPackageName (specs ++ uriSpecs)+        envNames = S.fromList $ map getPackageName envSpecs+        forceInstall = fromFlagOrDefault False $ installOverrideReinstall installFlags+        nameIntersection = S.intersection targetNames envNames++    -- we check for intersections in targets with the existing env+    (envSpecs', nonGlobalEnvEntries') <- if null nameIntersection+      then pure (envSpecs, map snd nonGlobalEnvEntries)+      else if forceInstall+             then let es = filter (\e -> not $ getPackageName e `S.member` nameIntersection) envSpecs+                      nge = map snd . filter (\e -> not $ fst e `S.member` nameIntersection) $ nonGlobalEnvEntries+                  in pure (es, nge)+             else die' verbosity $ "Packages requested to install already exist in environment file at " ++ envFile ++ ". Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: " ++ intercalate ", " (map prettyShow $ S.toList nameIntersection)++    -- we construct an installed index of files in the cleaned target environment (absent overwrites) so that we can solve with regards to packages installed locally but not in the upstream repo+    let installedPacks = PI.allPackagesByName installedIndex+        newEnvNames = S.fromList $ map getPackageName envSpecs'+        installedIndex' = PI.fromList . concatMap snd . filter (\p -> fst p `S.member` newEnvNames) $ installedPacks+     baseCtx <- establishDummyProjectBaseContext                  verbosity                  config                  distDirLayout-                 (envSpecs ++ specs ++ uriSpecs)+                 (envSpecs' ++ specs ++ uriSpecs)                  InstallCommand -    buildCtx <- constructProjectBuildContext verbosity baseCtx targetSelectors+    buildCtx <- constructProjectBuildContext verbosity (baseCtx {installedPackages = Just installedIndex'}) targetSelectors      printPlan verbosity baseCtx buildCtx @@ -387,19 +424,31 @@     unless dryRun $       if installLibs       then installLibraries verbosity-           buildCtx compiler packageDbs progDb envFile nonGlobalEnvEntries+           buildCtx compiler packageDbs envFile nonGlobalEnvEntries'       else installExes verbosity            baseCtx buildCtx platform compiler configFlags clientInstallFlags   where     configFlags' = disableTestsBenchsByDefault configFlags     verbosity = fromFlagOrDefault normal (configVerbosity configFlags')     ignoreProject = flagIgnoreProject projectFlags-    cliConfig = commandLineFlagsToProjectConfig-                  globalFlags-                  flags { configFlags = configFlags' }-                  clientInstallFlags'+    baseCliConfig = commandLineFlagsToProjectConfig+                        globalFlags+                        flags { configFlags = configFlags' }+                        clientInstallFlags'+    cliConfig = addLocalConfigToTargets baseCliConfig targetStrings     globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) +-- | Treat all direct targets of install command as local packages: #8637+addLocalConfigToTargets :: ProjectConfig -> [String] -> ProjectConfig+addLocalConfigToTargets config targetStrings+    = config {+        projectConfigSpecificPackage = projectConfigSpecificPackage config+                                       <> MapMappend (Map.fromList targetPackageConfigs)+    }+  where+    localConfig = projectConfigLocalPackages config+    targetPackageConfigs = map (\x -> (mkPackageName x, localConfig)) targetStrings+ -- | Verify that invalid config options were not passed to the install command. -- -- If an invalid configuration is found the command will @die'@.@@ -605,7 +654,7 @@   installdir <- fromFlagOrDefault                 (warn verbosity installdirUnknown >> pure installPath) $                 pure <$> cinstInstalldir clientInstallFlags-  createDirectoryIfMissingVerbose verbosity False installdir+  createDirectoryIfMissingVerbose verbosity True installdir   warnIfNoExes verbosity buildCtx    installMethod <- flagElim defaultMethod return $@@ -640,29 +689,18 @@   -> ProjectBuildContext   -> Compiler   -> PackageDBStack-  -> ProgramDb   -> FilePath -- ^ Environment file   -> [GhcEnvironmentFileEntry]   -> IO () installLibraries verbosity buildCtx compiler-                 packageDbs programDb envFile envEntries = do-  -- Why do we get it again? If we updated a globalPackage then we need-  -- the new version.-  installedIndex <- getInstalledPackages verbosity compiler packageDbs programDb+                 packageDbs envFile envEntries = do   if supportsPkgEnvFiles $ getImplInfo compiler     then do       let-        getLatest :: PackageName -> [InstalledPackageInfo]-        getLatest = (=<<) (maybeToList . safeHead . snd) . take 1 . sortBy (comparing (Down . fst))-                  . PI.lookupPackageName installedIndex-        globalLatest = concat (getLatest <$> globalPackages)-         baseEntries =           GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs-        globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest         pkgEntries = ordNub $-              globalEntries-          ++ envEntries+             envEntries           ++ entriesForLibraryComponents (targetsMap buildCtx)         contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries)       createDirectoryIfMissing True (takeDirectory envFile)@@ -700,21 +738,12 @@     exeMaybe (ComponentTarget (CExeName exe) _) = Just exe     exeMaybe _                                  = Nothing -globalPackages :: [PackageName]-globalPackages = mkPackageName <$>-  [ "ghc", "hoopl", "bytestring", "unix", "base", "time", "hpc", "filepath"-  , "process", "array", "integer-gmp", "containers", "ghc-boot", "binary"-  , "ghc-prim", "ghci", "rts", "terminfo", "transformers", "deepseq"-  , "ghc-boot-th", "pretty", "template-haskell", "directory", "text"-  , "bin-package-db"-  ]- -- | Return the package specifiers and non-global environment file entries. getEnvSpecsAndNonGlobalEntries   :: PI.InstalledPackageIndex   -> [GhcEnvironmentFileEntry]   -> Bool-  -> ([PackageSpecifier a], [GhcEnvironmentFileEntry])+  -> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)]) getEnvSpecsAndNonGlobalEntries installedIndex entries installLibs =   if installLibs   then (envSpecs, envEntries')@@ -724,7 +753,7 @@  environmentFileToSpecifiers   :: PI.InstalledPackageIndex -> [GhcEnvironmentFileEntry]-  -> ([PackageSpecifier a], [GhcEnvironmentFileEntry])+  -> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)]) environmentFileToSpecifiers ipi = foldMap $ \case     (GhcEnvFilePackageId unitId)         | Just InstalledPackageInfo@@ -732,9 +761,7 @@           <- PI.lookupUnitId ipi unitId         , let pkgSpec = NamedPackage pkgName                         [PackagePropertyVersion (thisVersion pkgVersion)]-        -> if pkgName `elem` globalPackages-          then ([pkgSpec], [])-          else ([pkgSpec], [GhcEnvFilePackageId installedUnitId])+        -> ([pkgSpec], [(pkgName, GhcEnvFilePackageId installedUnitId)])     _ -> ([], [])  @@ -912,11 +939,10 @@   -> Flag FilePath   -> IO PackageDBStack getPackageDbStack compilerId storeDirFlag logsDirFlag = do-  cabalDir <- getCabalDir   mstoreDir <- traverse makeAbsolute $ flagToMaybe storeDirFlag   let     mlogsDir    = flagToMaybe logsDirFlag-    cabalLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir+  cabalLayout <- mkCabalDirLayout mstoreDir mlogsDir   pure $ storePackageDBStack (cabalStoreDirLayout cabalLayout) compilerId  -- | This defines what a 'TargetSelector' means for the @bench@ command.

@@ -66,7 +66,7 @@     "How to handle already existing symlinks."     cinstOverwritePolicy (\v flags -> flags { cinstOverwritePolicy = v })     $ reqArg "always|never|prompt"-        (parsecToReadE (\err -> "Error parsing overwrite-policy: " ++ err) (toFlag `fmap` parsec)) +        (parsecToReadE (\err -> "Error parsing overwrite-policy: " ++ err) (toFlag `fmap` parsec))         (map prettyShow . flagToList)   , option [] ["install-method"]     "How to install the executables."

@@ -34,7 +34,7 @@ import Distribution.Simple.BuildPaths            (dllExtension, exeExtension) import Distribution.Simple.Command               (CommandUI (..)) import Distribution.Simple.Setup                 (configVerbosity, fromFlagOrDefault)-import Distribution.Simple.Utils                 (die', wrapText)+import Distribution.Simple.Utils                 (die', withOutputMarker, wrapText) import Distribution.System                       (Platform) import Distribution.Types.ComponentName          (showComponentName) import Distribution.Types.UnitId                 (UnitId)@@ -78,7 +78,7 @@       _   -> die' verbosity "One target is required, given multiple"    -- configure and elaborate target selectors-  withContextAndSelectors RejectNoTargets (Just ExeKind) flags [target] globalFlags $ \targetCtx ctx targetSelectors -> do+  withContextAndSelectors RejectNoTargets (Just ExeKind) flags [target] globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do     baseCtx <- case targetCtx of       ProjectContext             -> return ctx       GlobalContext              -> return ctx@@ -133,7 +133,18 @@      case binfiles of         []     -> die' verbosity "No target found"-        [exe] -> putStrLn exe+        [exe]  -> putStr $ withOutputMarker verbosity $ exe ++ "\n"+                    -- Andreas, 2023-01-13, issue #8400:+                    -- Regular output of `list-bin` should go to stdout unconditionally,+                    -- but for the sake of the testsuite, we want to mark it so it goes+                    -- into the golden value for the test.+                    -- Note: 'withOutputMarker' only checks 'isVerboseMarkOutput',+                    -- thus, we can reuse @verbosity@ here, even if other components+                    -- of @verbosity@ may be wrong (like 'VStderr', verbosity level etc.).+                    -- Andreas, 2023-01-20:+                    -- Appending the newline character here rather than using 'putStrLn'+                    -- because an active 'withOutputMarker' produces text that ends+                    -- in newline characters.         _ -> die' verbosity "Multiple targets found"   where     defaultVerbosity = verboseStderr silent

@@ -30,7 +30,7 @@     , DistDirLayout(distProjectRootDirectory, distProjectFile) ) import Distribution.Client.ProjectConfig import Distribution.Client.ProjectConfig.Legacy-    ( instantiateProjectConfigSkeleton )+    ( instantiateProjectConfigSkeletonWithCompiler ) import Distribution.Client.ProjectFlags     ( projectFlagsOptions, ProjectFlags(..), defaultProjectFlags     , removeIgnoreProjectOption )@@ -306,7 +306,7 @@                       {- TODO: Support dist dir override -} Nothing   projectConfig <- runRebuild (distProjectRootDirectory distDirLayout) $ do                       pcs <- readProjectLocalFreezeConfig verbosity httpTransport distDirLayout-                      pure $ instantiateProjectConfigSkeleton os arch (compilerInfo compiler) mempty pcs+                      pure $ instantiateProjectConfigSkeletonWithCompiler os arch (compilerInfo compiler) mempty pcs   let ucnstrs = map fst . projectConfigConstraints . projectConfigShared                 $ projectConfig       deps    = userConstraintsToDependencies ucnstrs

@@ -75,7 +75,7 @@ import Distribution.Types.ComponentName          ( componentNameString ) import Distribution.Types.CondTree-         ( CondTree(..), traverseCondTreeC )+         ( CondTree(..) ) import Distribution.Types.Dependency          ( Dependency(..), mainLibSet ) import Distribution.Types.Library@@ -187,7 +187,7 @@ -- replAction :: NixStyleFlags (ReplOptions, EnvFlags) -> [String] -> GlobalFlags -> IO () replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetStrings globalFlags-  = withContextAndSelectors AcceptNoTargets (Just LibKind) flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do+  = withContextAndSelectors AcceptNoTargets (Just LibKind) flags targetStrings globalFlags ReplCommand $ \targetCtx ctx targetSelectors -> do     when (buildSettingOnlyDeps (buildSettings ctx)) $       die' verbosity $ "The repl command does not support '--only-dependencies'. "           ++ "You may wish to use 'build --only-dependencies' and then "@@ -338,7 +338,12 @@       | packageId pkg /= pkgId = SpecificSourcePackage pkg       | SourcePackage{..} <- pkg =         SpecificSourcePackage $ pkg { srcpkgDescription =-          srcpkgDescription & (\f -> L.allCondTrees $ traverseCondTreeC f)+          -- New dependencies are added to the original ones found in the+          -- `targetBuildDepends` field.+          -- `traverseBuildInfos` is used in order to update _all_ the+          -- occurrences of the field `targetBuildDepends`. It ensures that+          -- fields depending on the latter are also consistently updated.+          srcpkgDescription &  (L.traverseBuildInfos . L.targetBuildDepends)                             %~ (deps ++)         }     addDeps spec = spec

@@ -27,7 +27,8 @@          ( renderTargetSelector, showTargetSelector,            renderTargetProblem,            renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs,-           targetSelectorFilter, renderListCommaAnd )+           targetSelectorFilter, renderListCommaAnd,+           renderListPretty ) import Distribution.Client.TargetProblem          ( TargetProblem (..) ) @@ -42,11 +43,11 @@ import Distribution.Simple.Command          ( CommandUI(..), usageAlternatives ) import Distribution.Types.ComponentName-         ( showComponentName )+         ( componentNameRaw ) import Distribution.Verbosity          ( normal, silent ) import Distribution.Simple.Utils-         ( wrapText, die', info, notice )+         ( wrapText, die', info, notice, safeHead ) import Distribution.Client.ProjectPlanning          ( ElaboratedConfiguredPackage(..)          , ElaboratedInstallPlan, binDirectoryFor )@@ -64,6 +65,7 @@ import Distribution.Client.ScriptUtils          ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) ) +import Data.List (group) import qualified Data.Set as Set import System.Directory          ( doesFileExist )@@ -120,7 +122,7 @@ -- runAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO () runAction flags@NixStyleFlags {..} targetAndArgs globalFlags-  = withContextAndSelectors RejectNoTargets (Just ExeKind) flags targetStr globalFlags $ \targetCtx ctx targetSelectors -> do+  = withContextAndSelectors RejectNoTargets (Just ExeKind) flags targetStr globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do     (baseCtx, defaultVerbosity) <- case targetCtx of       ProjectContext             -> return (ctx, normal)       GlobalContext              -> return (ctx, normal)@@ -424,14 +426,13 @@ renderRunProblem (TargetProblemMatchesMultiple targetSelector targets) =     "The run command is for running a single executable at once. The target '"  ++ showTargetSelector targetSelector ++ "' refers to "- ++ renderTargetSelector targetSelector ++ " which includes "- ++ renderListCommaAnd ( ("the "++) <$>-                         showComponentName <$>-                         availableTargetComponentName <$>-                         foldMap-                           (\kind -> filterTargetsKind kind targets)-                           [ExeKind, TestKind, BenchKind] )- ++ "."+ ++ renderTargetSelector targetSelector ++ " which includes \n"+ ++ unlines ((\(label, xs) -> "- " ++ label ++ ": " ++ renderListPretty xs)+    <$> (zip ["executables", "test-suites", "benchmarks"]+     $  filter (not . null) . map removeDuplicates+     $  map (componentNameRaw . availableTargetComponentName)+    <$> (flip filterTargetsKind $ targets) <$> [ExeKind, TestKind, BenchKind] ))+    where removeDuplicates = catMaybes . map safeHead . group . sort  renderRunProblem (TargetProblemMultipleTargets selectorMap) =     "The run command is for running a single executable at once. The targets "

@@ -137,7 +137,7 @@ -------------------------------------------------------------------------------  sdistAction :: (ProjectFlags, SdistFlags) -> [String] -> GlobalFlags -> IO ()-sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do+sdistAction (pf@ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do     (baseCtx, distDirLayout) <- withProjectOrGlobalConfig verbosity flagIgnoreProject globalConfigFlag withProject withoutProject      let localPkgs = localPackages baseCtx@@ -196,6 +196,7 @@             { configVerbosity = sdistVerbosity             , configDistPref = sdistDistDir             }+          , projectFlags = pf           }         mempty 

@@ -85,7 +85,7 @@      ++ "  " ++ pname ++ " v2-update hackage.haskell.org,HEAD\n"      ++ "  " ++ pname ++ " v2-update hackage.haskell.org\n"      ++ "    Download hackage.haskell.org at a specific index state.\n\n"-     ++ "  " ++ pname ++ " new update hackage.haskell.org head.hackage\n"+     ++ "  " ++ pname ++ " v2-update hackage.haskell.org head.hackage\n"      ++ "    Download hackage.haskell.org and head.hackage\n"      ++ "    head.hackage must be a known repo-id. E.g. from\n"      ++ "    your cabal.project(.local) file.\n"

@@ -1,48 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Distribution.Client.Compat.Process--- Copyright   :  (c) 2013 Liu Hao, Brent Yorgey--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  cabal-devel@haskell.org--- Stability   :  provisional--- Portability :  portable------ Cross-platform utilities for invoking processes.-----------------------------------------------------------------------------------module Distribution.Client.Compat.Process (-  readProcessWithExitCode-) where--import Prelude (FilePath, IO, String, return, (||))--import           Control.Exception (catch, throw)-import           System.Exit       (ExitCode (ExitFailure))-import           System.IO.Error   (isDoesNotExistError, isPermissionError)-import qualified System.Process    as P---- | @readProcessWithExitCode@ creates an external process, reads its---   standard output and standard error strictly, waits until the---   process terminates, and then returns the @ExitCode@ of the---   process, the standard output, and the standard error.------   See the documentation of the version from @System.Process@ for---   more information.------   The version from @System.Process@ behaves inconsistently across---   platforms when an executable with the given name is not found: in---   some cases it returns an @ExitFailure@, in others it throws an---   exception.  This variant catches \"does not exist\" and---   \"permission denied\" exceptions and turns them into---   @ExitFailure@s.------ TODO: this doesn't use 'Distrubution.Compat.Process'.----readProcessWithExitCode :: FilePath -> [String] -> String -> IO (ExitCode, String, String)-readProcessWithExitCode cmd args input =-  P.readProcessWithExitCode cmd args input-    `catch` \e -> if isDoesNotExistError e || isPermissionError e-                    then return (ExitFailure 127, "", "")-                    else throw e

@@ -22,12 +22,14 @@     showConfigWithComments,     parseConfig, -    getCabalDir,     defaultConfigFile,     defaultCacheDir,+    defaultScriptBuildsDir,+    defaultStoreDir,     defaultCompiler,     defaultInstallPath,     defaultLogsDir,+    defaultReportsDir,     defaultUserInstall,      baseSavedConfig,@@ -46,6 +48,7 @@     postProcessRepo,   ) where +import Distribution.Compat.Environment (lookupEnv) import Distribution.Client.Compat.Prelude import Prelude () @@ -90,7 +93,7 @@          , Flag(..), toFlag, flagToMaybe, fromFlagOrDefault ) import Distribution.Simple.InstallDirs          ( InstallDirs(..), defaultInstallDirs-         , PathTemplate, toPathTemplate )+         , PathTemplate, toPathTemplate) import Distribution.Deprecated.ParseUtils          ( FieldDescr(..), liftField, runP          , ParseResult(..), PError(..), PWarning(..)@@ -130,7 +133,7 @@ import Text.PrettyPrint.HughesPJ          ( text, Doc ) import System.Directory-         ( createDirectoryIfMissing, getAppUserDataDirectory, renameFile )+         ( createDirectoryIfMissing, getHomeDirectory, getXdgDirectory, XdgDirectory(XdgCache, XdgConfig, XdgState), renameFile, getAppUserDataDirectory, doesDirectoryExist ) import Network.URI          ( URI(..), URIAuth(..), parseURI ) import System.FilePath@@ -138,7 +141,7 @@ import System.IO.Error          ( isDoesNotExistError ) import Distribution.Compat.Environment-         ( getEnvironment, lookupEnv )+         ( getEnvironment ) import qualified Data.Map as M import qualified Data.ByteString as BS @@ -302,6 +305,7 @@         installFineGrainedConflicts  = combine installFineGrainedConflicts,         installMinimizeConflictSet   = combine installMinimizeConflictSet,         installIndependentGoals      = combine installIndependentGoals,+        installPreferOldest          = combine installPreferOldest,         installShadowPkgs            = combine installShadowPkgs,         installStrongFlags           = combine installStrongFlags,         installAllowBootLibInstalls  = combine installAllowBootLibInstalls,@@ -487,6 +491,9 @@         haddockKeepTempFiles = combine haddockKeepTempFiles,         haddockVerbosity     = combine haddockVerbosity,         haddockCabalFilePath = combine haddockCabalFilePath,+        haddockIndex         = combine haddockIndex,+        haddockBaseUrl       = combine haddockBaseUrl,+        haddockLib           = combine haddockLib,         haddockArgs          = lastNonEmpty haddockArgs         }         where@@ -535,7 +542,7 @@ -- baseSavedConfig :: IO SavedConfig baseSavedConfig = do-  userPrefix <- getCabalDir+  userPrefix <- defaultInstallPrefix   cacheDir   <- defaultCacheDir   logsDir    <- defaultLogsDir   return mempty {@@ -583,40 +590,91 @@     }   } -defaultCabalDir :: IO FilePath-defaultCabalDir = getAppUserDataDirectory "cabal"--getCabalDir :: IO FilePath-getCabalDir = do+-- | If @CABAL\_DIR@ is set or @~/.cabal@ exists, return that+-- directory.  Otherwise returns Nothing.  If this function returns+-- Nothing, then it implies that we are not using a single directory+-- for everything, but instead use XDG paths.  Fundamentally, this+-- function is used to implement transparent backwards compatibility+-- with pre-XDG versions of cabal-install.+maybeGetCabalDir :: IO (Maybe FilePath)+maybeGetCabalDir = do   mDir <- lookupEnv "CABAL_DIR"   case mDir of-    Nothing -> defaultCabalDir-    Just dir -> return dir+    Just dir -> return $ Just dir+    Nothing -> do+      defaultDir <- getAppUserDataDirectory "cabal"+      dotCabalExists <- doesDirectoryExist defaultDir+      return $ if dotCabalExists+               then Just defaultDir+               else Nothing +-- | The default behaviour of cabal-install is to use the XDG+-- directory standard.  However, if @CABAL_DIR@ is set, we instead use+-- that directory as a single store for everything cabal-related, like+-- the old @~/.cabal@ behaviour.  Also, for backwards compatibility,+-- if @~/.cabal@ exists we treat that as equivalent to @CABAL_DIR@+-- being set.  This function abstracts that decision-making.+getDefaultDir :: XdgDirectory -> FilePath -> IO FilePath+getDefaultDir xdg subdir = do+  mDir <- maybeGetCabalDir+  case mDir of+    Just dir -> return $ dir </> subdir+    Nothing -> getXdgDirectory xdg $ "cabal" </> subdir++-- | The default prefix used for installation.+defaultInstallPrefix :: IO FilePath+defaultInstallPrefix = do+  mDir <- maybeGetCabalDir+  case mDir of+    Just dir ->+      return dir+    Nothing -> do+      dir <- getHomeDirectory+      return $ dir </> ".local"+ defaultConfigFile :: IO FilePath-defaultConfigFile = do-  dir <- getCabalDir-  return $ dir </> "config"+defaultConfigFile =+  getDefaultDir XdgConfig "config"  defaultCacheDir :: IO FilePath-defaultCacheDir = do-  dir <- getCabalDir-  return $ dir </> "packages"+defaultCacheDir =+  getDefaultDir XdgCache "packages" +defaultScriptBuildsDir :: IO FilePath+defaultScriptBuildsDir =+  getDefaultDir XdgCache "script-builds"++defaultStoreDir :: IO FilePath+defaultStoreDir =+  getDefaultDir XdgState "store"+ defaultLogsDir :: IO FilePath-defaultLogsDir = do-  dir <- getCabalDir-  return $ dir </> "logs"+defaultLogsDir =+  getDefaultDir XdgCache "logs" +defaultReportsDir :: IO FilePath+defaultReportsDir =+  getDefaultDir XdgCache "reports"+ defaultExtraPath :: IO [FilePath] defaultExtraPath = do-  dir <- getCabalDir-  return [dir </> "bin"]+  mDir <- maybeGetCabalDir+  case mDir of+    Just dir ->+      return [dir </> "bin"]+    Nothing -> do+      dir <- getHomeDirectory+      return [dir </> ".local" </> "bin"]  defaultInstallPath :: IO FilePath defaultInstallPath = do-  dir <- getCabalDir-  return (dir </> "bin")+  mDir <- maybeGetCabalDir+  case mDir of+    Just dir ->+      return $ dir </> "bin"+    Nothing -> do+      dir <- getHomeDirectory+      return $ dir </> ".local" </> "bin"  defaultCompiler :: CompilerFlavor defaultCompiler = fromMaybe GHC defaultCompilerFlavor@@ -632,7 +690,7 @@     str  = "hackage.haskell.org"     name = RepoName str     uri  = URI "http:" (Just (URIAuth "" str "")) "/" "" ""-    -- Note that lots of old ~/.cabal/config files will have the old url+    -- Note that lots of old config files will have the old url     -- http://hackage.haskell.org/packages/archive     -- but new config files can use the new url (without the /packages/archive)     -- and avoid having to do a http redirect@@ -1426,7 +1484,7 @@       unlines (map (showPWarning "Error parsing additional config lines") ws)  -- | Get the differences (as a pseudo code diff) between the user's--- '~/.cabal/config' and the one that cabal would generate if it didn't exist.+-- config file and the one that cabal would generate if it didn't exist. userConfigDiff :: Verbosity -> GlobalFlags -> [String] -> IO [String] userConfigDiff verbosity globalFlags extraLines = do   userConfig <- loadRawConfig normal (globalConfigFile globalFlags)@@ -1473,7 +1531,7 @@         in (topAndTail left, topAndTail (drop 1 right))  --- | Update the user's ~/.cabal/config' keeping the user's customizations.+-- | Update the user's config file keeping the user's customizations. userConfigUpdate :: Verbosity -> GlobalFlags -> [String] -> IO () userConfigUpdate verbosity globalFlags extraLines = do   userConfig  <- loadRawConfig normal (globalConfigFile globalFlags)

@@ -73,8 +73,8 @@ import Distribution.PackageDescription.Configuration          ( finalizePD ) import Distribution.Version-         ( Version, mkVersion, anyVersion, thisVersion-         , VersionRange, orLaterVersion )+         ( Version, anyVersion, thisVersion+         , VersionRange ) import Distribution.Simple.Utils as Utils          ( warn, notice, debug, die'          , defaultPackageDesc )@@ -84,21 +84,12 @@ import System.FilePath ( (</>) )  -- | Choose the Cabal version such that the setup scripts compiled against this--- version will support the given command-line flags.+-- version will support the given command-line flags. Currently, it implements no+-- specific restrictions and allows any version, unless the second argument is+-- filled with a 'Version', in which case this version is picked. chooseCabalVersion :: ConfigExFlags -> Maybe Version -> VersionRange-chooseCabalVersion configExFlags maybeVersion =-  maybe defaultVersionRange thisVersion maybeVersion-  where-    -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed-    -- for '--allow-newer' to work.-    allowNewer = isRelaxDeps-                 (maybe mempty unAllowNewer $ configAllowNewer configExFlags)-    allowOlder = isRelaxDeps-                 (maybe mempty unAllowOlder $ configAllowOlder configExFlags)--    defaultVersionRange = if allowOlder || allowNewer-                          then orLaterVersion (mkVersion [1,19,2])-                          else anyVersion+chooseCabalVersion _configExFlags maybeVersion =+  maybe anyVersion thisVersion maybeVersion  -- | Configure the package found in the local directory configure :: Verbosity

@@ -109,7 +109,7 @@ import qualified Distribution.Solver.Types.ComponentDeps as CD import           Distribution.Solver.Types.ConstraintSource import           Distribution.Solver.Types.DependencyResolver-import           Distribution.Solver.Types.InstalledPreference+import           Distribution.Solver.Types.InstalledPreference as Preference import           Distribution.Solver.Types.LabeledPackageConstraint import           Distribution.Solver.Types.OptionalStanza import           Distribution.Solver.Types.PackageConstraint@@ -400,6 +400,9 @@       , pkgname <- [ mkPackageName "base"                    , mkPackageName "ghc-bignum"                    , mkPackageName "ghc-prim"+                   , mkPackageName "ghc-boot"+                   , mkPackageName "ghc"+                   , mkPackageName "ghci"                    , mkPackageName "integer-gmp"                    , mkPackageName "integer-simple"                    , mkPackageName "template-haskell"@@ -767,13 +770,14 @@       [ (pkgname, pref)       | PackageInstalledPreference pkgname pref <- prefs ]     installPrefDefault = case defaultPref of-      PreferAllLatest         -> const PreferLatest-      PreferAllInstalled      -> const PreferInstalled+      PreferAllLatest         -> const Preference.PreferLatest+      PreferAllOldest         -> const Preference.PreferOldest+      PreferAllInstalled      -> const Preference.PreferInstalled       PreferLatestForSelected -> \pkgname ->         -- When you say cabal install foo, what you really mean is, prefer the         -- latest version of foo, but the installed version of everything else-        if pkgname `Set.member` selected then PreferLatest-                                         else PreferInstalled+        if pkgname `Set.member` selected then Preference.PreferLatest+                                         else Preference.PreferInstalled      stanzasPref :: PackageName -> [OptionalStanza]     stanzasPref pkgname =@@ -1019,8 +1023,9 @@                           (installPref pkg, versionPref pkg, packageVersion pkg)         installPref   :: UnresolvedSourcePackage -> Bool         installPref   = case preferInstalled of-          PreferLatest    -> const False-          PreferInstalled -> not . null+          Preference.PreferLatest    -> const False+          Preference.PreferOldest    -> const False+          Preference.PreferInstalled -> not . null                            . InstalledPackageIndex.lookupSourcePackageId                                                      installedPkgIndex                            . packageId

@@ -49,6 +49,13 @@      --      PreferAllLatest +     -- | Always prefer the oldest version irrespective of any existing+     -- installed version or packages explicitly requested.+     --+     -- * This is enabled by --prefer-oldest.+     --+   | PreferAllOldest+      -- | Always prefer the installed versions over ones that would need to be      -- installed. Secondarily, prefer latest versions (eg the latest installed      -- version or if there are none then the latest source version).

@@ -27,6 +27,8 @@  import System.FilePath +import Distribution.Client.Config+         ( defaultStoreDir, defaultLogsDir) import Distribution.Package          ( PackageId, PackageIdentifier, ComponentId, UnitId ) import Distribution.Compiler@@ -292,19 +294,16 @@       storeIncomingDirectory compid </> prettyShow unitid <.> "lock"  -defaultCabalDirLayout :: FilePath -> CabalDirLayout-defaultCabalDirLayout cabalDir =-    mkCabalDirLayout cabalDir Nothing Nothing+defaultCabalDirLayout :: IO CabalDirLayout+defaultCabalDirLayout =+    mkCabalDirLayout Nothing Nothing -mkCabalDirLayout :: FilePath -- ^ Cabal directory-                 -> Maybe FilePath -- ^ Store directory. Must be absolute+mkCabalDirLayout :: Maybe FilePath -- ^ Store directory. Must be absolute                  -> Maybe FilePath -- ^ Log directory-                 -> CabalDirLayout-mkCabalDirLayout cabalDir mstoreDir mlogDir =-    CabalDirLayout {..}-  where-    cabalStoreDirLayout :: StoreDirLayout-    cabalStoreDirLayout =-        defaultStoreDirLayout (fromMaybe (cabalDir </> "store") mstoreDir)-    cabalLogsDirectory :: FilePath-    cabalLogsDirectory = fromMaybe (cabalDir </> "logs") mlogDir+                 -> IO CabalDirLayout+mkCabalDirLayout mstoreDir mlogDir = do+    cabalStoreDirLayout <-+      defaultStoreDirLayout <$> maybe defaultStoreDir pure mstoreDir+    cabalLogsDirectory <-+      maybe defaultLogsDir pure mlogDir+    pure $ CabalDirLayout {..}

@@ -11,7 +11,7 @@ -- -- Functions for fetching packages ------------------------------------------------------------------------------{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} module Distribution.Client.FetchUtils (      -- * fetching packages@@ -22,6 +22,7 @@     -- ** specifically for repo packages     checkRepoTarballFetched,     fetchRepoTarball,+    verifyFetchedTarball,      -- ** fetching packages asynchronously     asyncFetchPackages,@@ -43,7 +44,7 @@ import Distribution.Package          ( PackageId, packageName, packageVersion ) import Distribution.Simple.Utils-         ( notice, info, debug, die' )+         ( notice, info, debug, warn, die' ) import Distribution.Verbosity          ( verboseUnmarkOutput ) import Distribution.Client.GlobalFlags@@ -56,7 +57,8 @@ import Control.Concurrent.Async import Control.Concurrent.MVar import System.Directory-         ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )+         ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory+         , getFileSize ) import System.IO          ( openTempFile, hClose ) import System.FilePath@@ -67,6 +69,8 @@          ( URI(uriPath) )  import qualified Hackage.Security.Client as Sec+import qualified Hackage.Security.Util.Path as Sec+import qualified Hackage.Security.Util.Checked as Sec  -- ------------------------------------------------------------ -- * Actually fetch things@@ -118,6 +122,38 @@       then return (Just file)       else return Nothing +verifyFetchedTarball :: Verbosity -> RepoContext -> Repo -> PackageId -> IO Bool+verifyFetchedTarball verbosity repoCtxt repo pkgid =+   let file = packageFile repo pkgid+       handleError :: IO Bool -> IO Bool+       handleError act = do+         res <- Safe.try act+         case res of+           Left e -> warn verbosity ("Error verifying fetched tarball " ++ file ++ ", will redownload: " ++ show (e :: SomeException)) >> pure False+           Right b -> pure b+   in handleError $ do+        exists <- doesFileExist file+        if not exists+          then return True -- if the file does not exist, it vacuously passes validation, since it will be downloaded as necessary with what we will then check is a valid hash.+          else case repo of+            -- a secure repo has hashes we can compare against to confirm this is the correct file.+                RepoSecure{} ->+                 repoContextWithSecureRepo repoCtxt repo $ \repoSecure ->+                   Sec.withIndex repoSecure $ \callbacks ->+                     let warnAndFail s = warn verbosity ("Fetched tarball " ++ file ++ " does not match server, will redownload: " ++ s) >> return False+                     -- the do block in parens is due to dealing with the checked exceptions mechanism.+                     in (do fileInfo <- Sec.indexLookupFileInfo callbacks pkgid+                            sz <- Sec.FileLength . fromInteger <$> getFileSize file+                            if sz /= Sec.fileInfoLength (Sec.trusted fileInfo)+                              then warnAndFail "file length mismatch"+                              else do+                                res <- Sec.compareTrustedFileInfo (Sec.trusted fileInfo) <$> Sec.computeFileInfo (Sec.Path file :: Sec.Path Sec.Absolute)+                                if res+                                  then pure True+                                  else warnAndFail "file hash mismatch")+                       `Sec.catchChecked` (\(e :: Sec.InvalidPackageException) -> warnAndFail (show e))+                       `Sec.catchChecked` (\(e :: Sec.VerificationError) -> warnAndFail (show e))+                _ -> pure True  -- | Fetch a package if we don't have it already. --@@ -290,7 +326,7 @@ -- ------------------------------------------------------------  -- | Generate the full path to the locally cached copy of--- the tarball for a given @PackageIdentifer@.+-- the tarball for a given @PackageIdentifier@. -- packageFile :: Repo -> PackageId -> FilePath packageFile repo pkgid = packageDir repo pkgid@@ -298,7 +334,7 @@                      <.> "tar.gz"  -- | Generate the full path to the directory where the local cached copy of--- the tarball for a given @PackageIdentifer@ is stored.+-- the tarball for a given @PackageIdentifier@ is stored. -- packageDir :: Repo -> PackageId -> FilePath packageDir (RepoLocalNoIndex (LocalRepo _ dir _) _) _pkgid = dir

@@ -19,7 +19,7 @@ import Distribution.Client.Compat.Prelude  import Distribution.Client.Utils-         ( incVersion )+         ( hasElem, incVersion ) import Distribution.Client.Freeze          ( getFreezePkgs ) import Distribution.Client.Setup@@ -40,7 +40,7 @@ import Distribution.Simple.Program          ( ProgramDb ) import Distribution.Simple.Utils-         ( tryFindPackageDesc )+         ( notice, tryFindPackageDesc ) import Distribution.System          ( Platform ) import Distribution.Version@@ -106,33 +106,29 @@     case epd of       Left _ -> putStrLn "finalizePD failed"       Right (pd,_) -> do-        let needBounds = filter (not . hasUpperBound . depVersion) $+       let needBounds = map depName $ filter (not . hasUpperBound . depVersion) $                          enabledBuildDepends pd defaultComponentRequestedSpec -        if (null needBounds)-          then putStrLn-               "Congratulations, all your dependencies have upper bounds!"-          else go needBounds-  where-     go needBounds = do        pkgs  <- getFreezePkgs                   verbosity packageDBs repoCtxt comp platform progdb                   globalFlags freezeFlags -       putStrLn boundsNeededMsg--       let isNeeded pkg = unPackageName (packageName pkg)-                          `elem` map depName needBounds+       let isNeeded = hasElem needBounds . unPackageName . packageName        let thePkgs = filter isNeeded pkgs         let padTo = maximum $ map (length . unPackageName . packageName) pkgs-       traverse_ (putStrLn . (++",") . showBounds padTo) thePkgs -     depName :: Dependency -> String-     depName (Dependency pn _ _) = unPackageName pn+       if null thePkgs then notice verbosity+         "Congratulations, all your dependencies have upper bounds!"+        else do+         notice verbosity boundsNeededMsg+         traverse_ (notice verbosity . (++",") . showBounds padTo) thePkgs -     depVersion :: Dependency -> VersionRange-     depVersion (Dependency _ vr _) = vr+depName :: Dependency -> String+depName (Dependency pn _ _) = unPackageName pn++depVersion :: Dependency -> VersionRange+depVersion (Dependency _ vr _) = vr  -- | The message printed when some dependencies are found to be lacking proper -- PVP-mandated bounds.

@@ -31,7 +31,7 @@ import Distribution.Simple.Setup          ( Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe ) import Distribution.Simple.Utils-         ( notice, die', info, writeFileAtomic )+         ( notice, die', info, warn, writeFileAtomic ) import qualified Distribution.PackageDescription as PD import Distribution.Simple.Program          ( programName )@@ -49,8 +49,11 @@ import Distribution.Client.IndexUtils         ( getSourcePackagesAtIndexState, TotalIndexState, ActiveRepos ) import Distribution.Solver.Types.SourcePackage+import Distribution.PackageDescription.PrettyPrint+        ( writeGenericPackageDescription )  import qualified Data.Map as Map+import Control.Monad ( mapM_ ) import System.Directory          ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist ) import System.FilePath@@ -94,16 +97,26 @@   unless (null prefix) $     createDirectoryIfMissing True prefix -  if useSourceRepo-    then clone  pkgs-    else unpack pkgs+  if onlyPkgDescr+    then do+      when useSourceRepo $+        warn verbosity $+          "Ignoring --source-repository for --only-package-description" +      mapM_ (unpackOnlyPkgDescr verbosity prefix) pkgs+    else+      if useSourceRepo+        then clone pkgs+        else unpack pkgs+   where     resolverParams :: SourcePackageDb -> [PackageSpecifier UnresolvedSourcePackage] -> DepResolverParams     resolverParams sourcePkgDb pkgSpecifiers =         --TODO: add command-line constraint and preference args for unpack         standardInstallPolicy mempty sourcePkgDb pkgSpecifiers +    onlyPkgDescr = fromFlagOrDefault False (getOnlyPkgDescr getFlags)+     prefix :: String     prefix = fromFlagOrDefault "" (getDestDir getFlags) @@ -188,6 +201,23 @@                       ++ " with the latest revision from the index."         writeFileAtomic descFilePath pkgtxt ++-- | Write a @pkgId.cabal@ file with the package description to the destination+-- directory, unless one already exists.+unpackOnlyPkgDescr :: Verbosity -> FilePath -> UnresolvedSourcePackage -> IO ()+unpackOnlyPkgDescr verbosity dstDir pkg = do+    let pkgFile = dstDir </> prettyShow (packageId pkg) <.> "cabal"+    existsFile <- doesFileExist pkgFile+    when existsFile $ die' verbosity $+      "The file \"" ++ pkgFile ++ "\" already exists, not overwriting."+    existsDir <- doesDirectoryExist (addTrailingPathSeparator pkgFile)+    when existsDir $ die' verbosity $+      "A directory \"" ++ pkgFile ++ "\" is in the way, not unpacking."+    notice verbosity $ "Writing package description to " ++ pkgFile+    case srcpkgDescrOverride pkg of+      Just pkgTxt -> writeFileAtomic pkgFile pkgTxt+      Nothing ->+        writeGenericPackageDescription pkgFile (srcpkgDescription pkg)  -- ------------------------------------------------------------ -- * Cloning packages from their declared source repositories

@@ -41,7 +41,7 @@                        -> IO () regenerateHaddockIndex verbosity pkgs progdb index = do       (paths, warns) <- haddockPackagePaths pkgs' Nothing-      let paths' = [ (interface, html) | (interface, Just html, _) <- paths]+      let paths' = [ (interface, html) | (interface, Just html, _, _) <- paths]       for_ warns (debug verbosity)        (confHaddock, _, _) <-

@@ -500,7 +500,7 @@             warningMsg     =  "the 'wget' transport currently doesn't support"                            ++ " range requests, which wastes network bandwidth."                            ++ " To fix this, set 'http-transport' to 'curl' or"-                           ++ " 'plain-http' in '~/.cabal/config'."+                           ++ " 'plain-http' in '~/.config/cabal/config'."                            ++ " Note that the 'plain-http' transport doesn't"                            ++ " support HTTPS.\n" 

@@ -123,7 +123,7 @@ mkCommonStanza :: WriteOpts -> PrettyField FieldAnnotation mkCommonStanza opts = case specHasCommonStanzas $ _optCabalSpec opts of   NoCommonStanzas -> PrettyEmpty-  _ -> PrettySection +  _ -> PrettySection     annNoComments     "common"     [text "warnings"]@@ -136,7 +136,7 @@         NoCommonStanzas -> PrettyEmpty         _ -> field "import" (hsep . map text) ["warnings"]           ["Import common warning flags."]-          False +          False           opts      , field "exposed-modules" formatExposedModules (toList expMods)@@ -182,9 +182,9 @@           NoCommonStanzas -> PrettyEmpty           _ -> field "import" (hsep . map text) ["warnings"]             ["Import common warning flags."]-            False +            False             opts-      +       , field "main-is" unsafeFromHs exeMain          [".hs or .lhs file containing the Main module."]          True@@ -230,9 +230,9 @@            NoCommonStanzas -> PrettyEmpty            _ -> field "import" (hsep . map text) ["warnings"]              ["Import common warning flags."]-             False +             False              opts-      +        , field "default-language" id lang          ["Base language which the package is written in."]          True

@@ -297,7 +297,7 @@ packageNamePrompt :: Interactive m => SourcePackageDb -> InitFlags -> m PackageName packageNamePrompt srcDb flags = getPackageName flags $ do     defName <- case packageDir flags of-        Flag b -> return $ filePathToPkgName b+        Flag b -> filePathToPkgName b         NoFlag -> currentDirPkgName      go $ DefaultPrompt defName@@ -416,7 +416,7 @@     let h2010   = "Haskell2010"         h98     = "Haskell98"         ghc2021 = "GHC2021 (requires at least GHC 9.2)"-          +     l <- promptList ("Choose a language for your " ++ pkgType)       [h2010, h98, ghc2021]       (DefaultPrompt h2010)@@ -427,13 +427,7 @@       | l == h2010       -> return Haskell2010       | l == h98         -> return Haskell98       | l == ghc2021     -> return GHC2021-      | all isAlphaNum l -> return $ UnknownLanguage l-      | otherwise        -> do-        putStrLn-          $ "\nThe language must be alphanumeric. "-          ++ "Please enter a different language."--        languagePrompt flags pkgType+      | otherwise        -> return $ UnknownLanguage l  noCommentsPrompt :: Interactive m => InitFlags -> m Bool noCommentsPrompt flags = getNoComments flags $ do

@@ -139,7 +139,7 @@       return $ ProjectSettings         (mkOpts comments cabalSpec) pkgDesc (Just libTarget)         (Just exeTarget) testTarget-    +     TestSuite -> do       testTarget <- genTestTarget initFlags comp pkgIx cabalSpec @@ -358,7 +358,7 @@            otherModules' <- libOtherModulesHeuristics flags           return $ filter (`notElem` otherModules') modulesNames-        +         else           return [] 

@@ -27,7 +27,6 @@   ) where  import Distribution.Client.Compat.Prelude hiding (readFile, (<|>), many)-import Distribution.Utils.Generic (safeLast)  import Distribution.Simple.Setup (fromFlagOrDefault) @@ -40,7 +39,7 @@ import Distribution.CabalSpecVersion import Language.Haskell.Extension import Distribution.Version-import Distribution.Types.PackageName (PackageName, mkPackageName)+import Distribution.Types.PackageName (PackageName) import Distribution.Simple.Compiler import qualified Data.Set as Set import Distribution.FieldGrammar.Newtypes@@ -82,24 +81,7 @@  -- | Guess the package name based on the given root directory. guessPackageName :: Interactive m => FilePath -> m PackageName-guessPackageName = fmap (mkPackageName . repair . fromMaybe "" . safeLast . splitDirectories)-                 . canonicalizePathNoThrow-  where-    -- Treat each span of non-alphanumeric characters as a hyphen. Each-    -- hyphenated component of a package name must contain at least one-    -- alphabetic character. An arbitrary character ('x') will be prepended if-    -- this is not the case for the first component, and subsequent components-    -- will simply be run together. For example, "1+2_foo-3" will become-    -- "x12-foo3".-    repair = repair' ('x' :) id-    repair' invalid valid x = case dropWhile (not . isAlphaNum) x of-        "" -> repairComponent ""-        x' -> let (c, r) = first repairComponent $ span isAlphaNum x'-              in c ++ repairRest r-      where-        repairComponent c | all isDigit c = invalid c-                          | otherwise     = valid c-    repairRest = repair' id ('-' :)+guessPackageName = filePathToPkgName  -- | Try to guess the license from an already existing @LICENSE@ file in --   the package directory, comparing the file contents with the ones@@ -125,7 +107,7 @@ guessPackageType flags = do   if fromFlagOrDefault False (initializeTestSuite flags)     then-      return TestSuite +      return TestSuite     else do       let lastDir dirs   = L.last . splitDirectories $ dirs           srcCandidates  = [defaultSourceDir, "src", "source"]

@@ -16,7 +16,7 @@ import qualified Data.List.NonEmpty as NEL import Distribution.Client.Init.Utils (currentDirPkgName, mkPackageNameDep, fixupDocFiles) import Distribution.Client.Init.Defaults-import Distribution.Simple.Flag (fromFlagOrDefault, flagElim, Flag(..))+import Distribution.Simple.Flag (fromFlagOrDefault, flagElim, Flag (..)) import Distribution.Client.Init.FlagExtractors import qualified Data.Set as Set import Distribution.Types.Dependency@@ -170,6 +170,6 @@       return $ initFlags         { dependencies = Flag $ based ++ as         }-  _ -> do+  NoFlag -> do     based <- dependenciesPrompt pkgIx initFlags     return initFlags { dependencies = Flag based }

@@ -72,7 +72,7 @@ import qualified System.IO  import qualified System.Directory as P-import qualified System.Process as P+import qualified System.Process as Process import qualified Distribution.Compat.Environment as P import System.FilePath import Distribution.FieldGrammar.Newtypes (SpecLicense)@@ -342,7 +342,7 @@     doesDirectoryExist = P.doesDirectoryExist     doesFileExist = P.doesFileExist     canonicalizePathNoThrow = P.canonicalizePathNoThrow-    readProcessWithExitCode = P.readProcessWithExitCode+    readProcessWithExitCode = Process.readProcessWithExitCode     getEnvironment = P.getEnvironment     getCurrentYear = P.getCurrentYear     listFilesInside = P.listFilesInside

@@ -23,9 +23,9 @@ ) where  -import qualified Prelude+import qualified Prelude () import Distribution.Client.Compat.Prelude hiding (putStrLn, empty, readFile, Parsec, many)-import Distribution.Utils.Generic (isInfixOf)+import Distribution.Utils.Generic (isInfixOf, safeLast)  import Control.Monad (forM) @@ -38,7 +38,6 @@ import Distribution.ModuleName (ModuleName) import Distribution.InstalledPackageInfo (InstalledPackageInfo, exposed) import qualified Distribution.Package as P-import qualified Distribution.Types.PackageName as PN import Distribution.Simple.PackageIndex (InstalledPackageIndex, moduleNameIndex) import Distribution.Simple.Setup (Flag(..)) import Distribution.Utils.String (trim)@@ -277,11 +276,28 @@       Flag x -> x                   < CabalSpecV2_0       NoFlag -> defaultCabalVersion < CabalSpecV2_0 -filePathToPkgName :: FilePath -> P.PackageName-filePathToPkgName = PN.mkPackageName . Prelude.last . splitDirectories+filePathToPkgName :: Interactive m => FilePath -> m P.PackageName+filePathToPkgName = fmap (mkPackageName . repair . fromMaybe "" . safeLast . splitDirectories)+                 . canonicalizePathNoThrow+  where+    -- Treat each span of non-alphanumeric characters as a hyphen. Each+    -- hyphenated component of a package name must contain at least one+    -- alphabetic character. An arbitrary character ('x') will be prepended if+    -- this is not the case for the first component, and subsequent components+    -- will simply be run together. For example, "1+2_foo-3" will become+    -- "x12-foo3".+    repair = repair' ('x' :) id+    repair' invalid valid x = case dropWhile (not . isAlphaNum) x of+        "" -> repairComponent ""+        x' -> let (c, r) = first repairComponent $ span isAlphaNum x'+              in c ++ repairRest r+      where+        repairComponent c | all isDigit c = invalid c+                          | otherwise     = valid c+    repairRest = repair' id ('-' :)  currentDirPkgName :: Interactive m => m P.PackageName-currentDirPkgName = filePathToPkgName <$> getCurrentDirectory+currentDirPkgName = filePathToPkgName =<< getCurrentDirectory  mkPackageNameDep :: PackageName -> Dependency mkPackageNameDep pkg = mkDependency pkg anyVersion (NES.singleton LMainLibName)

@@ -71,7 +71,7 @@          , ConfigExFlags(..), InstallFlags(..)          , filterTestFlags ) import Distribution.Client.Config-         ( getCabalDir, defaultUserInstall )+         ( defaultReportsDir, defaultUserInstall ) import Distribution.Client.Tar (extractTarGzFile) import Distribution.Client.Types as Source import Distribution.Client.BuildReports.Types@@ -197,7 +197,7 @@         warn verbosity $ "--root-cmd is no longer supported, "         ++ "see https://github.com/haskell/cabal/issues/3353"         ++ " (if you didn't type --root-cmd, comment out root-cmd"-        ++ " in your ~/.cabal/config file)"+        ++ " in your ~/.config/cabal/config file)"     let userOrSandbox = fromFlag (configUserInstall configFlags)     unless userOrSandbox $         warn verbosity $ "the --global flag is deprecated -- "@@ -831,10 +831,10 @@ storeDetailedBuildReports :: Verbosity -> FilePath                           -> [(BuildReports.BuildReport, Maybe Repo)] -> IO () storeDetailedBuildReports verbosity logsDir reports = sequence_-  [ do dotCabal <- getCabalDir+  [ do allReportsDir <- defaultReportsDir        let logFileName = prettyShow (BuildReports.package report) <.> "log"            logFile     = logsDir </> logFileName-           reportsDir  = dotCabal </> "reports" </> unRepoName (remoteRepoName remoteRepo)+           reportsDir  = allReportsDir </> unRepoName (remoteRepoName remoteRepo)            reportFile  = reportsDir </> logFileName         handleMissingLogFile $ do

@@ -27,15 +27,14 @@ import Distribution.Client.Init.Utils   (trim) import Distribution.Client.ManpageFlags import Distribution.Client.Setup        (globalCommand)+import Distribution.Compat.Process      (proc) import Distribution.Simple.Command-import Distribution.Simple.Flag         (fromFlagOrDefault)+import Distribution.Simple.Flag         (fromFlag, fromFlagOrDefault) import Distribution.Simple.Utils-  ( IOData(..), IODataMode(..), createProcessWithEnv, ignoreSigPipe, rawSystemStdInOut )-import qualified Distribution.Verbosity as Verbosity+  ( IOData(..), IODataMode(..), ignoreSigPipe, rawSystemStdInOut, rawSystemProcAction,+    fromCreatePipe, die' ) import System.IO                        (hClose, hPutStr) import System.Environment               (lookupEnv)-import System.FilePath                  (takeFileName)- import qualified System.Process as Process  data FileInfo = FileInfo String String -- ^ path, description@@ -47,7 +46,7 @@ -- | A list of files that should be documented in the manual page. files :: [FileInfo] files =-  [ (FileInfo "~/.cabal/config" "The defaults that can be overridden with command-line options.")+  [ (FileInfo "~/.config/cabal/config" "The defaults that can be overridden with command-line options.")   ]  manpageCmd :: String -> [CommandSpec a] -> ManpageFlags -> IO ()@@ -69,7 +68,7 @@          -- Feed contents into @nroff -man /dev/stdin@         (formatted, _errors, ec1) <- rawSystemStdInOut-          Verbosity.normal+          verbosity           "nroff"           [ "-man", "/dev/stdin" ]           Nothing  -- Inherit working directory@@ -79,26 +78,23 @@          unless (ec1 == ExitSuccess) $ exitWith ec1 -        pager <- fromMaybe "less" <$> lookupEnv "PAGER"-        -- 'less' is borked with color sequences otherwise-        let pagerArgs = if takeFileName pager == "less" then ["-R"] else []+        pagerAndArgs <- fromMaybe "less -R" <$> lookupEnv "PAGER"+        -- 'less' is borked with color sequences otherwise, hence -R+        (pager, pagerArgs) <- case words pagerAndArgs of+          []     -> die' verbosity "man: empty value of the PAGER environment variable"+          (p:pa) -> pure (p, pa)         -- Pipe output of @nroff@ into @less@-        (Just inLess, _, _, procLess) <- createProcessWithEnv-          Verbosity.normal-          pager-          pagerArgs-          Nothing  -- Inherit working directory-          Nothing  -- Inherit environment-          Process.CreatePipe  -- in-          Process.Inherit     -- out-          Process.Inherit     -- err--        hPutStr inLess formatted-        hClose  inLess-        exitWith =<< Process.waitForProcess procLess+        (ec2, _) <- rawSystemProcAction verbosity+            (proc pager pagerArgs) { Process.std_in = Process.CreatePipe }+              $ \mIn _ _ -> do+          let wIn = fromCreatePipe mIn+          hPutStr wIn formatted+          hClose  wIn+        exitWith ec2   where     contents :: String     contents = manpage pname commands+    verbosity = fromFlag $ manpageVerbosity flags  -- | Produces a manual page with @troff@ markup. manpage :: String -> [CommandSpec a] -> String

@@ -196,6 +196,7 @@        pkgHashDebugInfo           :: DebugInfoLevel,        pkgHashProgramArgs         :: Map String [String],        pkgHashExtraLibDirs        :: [FilePath],+       pkgHashExtraLibDirsStatic  :: [FilePath],        pkgHashExtraFrameworkDirs  :: [FilePath],        pkgHashExtraIncludeDirs    :: [FilePath],        pkgHashProgPrefix          :: Maybe PathTemplate,@@ -215,7 +216,10 @@        pkgHashHaddockCss          :: Maybe FilePath,        pkgHashHaddockLinkedSource :: Bool,        pkgHashHaddockQuickJump    :: Bool,-       pkgHashHaddockContents     :: Maybe PathTemplate+       pkgHashHaddockContents     :: Maybe PathTemplate,+       pkgHashHaddockIndex        :: Maybe PathTemplate,+       pkgHashHaddockBaseUrl      :: Maybe String,+       pkgHashHaddockLib          :: Maybe String  --     TODO: [required eventually] pkgHashToolsVersions     ? --     TODO: [required eventually] pkgHashToolsExtraOptions ?@@ -290,6 +294,7 @@       , opt   "stripped-exe" True  prettyShow pkgHashStripExes       , opt   "debug-info"   NormalDebugInfo (show . fromEnum) pkgHashDebugInfo       , opt   "extra-lib-dirs"     [] unwords pkgHashExtraLibDirs+      , opt   "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic       , opt   "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs       , opt   "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs       , opt   "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix@@ -309,6 +314,9 @@       , opt   "haddock-hyperlink-source" False prettyShow pkgHashHaddockLinkedSource       , opt   "haddock-quickjump" False prettyShow pkgHashHaddockQuickJump       , opt   "haddock-contents-location" Nothing (maybe "" fromPathTemplate) pkgHashHaddockContents+      , opt   "haddock-index-location" Nothing (maybe "" fromPathTemplate) pkgHashHaddockIndex+      , opt   "haddock-base-url" Nothing (fromMaybe "") pkgHashHaddockBaseUrl+      , opt   "haddock-lib" Nothing (fromMaybe "") pkgHashHaddockLib        ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs   where

@@ -119,7 +119,7 @@          ( PathTemplate, fromPathTemplate          , toPathTemplate, substPathTemplate, initialPathTemplateEnv ) import Distribution.Simple.Utils-         ( die', warn, notice, info, createDirectoryIfMissingVerbose, rawSystemIOWithEnv )+         ( die', warn, notice, info, createDirectoryIfMissingVerbose, maybeExit, rawSystemIOWithEnv ) import Distribution.Client.Utils          ( determineNumJobs ) import Distribution.Utils.NubList@@ -254,6 +254,7 @@     solverSettingIndexState        = flagToMaybe projectConfigIndexState     solverSettingActiveRepos       = flagToMaybe projectConfigActiveRepos     solverSettingIndependentGoals  = fromFlag projectConfigIndependentGoals+    solverSettingPreferOldest      = fromFlag projectConfigPreferOldest   --solverSettingShadowPkgs        = fromFlag projectConfigShadowPkgs   --solverSettingReinstall         = fromFlag projectConfigReinstall   --solverSettingAvoidReinstalls   = fromFlag projectConfigAvoidReinstalls@@ -274,7 +275,8 @@        projectConfigStrongFlags       = Flag (StrongFlags False),        projectConfigAllowBootLibInstalls = Flag (AllowBootLibInstalls False),        projectConfigOnlyConstrained   = Flag OnlyConstrainedNone,-       projectConfigIndependentGoals  = Flag (IndependentGoals False)+       projectConfigIndependentGoals  = Flag (IndependentGoals False),+       projectConfigPreferOldest      = Flag (PreferOldest False)      --projectConfigShadowPkgs        = Flag False,      --projectConfigReinstall         = Flag False,      --projectConfigAvoidReinstalls   = Flag False,@@ -465,7 +467,7 @@     -> Flag Bool                  -- ^ whether to ignore local project (--ignore-project flag)     -> Flag FilePath              -- ^ @--cabal-config@     -> IO a                       -- ^ with project-    -> (ProjectConfig -> IO a)    -- ^ without projet+    -> (ProjectConfig -> IO a)    -- ^ without project     -> IO a withProjectOrGlobalConfig verbosity (Flag True) gcf _with without = do     globalConfig <- runRebuild "" $ readGlobalConfig verbosity gcf@@ -620,7 +622,7 @@     writeFile file . showProjectConfig  --- | Read the user's @~/.cabal/config@ file.+-- | Read the user's cabal-install config file. -- readGlobalConfig :: Verbosity -> Flag FilePath -> Rebuild ProjectConfig readGlobalConfig verbosity configFileFlag = do@@ -1175,8 +1177,7 @@         -- Run post-checkout-command if it is specified         for_ repoGroupWithPaths $ \(repo, _, repoPath) ->             for_ (nonEmpty (srpCommand repo)) $ \(cmd :| args) -> liftIO $ do-                exitCode <- rawSystemIOWithEnv verbosity cmd args (Just repoPath) Nothing Nothing Nothing Nothing-                unless (exitCode == ExitSuccess) $ exitWith exitCode+                maybeExit $ rawSystemIOWithEnv verbosity cmd args (Just repoPath) Nothing Nothing Nothing Nothing          -- But for reading we go through each 'SourceRepo' including its subdir         -- value and have to know which path each one ended up in.

@@ -7,7 +7,8 @@    -- Project config skeletons     ProjectConfigSkeleton,     parseProjectSkeleton,-    instantiateProjectConfigSkeleton,+    instantiateProjectConfigSkeletonFetchingCompiler,+    instantiateProjectConfigSkeletonWithCompiler,     singletonProjectConfigSkeleton,     projectSkeletonImports, @@ -44,7 +45,7 @@          ( ClientInstallFlags(..), defaultClientInstallFlags          , clientInstallOptions ) -import Distribution.Compat.Lens (view)+import Distribution.Compat.Lens (view, toListOf)  import Distribution.Solver.Types.ConstraintSource @@ -52,7 +53,7 @@ import Distribution.Package import Distribution.Types.SourceRepo (RepoType) import Distribution.Types.CondTree-         ( CondTree (..), CondBranch (..), mapTreeConds, traverseCondTreeC )+         ( CondTree (..), CondBranch (..), mapTreeConds, traverseCondTreeC, traverseCondTreeV, ignoreConditions ) import Distribution.PackageDescription          ( dispFlagAssignment, Condition (..), ConfVar (..), FlagAssignment ) import Distribution.PackageDescription.Configuration (simplifyWithSysParams)@@ -66,7 +67,7 @@          , TestFlags(..), testOptions', defaultTestFlags          , BenchmarkFlags(..), benchmarkOptions', defaultBenchmarkFlags          , programDbPaths', splitArgs, DumpBuildInfo (NoDumpBuildInfo, DumpBuildInfo)-         , readPackageDb, showPackageDb+         , readPackageDb, showPackageDb, installDirsOptions          ) import Distribution.Client.NixStyleOptions (NixStyleFlags (..)) import Distribution.Client.ProjectFlags (ProjectFlags (..), projectFlagsOptions, defaultProjectFlags)@@ -101,7 +102,7 @@ import Distribution.Client.ParseUtils import Distribution.Simple.Command          ( CommandUI(commandOptions), ShowOrParseArgs(..)-         , OptionField, option, reqArg' )+         , OptionField(..), option, reqArg' ) import Distribution.Types.PackageVersionConstraint          ( PackageVersionConstraint ) import Distribution.Parsec (ParsecParser, parsecToken)@@ -116,7 +117,7 @@ import Distribution.Fields.ConfVar (parseConditionConfVarFromClause)  import Distribution.Client.HttpUtils-import System.FilePath ((</>), isPathSeparator, makeValid)+import System.FilePath ((</>), isPathSeparator, makeValid, isAbsolute, takeDirectory) import System.Directory (createDirectoryIfMissing)  @@ -135,8 +136,16 @@ singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton singletonProjectConfigSkeleton x = CondNode x mempty mempty -instantiateProjectConfigSkeleton :: OS -> Arch -> CompilerInfo -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig-instantiateProjectConfigSkeleton os arch impl _flags skel = go $ mapTreeConds (fst . simplifyWithSysParams os arch impl) skel+instantiateProjectConfigSkeletonFetchingCompiler :: Monad m =>  m (OS, Arch, CompilerInfo) -> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig+instantiateProjectConfigSkeletonFetchingCompiler fetch flags skel+   | null (toListOf traverseCondTreeV skel) = pure $ fst (ignoreConditions skel)+   | otherwise = do+       (os, arch, impl) <- fetch+       pure $ instantiateProjectConfigSkeletonWithCompiler os arch impl flags skel+++instantiateProjectConfigSkeletonWithCompiler :: OS -> Arch -> CompilerInfo -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig+instantiateProjectConfigSkeletonWithCompiler os arch impl _flags skel = go $ mapTreeConds (fst . simplifyWithSysParams os arch impl) skel     where         go :: CondTree                FlagName@@ -215,7 +224,8 @@             createDirectoryIfMissing True cacheDir             _ <- downloadURI httpTransport verbosity uri fp             BS.readFile fp-         Nothing -> BS.readFile pci+         Nothing -> BS.readFile $+           if isAbsolute pci then pci else takeDirectory source </> pci      modifiesCompiler :: ProjectConfig -> Bool     modifiesCompiler pc = isSet projectConfigHcFlavor || isSet projectConfigHcPath || isSet projectConfigHcPkg@@ -346,9 +356,17 @@         splitConfig pc = (pc                          , mempty { packageConfigProgramPaths = packageConfigProgramPaths pc                                   , packageConfigProgramPathExtra = packageConfigProgramPathExtra pc-                                  , packageConfigDocumentation = packageConfigDocumentation pc }) --- | Convert from the types currently used for the user-wide @~/.cabal/config@+                                  -- Some flags to haddock should be passed to dependencies+                                  , packageConfigDocumentation = packageConfigDocumentation pc+                                  , packageConfigHaddockHoogle = packageConfigHaddockHoogle pc+                                  , packageConfigHaddockHtml = packageConfigHaddockHtml pc+                                  , packageConfigHaddockInternal = packageConfigHaddockInternal pc+                                  , packageConfigHaddockQuickJump = packageConfigHaddockQuickJump pc+                                  , packageConfigHaddockLinkedSource = packageConfigHaddockLinkedSource pc+                                  })++-- | Convert from the types currently used for the user-wide Cabal config -- file into the 'ProjectConfig' type. -- -- Only a subset of the 'ProjectConfig' can be represented in the user-wide@@ -484,7 +502,7 @@       configHcPath              = projectConfigHcPath,       configHcPkg               = projectConfigHcPkg,     --configProgramPathExtra    = projectConfigProgPathExtra DELETE ME-    --configInstallDirs         = projectConfigInstallDirs,+      configInstallDirs         = projectConfigInstallDirs,     --configUserInstall         = projectConfigUserInstall,       configPackageDBs          = projectConfigPackageDBs     } = configFlags@@ -514,6 +532,7 @@       installMinimizeConflictSet = projectConfigMinimizeConflictSet,       installPerComponent       = projectConfigPerComponent,       installIndependentGoals   = projectConfigIndependentGoals,+      installPreferOldest       = projectConfigPreferOldest,     --installShadowPkgs         = projectConfigShadowPkgs,       installStrongFlags        = projectConfigStrongFlags,       installAllowBootLibInstalls = projectConfigAllowBootLibInstalls,@@ -595,7 +614,10 @@       haddockLinkedSource       = packageConfigHaddockLinkedSource,       haddockQuickJump          = packageConfigHaddockQuickJump,       haddockHscolourCss        = packageConfigHaddockHscolourCss,-      haddockContents           = packageConfigHaddockContents+      haddockContents           = packageConfigHaddockContents,+      haddockIndex              = packageConfigHaddockIndex,+      haddockBaseUrl            = packageConfigHaddockBaseUrl,+      haddockLib                = packageConfigHaddockLib     } = haddockFlags      TestFlags {@@ -724,7 +746,8 @@     configFlags = mempty {       configVerbosity     = projectConfigVerbosity,       configDistPref      = projectConfigDistDir,-      configPackageDBs    = projectConfigPackageDBs+      configPackageDBs    = projectConfigPackageDBs,+      configInstallDirs   = projectConfigInstallDirs     }      configExFlags = ConfigExFlags {@@ -756,6 +779,7 @@       installFineGrainedConflicts = projectConfigFineGrainedConflicts,       installMinimizeConflictSet = projectConfigMinimizeConflictSet,       installIndependentGoals  = projectConfigIndependentGoals,+      installPreferOldest      = projectConfigPreferOldest,       installShadowPkgs        = mempty, --projectConfigShadowPkgs,       installStrongFlags       = projectConfigStrongFlags,       installAllowBootLibInstalls = projectConfigAllowBootLibInstalls,@@ -821,7 +845,7 @@       configOptimization        = mempty,       configProgPrefix          = mempty,       configProgSuffix          = mempty,-      configInstallDirs         = mempty,+      configInstallDirs         = projectConfigInstallDirs,       configScratchDir          = mempty,       configDistPref            = mempty,       configCabalFilePath       = mempty,@@ -956,6 +980,9 @@       haddockKeepTempFiles = mempty,       haddockVerbosity     = mempty,       haddockCabalFilePath = mempty,+      haddockIndex         = packageConfigHaddockIndex,+      haddockBaseUrl       = packageConfigHaddockBaseUrl,+      haddockLib           = packageConfigHaddockLib,       haddockArgs          = mempty     } @@ -1115,7 +1142,7 @@         (Disp.text . showPackageDb) (fmap readPackageDb parsecToken)         configPackageDBs (\v conf -> conf { configPackageDBs = v })       ]-  . filterFields ["verbose", "builddir" ]+  . filterFields (["verbose", "builddir"] ++ map optionName installDirsOptions)   . commandOptionsToFields   $ configureOptions ParseArgs @@ -1165,7 +1192,7 @@       , "jobs", "keep-going", "offline", "per-component"         -- solver flags:       , "max-backjumps", "reorder-goals", "count-conflicts"-      , "fine-grained-conflicts" , "minimize-conflict-set", "independent-goals"+      , "fine-grained-conflicts" , "minimize-conflict-set", "independent-goals", "prefer-oldest"       , "strong-flags" , "allow-boot-library-installs"       , "reject-unconstrained-dependencies", "index-state"       ]@@ -1275,7 +1302,8 @@       , "foreign-libraries"       , "executables", "tests", "benchmarks", "all", "internal", "css"       , "hyperlink-source", "quickjump", "hscolour-css"-      , "contents-location", "keep-temp-files"+      , "contents-location", "index-location", "keep-temp-files", "base-url"+      , "lib"       ]   . commandOptionsToFields   ) (haddockOptions ParseArgs)@@ -1310,7 +1338,6 @@       []   . commandOptionsToFields   ) (benchmarkOptions' ParseArgs)-    where     overrideFieldCompiler =

@@ -61,7 +61,7 @@ import Distribution.Simple.Setup          ( Flag, HaddockTarget(..), TestShowDetails(..), DumpBuildInfo (..) ) import Distribution.Simple.InstallDirs-         ( PathTemplate )+         ( PathTemplate, InstallDirs ) import Distribution.Utils.NubList          ( NubList ) @@ -73,7 +73,7 @@  -- | This type corresponds directly to what can be written in the -- @cabal.project@ file. Other sources of configuration can also be injected--- into this type, such as the user-wide @~/.cabal/config@ file and the+-- into this type, such as the user-wide config file and the -- command line of @cabal configure@ or @cabal build@. -- -- Since it corresponds to the external project file it is an instance of@@ -169,12 +169,11 @@        projectConfigHcPkg             :: Flag FilePath,        projectConfigHaddockIndex      :: Flag PathTemplate, -       -- Things that only make sense for manual mode, not --local mode+       -- Only makes sense for manual mode, not --local mode        -- too much control!      --projectConfigUserInstall       :: Flag Bool,-     --projectConfigInstallDirs       :: InstallDirs (Flag PathTemplate),-     --TODO: [required eventually] decide what to do with InstallDirs-     -- currently we don't allow it to be specified in the config file++       projectConfigInstallDirs       :: InstallDirs (Flag PathTemplate),        projectConfigPackageDBs        :: [Maybe PackageDB],         -- configuration used both by the solver and other phases@@ -203,6 +202,7 @@        projectConfigOnlyConstrained   :: Flag OnlyConstrained,        projectConfigPerComponent      :: Flag Bool,        projectConfigIndependentGoals  :: Flag IndependentGoals,+       projectConfigPreferOldest      :: Flag PreferOldest,         projectConfigProgPathExtra     :: NubList FilePath @@ -287,6 +287,9 @@        packageConfigHaddockQuickJump    :: Flag Bool, --TODO: [required eventually] use this        packageConfigHaddockHscolourCss  :: Flag FilePath, --TODO: [required eventually] use this        packageConfigHaddockContents     :: Flag PathTemplate, --TODO: [required eventually] use this+       packageConfigHaddockIndex        :: Flag PathTemplate, --TODO: [required eventually] use this+       packageConfigHaddockBaseUrl      :: Flag String, --TODO: [required eventually] use this+       packageConfigHaddockLib          :: Flag String, --TODO: [required eventually] use this        packageConfigHaddockForHackage   :: Flag HaddockTarget,        -- Test options        packageConfigTestHumanLog        :: Flag PathTemplate,@@ -410,7 +413,8 @@        solverSettingOnlyConstrained   :: OnlyConstrained,        solverSettingIndexState        :: Maybe TotalIndexState,        solverSettingActiveRepos       :: Maybe ActiveRepos,-       solverSettingIndependentGoals  :: IndependentGoals+       solverSettingIndependentGoals  :: IndependentGoals,+       solverSettingPreferOldest      :: PreferOldest        -- Things that only make sense for manual mode, not --local mode        -- too much control!      --solverSettingShadowPkgs        :: Bool,

@@ -138,7 +138,6 @@ import qualified Distribution.Client.BuildReports.Storage as BuildReports          ( storeLocal ) -import           Distribution.Client.Config (getCabalDir) import           Distribution.Client.HttpUtils import           Distribution.Client.Setup hiding (packageName) import           Distribution.Compiler@@ -162,7 +161,7 @@ import qualified Distribution.Simple.Setup as Setup import           Distribution.Simple.Command (commandShowOptions) import           Distribution.Simple.Configure (computeEffectiveProfiling)-+import           Distribution.Simple.PackageIndex (InstalledPackageIndex) import           Distribution.Simple.Utils                    ( die', warn, notice, noticeNoWrap, debugNoWrap, createDirectoryIfMissingVerbose, ordNub ) import           Distribution.Verbosity@@ -187,7 +186,7 @@  -- | Tracks what command is being executed, because we need to hide this somewhere -- for cases that need special handling (usually for error reporting).-data CurrentCommand = InstallCommand | HaddockCommand | OtherCommand+data CurrentCommand = InstallCommand | HaddockCommand | BuildCommand | ReplCommand | OtherCommand                     deriving (Show, Eq)  -- | This holds the context of a project prior to solving: the content of the@@ -199,7 +198,8 @@        projectConfig  :: ProjectConfig,        localPackages  :: [PackageSpecifier UnresolvedSourcePackage],        buildSettings  :: BuildTimeSettings,-       currentCommand :: CurrentCommand+       currentCommand :: CurrentCommand,+       installedPackages :: Maybe InstalledPackageIndex      }  establishProjectBaseContext@@ -222,8 +222,6 @@     -> CurrentCommand     -> IO ProjectBaseContext establishProjectBaseContextWithRoot verbosity cliConfig projectRoot currentCommand = do-    cabalDir <- getCabalDir-     let distDirLayout  = defaultDistDirLayout projectRoot mdistDirectory      httpTransport <- configureTransport verbosity@@ -247,9 +245,9 @@         mlogsDir = Setup.flagToMaybe projectConfigLogsDir     mstoreDir <- sequenceA $ makeAbsolute                  <$> Setup.flagToMaybe projectConfigStoreDir-    let cabalDirLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir+    cabalDirLayout <- mkCabalDirLayout mstoreDir mlogsDir -        buildSettings = resolveBuildTimeSettings+    let  buildSettings = resolveBuildTimeSettings                           verbosity cabalDirLayout                           projectConfig @@ -263,11 +261,13 @@       projectConfig,       localPackages,       buildSettings,-      currentCommand+      currentCommand,+      installedPackages     }   where     mdistDirectory = Setup.flagToMaybe projectConfigDistDir     ProjectConfigShared { projectConfigDistDir } = projectConfigShared cliConfig+    installedPackages = Nothing   -- | This holds the context between the pre-build, build and post-build phases.@@ -312,7 +312,8 @@       distDirLayout,       cabalDirLayout,       projectConfig,-      localPackages+      localPackages,+      installedPackages     }     action = do     -- Take the project configuration and make a plan for how to build@@ -324,6 +325,7 @@                          distDirLayout cabalDirLayout                          projectConfig                          localPackages+                         installedPackages     action elaboratedPlan elaboratedShared  runProjectPreBuildPhase@@ -337,7 +339,8 @@       distDirLayout,       cabalDirLayout,       projectConfig,-      localPackages+      localPackages,+      installedPackages     }     selectPlanSubset = do     -- Take the project configuration and make a plan for how to build@@ -349,6 +352,7 @@                          distDirLayout cabalDirLayout                          projectConfig                          localPackages+                         installedPackages      -- The plan for what to do is represented by an 'ElaboratedInstallPlan' @@ -862,26 +866,26 @@           ProjectBaseContext {             buildSettings = BuildTimeSettings{buildSettingDryRun},             projectConfig = ProjectConfig {+              projectConfigAllPackages =+                  PackageConfig {packageConfigOptimization = globalOptimization},               projectConfigLocalPackages =-                  PackageConfig {packageConfigOptimization}-            }+                  PackageConfig {packageConfigOptimization = localOptimization}+            },+            currentCommand           }           ProjectBuildContext {             elaboratedPlanToExecute = elaboratedPlan,             elaboratedShared,             pkgsBuildStatus           }--  | null pkgs-  = notice verbosity "Up to date"--  | otherwise-  = noticeNoWrap verbosity $ unlines $+  | null pkgs && currentCommand == BuildCommand+    = notice verbosity "Up to date"+  | not (null pkgs) = noticeNoWrap verbosity $ unlines $       (showBuildProfile ++ "In order, the following "        ++ wouldWill ++ " be built"        ++ ifNormal " (use -v for more details)" ++ ":")     : map showPkgAndReason pkgs-+  | otherwise = return ()   where     pkgs = InstallPlan.executionOrder elaboratedPlan @@ -997,7 +1001,7 @@     showBuildProfile :: String     showBuildProfile = "Build profile: " ++ unwords [       "-w " ++ (showCompilerId . pkgConfigCompiler) elaboratedShared,-      "-O" ++  (case packageConfigOptimization of+      "-O" ++  (case globalOptimization <> localOptimization of -- if local is not set, read global                 Setup.Flag NoOptimisation      -> "0"                 Setup.Flag NormalOptimisation  -> "1"                 Setup.Flag MaximumOptimisation -> "2"@@ -1153,7 +1157,7 @@       , [pkg]              <- rootpkgs       , installedUnitId pkg == pkgid       , isFailureSelfExplanatory (buildFailureReason failure)-      , currentCommand /= InstallCommand+      , currentCommand `notElem` [InstallCommand, BuildCommand, ReplCommand]       = True       | otherwise       = False@@ -1319,8 +1323,6 @@   -> CurrentCommand   -> IO ProjectBaseContext establishDummyProjectBaseContext verbosity projectConfig distDirLayout localPackages currentCommand = do-    cabalDir <- getCabalDir-     let ProjectConfigBuildOnly {           projectConfigLogsDir         } = projectConfigBuildOnly projectConfig@@ -1331,12 +1333,14 @@          mlogsDir = flagToMaybe projectConfigLogsDir         mstoreDir = flagToMaybe projectConfigStoreDir-        cabalDirLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir -        buildSettings :: BuildTimeSettings+    cabalDirLayout <- mkCabalDirLayout mstoreDir mlogsDir++    let buildSettings :: BuildTimeSettings         buildSettings = resolveBuildTimeSettings                           verbosity cabalDirLayout                           projectConfig+        installedPackages = Nothing      return ProjectBaseContext {       distDirLayout,@@ -1344,7 +1348,8 @@       projectConfig,       localPackages,       buildSettings,-      currentCommand+      currentCommand,+      installedPackages     }  establishDummyDistDirLayout :: Verbosity -> ProjectConfig -> FilePath -> IO DistDirLayout

@@ -170,7 +170,9 @@ import qualified Text.PrettyPrint as Disp import qualified Data.Map as Map import qualified Data.Set as Set-import           Control.Monad.State as State+import           Control.Monad (sequence, forM)+import           Control.Monad.IO.Class (liftIO)+import           Control.Monad.State as State (State, execState, runState, state) import           Control.Exception (assert) import           Data.List (groupBy, deleteBy) import qualified Data.List.NonEmpty as NE@@ -330,11 +332,14 @@                        fileMonitorProjectConfigKey -- todo check deps too?       $ do           liftIO $ info verbosity "Project settings changed, reconfiguring..."-          liftIO $ createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory           projectConfigSkeleton <- phaseReadProjectConfig-          -- have to create the cache directory before configuring the compiler-          (compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout ((fst $ PD.ignoreConditions projectConfigSkeleton) <> cliConfig)-          let projectConfig = instantiateProjectConfigSkeleton os arch (compilerInfo compiler) mempty projectConfigSkeleton+          let fetchCompiler = do+                 -- have to create the cache directory before configuring the compiler+                 liftIO $ createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory+                 (compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout ((fst $ PD.ignoreConditions projectConfigSkeleton) <> cliConfig)+                 pure (os, arch, compilerInfo compiler)++          projectConfig <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton           localPackages <- phaseReadLocalPackages (projectConfig <> cliConfig)           return (projectConfig, localPackages) @@ -441,8 +446,8 @@         progdb   =             userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))           . modifyProgramSearchPath-              (++ [ ProgramSearchPathDir dir-                  | dir <- fromNubList packageConfigProgramPathExtra ])+              ([ ProgramSearchPathDir dir+               | dir <- fromNubList packageConfigProgramPathExtra ] ++)           $ defaultProgramDb  @@ -463,6 +468,7 @@                    -> DistDirLayout -> CabalDirLayout                    -> ProjectConfig                    -> [PackageSpecifier UnresolvedSourcePackage]+                   -> Maybe InstalledPackageIndex                    -> IO ( ElaboratedInstallPlan  -- with store packages                          , ElaboratedInstallPlan  -- with source packages                          , ElaboratedSharedConfig@@ -477,7 +483,7 @@                    }                    CabalDirLayout {                      cabalStoreDirLayout-                   } = \projectConfig localPackages ->+                   } = \projectConfig localPackages mbInstalledPackages ->     runRebuild distProjectRootDirectory $ do     progsearchpath <- liftIO $ getSystemSearchPath     let projectConfigMonitored = projectConfig { projectConfigBuildOnly = mempty }@@ -500,6 +506,7 @@                         <- phaseRunSolver         projectConfig                                                   compilerEtc                                                   localPackages+                                                  (fromMaybe mempty mbInstalledPackages)           (elaboratedPlan,            elaboratedShared) <- phaseElaboratePlan projectConfig                                                    compilerEtc pkgConfigDB@@ -573,13 +580,15 @@         :: ProjectConfig         -> (Compiler, Platform, ProgramDb)         -> [PackageSpecifier UnresolvedSourcePackage]+        -> InstalledPackageIndex         -> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)     phaseRunSolver projectConfig@ProjectConfig {                      projectConfigShared,                      projectConfigBuildOnly                    }                    (compiler, platform, progdb)-                   localPackages =+                   localPackages+                   installedPackages =         rerunIfChanged verbosity fileMonitorSolverPlan                        (solverSettings,                         localPackages, localPackagesEnabledStanzas,@@ -606,7 +615,7 @@             notice verbosity "Resolving dependencies..."             planOrError <- foldProgress logMsg (pure . Left) (pure . Right) $               planPackages verbosity compiler platform solver solverSettings-                           installedPkgIndex sourcePkgDb pkgConfigDB+                           (installedPackages <> installedPkgIndex) sourcePkgDb pkgConfigDB                            localPackages localPackagesEnabledStanzas             case planOrError of               Left msg -> do reportPlanningFailure projectConfig compiler platform localPackages@@ -676,6 +685,7 @@             getPackageSourceHashes verbosity withRepoCtx solverPlan          defaultInstallDirs <- liftIO $ userInstallDirTemplates compiler+        let installDirs = fmap Cabal.fromFlag $ (fmap Flag defaultInstallDirs) <> (projectConfigInstallDirs projectConfigShared)         (elaboratedPlan, elaboratedShared)           <- liftIO . runLogProgress verbosity $               elaborateInstallPlan@@ -686,7 +696,7 @@                 solverPlan                 localPackages                 sourcePackageHashes-                defaultInstallDirs+                installDirs                 projectConfigShared                 projectConfigAllPackages                 projectConfigLocalPackages@@ -694,7 +704,7 @@         let instantiatedPlan               = instantiateInstallPlan                   cabalStoreDirLayout-                  defaultInstallDirs+                  installDirs                   elaboratedShared                   elaboratedPlan         liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan instantiatedPlan)@@ -913,9 +923,9 @@         -- Tarballs from repositories, either where the repository provides         -- hashes as part of the repo metadata, or where we will have to         -- download and hash the tarball.-        repoTarballPkgsWithMetadata    :: [(PackageId, Repo)]+        repoTarballPkgsWithMetadataUnvalidated    :: [(PackageId, Repo)]         repoTarballPkgsWithoutMetadata :: [(PackageId, Repo)]-        (repoTarballPkgsWithMetadata,+        (repoTarballPkgsWithMetadataUnvalidated,          repoTarballPkgsWithoutMetadata) =           partitionEithers           [ case repo of@@ -923,10 +933,16 @@               _            -> Right (pkgid, repo)           | (pkgid, RepoTarballPackage repo _ _) <- allPkgLocations ] +    (repoTarballPkgsWithMetadata, repoTarballPkgsToDownloadWithMeta) <- fmap partitionEithers $+      liftIO $ withRepoCtx $ \repoctx -> forM repoTarballPkgsWithMetadataUnvalidated $+        \x@(pkg, repo) -> verifyFetchedTarball verbosity repoctx repo pkg >>= \b -> case b of+                          True -> return $ Left x+                          False -> return $ Right x+     -- For tarballs from repos that do not have hashes available we now have     -- to check if the packages were downloaded already.     ---    (repoTarballPkgsToDownload,+    (repoTarballPkgsToDownloadWithNoMeta,      repoTarballPkgsDownloaded)       <- fmap partitionEithers $          liftIO $ sequence@@ -936,6 +952,7 @@                   Just tarball -> return (Right (pkgid, tarball))            | (pkgid, repo) <- repoTarballPkgsWithoutMetadata ] +    let repoTarballPkgsToDownload = repoTarballPkgsToDownloadWithMeta ++ repoTarballPkgsToDownloadWithNoMeta     (hashesFromRepoMetadata,      repoTarballPkgsNewlyDownloaded) <-       -- Avoid having to initialise the repository (ie 'withRepoCtx') if we@@ -1030,7 +1047,6 @@ planPackages verbosity comp platform solver SolverSettings{..}              installedPkgIndex sourcePkgDb pkgConfigDB              localPackages pkgStanzasEnable =-     resolveDependencies       platform (compilerInfo comp)       pkgConfigDB solver@@ -1076,7 +1092,10 @@         -- installed for global packages, or prefer latest even for         -- global packages. Perhaps should be configurable but with a         -- different name than "upgrade-dependencies".-      . setPreferenceDefault PreferLatestForSelected+      . setPreferenceDefault+        (if Cabal.asBool solverSettingPreferOldest+          then PreferAllOldest+          else PreferLatestForSelected)                            {-(if solverSettingUpgradeDeps                                 then PreferAllLatest                                 else PreferLatestForSelected)-}@@ -1181,6 +1200,7 @@     -- respective major Cabal version bundled with the respective GHC     -- release).     --+    -- etc.     -- GHC 9.2   needs  Cabal >= 3.6     -- GHC 9.0   needs  Cabal >= 3.4     -- GHC 8.10  needs  Cabal >= 3.2@@ -1197,6 +1217,7 @@     -- TODO: long-term, this compatibility matrix should be     --       stored as a field inside 'Distribution.Compiler.Compiler'     setupMinCabalVersionConstraint+      | isGHC, compVer >= mkVersion [9,6]  = mkVersion [3,10]       | isGHC, compVer >= mkVersion [9,4]  = mkVersion [3,8]       | isGHC, compVer >= mkVersion [9,2]  = mkVersion [3,6]       | isGHC, compVer >= mkVersion [9,0]  = mkVersion [3,4]@@ -1955,6 +1976,9 @@         elabHaddockQuickJump    = perPkgOptionFlag pkgid False packageConfigHaddockQuickJump         elabHaddockHscolourCss  = perPkgOptionMaybe pkgid packageConfigHaddockHscolourCss         elabHaddockContents     = perPkgOptionMaybe pkgid packageConfigHaddockContents+        elabHaddockIndex        = perPkgOptionMaybe pkgid packageConfigHaddockIndex+        elabHaddockBaseUrl      = perPkgOptionMaybe pkgid packageConfigHaddockBaseUrl+        elabHaddockLib          = perPkgOptionMaybe pkgid packageConfigHaddockLib          elabTestMachineLog      = perPkgOptionMaybe pkgid packageConfigTestMachineLog         elabTestHumanLog        = perPkgOptionMaybe pkgid packageConfigTestHumanLog@@ -3432,7 +3456,6 @@     sysconfdir   = prefix </> "etc"  - computeInstallDirs :: StoreDirLayout                    -> InstallDirs.InstallDirTemplates                    -> ElaboratedSharedConfig@@ -3741,9 +3764,13 @@                     -> Verbosity                     -> FilePath                     -> Cabal.HaddockFlags-setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir =+setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) (ElaboratedSharedConfig{..}) verbosity builddir =     Cabal.HaddockFlags {-      haddockProgramPaths  = mempty, --unused, set at configure time+      haddockProgramPaths  =+        case lookupProgram haddockProgram pkgConfigCompilerProgs of+          Nothing  -> mempty+          Just prg -> [( programName haddockProgram+                       , locationPath (programLocation prg) )],       haddockProgramArgs   = mempty, --unused, set at configure time       haddockHoogle        = toFlag elabHaddockHoogle,       haddockHtml          = toFlag elabHaddockHtml,@@ -3763,6 +3790,9 @@       haddockKeepTempFiles = mempty, --TODO: from build settings       haddockVerbosity     = toFlag verbosity,       haddockCabalFilePath = mempty,+      haddockIndex         = maybe mempty toFlag elabHaddockIndex,+      haddockBaseUrl       = maybe mempty toFlag elabHaddockBaseUrl,+      haddockLib           = maybe mempty toFlag elabHaddockLib,       haddockArgs          = mempty     } @@ -3897,6 +3927,7 @@       pkgHashDebugInfo           = elabDebugInfo,       pkgHashProgramArgs         = elabProgramArgs,       pkgHashExtraLibDirs        = elabExtraLibDirs,+      pkgHashExtraLibDirsStatic  = elabExtraLibDirsStatic,       pkgHashExtraFrameworkDirs  = elabExtraFrameworkDirs,       pkgHashExtraIncludeDirs    = elabExtraIncludeDirs,       pkgHashProgPrefix          = elabProgPrefix,@@ -3915,7 +3946,10 @@       pkgHashHaddockCss          = elabHaddockCss,       pkgHashHaddockLinkedSource = elabHaddockLinkedSource,       pkgHashHaddockQuickJump    = elabHaddockQuickJump,-      pkgHashHaddockContents     = elabHaddockContents+      pkgHashHaddockContents     = elabHaddockContents,+      pkgHashHaddockIndex        = elabHaddockIndex,+      pkgHashHaddockBaseUrl      = elabHaddockBaseUrl,+      pkgHashHaddockLib          = elabHaddockLib     }   where     ElaboratedConfiguredPackage{..} = normaliseConfiguredPackage shared pkg

@@ -292,6 +292,9 @@        elabHaddockQuickJump      :: Bool,        elabHaddockHscolourCss    :: Maybe FilePath,        elabHaddockContents       :: Maybe PathTemplate,+       elabHaddockIndex          :: Maybe PathTemplate,+       elabHaddockBaseUrl        :: Maybe String,+       elabHaddockLib            :: Maybe String,         elabTestMachineLog        :: Maybe PathTemplate,        elabTestHumanLog          :: Maybe PathTemplate,

@@ -25,7 +25,7 @@ import Distribution.Client.Compat.Prelude import Prelude () -import Distribution.Client.Config      ( SavedConfig(..) +import Distribution.Client.Config      ( SavedConfig(..)                                        , configFieldDescriptions                                        , haddockFlagsFields                                        , installDirsFields, withProgramsFields@@ -45,7 +45,7 @@                                        , commaListFieldParsec, commaNewLineListFieldParsec                                        , liftField, lineNo, locatedErrorMsg                                        , readFields-                                       , showPWarning +                                       , showPWarning                                        , syntaxError, warning ) import System.Directory                ( doesFileExist ) import System.FilePath                 ( (</>) )@@ -81,7 +81,7 @@ -- | Type of the current package environment. data PackageEnvironmentType   = UserPackageEnvironment    -- ^ './cabal.config'-  | AmbientPackageEnvironment -- ^ '~/.cabal/config'+  | AmbientPackageEnvironment -- ^ '~/.config/cabal/config'  -- | Is there a 'cabal.config' in this directory? classifyPackageEnvironment :: FilePath -> IO PackageEnvironmentType@@ -271,7 +271,7 @@ showPackageEnvironment pkgEnv = showPackageEnvironmentWithComments Nothing pkgEnv  -- | Pretty-print the package environment with default values for empty fields--- commented out (just like the default ~/.cabal/config).+-- commented out (just like the default Cabal config file). showPackageEnvironmentWithComments :: (Maybe PackageEnvironment)                                       -> PackageEnvironment                                       -> String

@@ -6,7 +6,7 @@ -- | Utilities to help commands with scripts -- module Distribution.Client.ScriptUtils (-    getScriptCacheDirectoryRoot, getScriptHash, getScriptCacheDirectory, ensureScriptCacheDirectory,+    getScriptHash, getScriptCacheDirectory, ensureScriptCacheDirectory,     withContextAndSelectors, AcceptNoTargets(..), TargetContext(..),     updateContextAndWriteProjectFile, updateContextAndWriteProjectFile',     fakeProjectSourcePackage, lSrcpkgDescription@@ -22,7 +22,7 @@     ( CabalSpecVersion (..), cabalSpecLatest) import Distribution.Client.ProjectOrchestration import Distribution.Client.Config-    ( getCabalDir )+    ( defaultScriptBuildsDir ) import Distribution.Client.DistDirLayout     ( DistDirLayout(..) ) import Distribution.Client.HashValue@@ -37,7 +37,7 @@     , projectConfigHttpTransport ) import Distribution.Client.ProjectConfig.Legacy     ( ProjectConfigSkeleton-    , parseProjectSkeleton, instantiateProjectConfigSkeleton )+    , parseProjectSkeleton, instantiateProjectConfigSkeletonFetchingCompiler ) import Distribution.Client.ProjectFlags     ( flagIgnoreProject ) import Distribution.Client.RebuildMonad@@ -120,14 +120,6 @@ --    repl to deal with the fact that the repl is relative to the working directory and not --    the project root. --- | Get the directory where script builds are cached.------ @CABAL_DIR\/script-builds\/@-getScriptCacheDirectoryRoot :: IO FilePath-getScriptCacheDirectoryRoot = do-  cabalDir <- getCabalDir-  return $ cabalDir </> "script-builds"- -- | Get the hash of a script's absolute path) -- -- Two hashes will be the same as long as the absolute paths@@ -138,14 +130,14 @@ -- | Get the directory for caching a script build. -- -- The only identity of a script is it's absolute path, so append the--- hashed path to @CABAL_DIR\/script-builds\/@ to get the cache directory.+-- hashed path to the @script-builds@ dir to get the cache directory. getScriptCacheDirectory :: FilePath -> IO FilePath-getScriptCacheDirectory script = (</>) <$> getScriptCacheDirectoryRoot <*> getScriptHash script+getScriptCacheDirectory script = (</>) <$> defaultScriptBuildsDir <*> getScriptHash script  -- | Get the directory for caching a script build and ensure it exists. -- -- The only identity of a script is it's absolute path, so append the--- hashed path to @CABAL_DIR\/script-builds\/@ to get the cache directory.+-- hashed path to the @script-builds@ dir to get the cache directory. ensureScriptCacheDirectory :: Verbosity -> FilePath -> IO FilePath ensureScriptCacheDirectory verbosity script = do   cacheDir <- getScriptCacheDirectory script@@ -179,10 +171,11 @@   -> NixStyleFlags a     -- ^ Command line flags   -> [String]            -- ^ Target strings or a script and args.   -> GlobalFlags         -- ^ Global flags.+  -> CurrentCommand      -- ^ Current Command (usually for error reporting).   -> (TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO b)   -- ^ The body of your command action.   -> IO b-withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings globalFlags act+withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings globalFlags cmd act   = withTemporaryTempDirectory $ \mkTmpDir -> do     (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with (without mkTmpDir) @@ -217,11 +210,11 @@     defaultTarget = [TargetPackage TargetExplicitNamed [fakePackageId] Nothing]      with = do-      ctx <- establishProjectBaseContext verbosity cliConfig OtherCommand+      ctx <- establishProjectBaseContext verbosity cliConfig cmd       return (ProjectContext, ctx)     without mkDir globalConfig = do       distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) =<< mkDir-      ctx <- establishDummyProjectBaseContext verbosity (globalConfig <> cliConfig) distDirLayout [] OtherCommand+      ctx <- establishDummyProjectBaseContext verbosity (globalConfig <> cliConfig) distDirLayout [] cmd       return (GlobalContext, ctx)     scriptOrError script err = do       exists <- doesFileExist script@@ -243,9 +236,11 @@          projectCfgSkeleton <- readProjectBlockFromScript verbosity httpTransport (distDirLayout ctx) (takeFileName script) scriptContents -        (compiler, Platform arch os, _) <- runRebuild (distProjectRootDirectory . distDirLayout $ ctx) $ configureCompiler verbosity (distDirLayout ctx) ((fst $ ignoreConditions projectCfgSkeleton) <> projectConfig ctx)+        let fetchCompiler = do+               (compiler, Platform arch os, _) <- runRebuild (distProjectRootDirectory . distDirLayout $ ctx) $ configureCompiler verbosity (distDirLayout ctx) ((fst $ ignoreConditions projectCfgSkeleton) <> projectConfig ctx)+               pure (os, arch, compilerInfo compiler) -        let projectCfg = instantiateProjectConfigSkeleton os arch (compilerInfo compiler) mempty projectCfgSkeleton :: ProjectConfig+        projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectCfgSkeleton          let executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just             ctx'        = ctx & lProjectConfig %~ (<> projectCfg)

@@ -112,7 +112,7 @@ import Distribution.Types.UnqualComponentName          ( unqualComponentNameToPackageName ) import Distribution.PackageDescription-         ( BuildType(..), RepoKind(..), LibraryName(..) )+         ( BuildType(..), RepoKind(..), LibraryName(..), Dependency ) import Distribution.System ( Platform ) import Distribution.ReadE          ( ReadE(..), succeedReadE, parsecToReadE, parsecToReadEErr, unexpectMsgString )@@ -127,6 +127,8 @@          ) import Distribution.Client.ManpageFlags (ManpageFlags, defaultManpageFlags, manpageOptions) import Distribution.FieldGrammar.Newtypes (SpecVersion (..))+import Distribution.Parsec+         ( parsecCommaList  )  import Data.List          ( deleteFirstsBy )@@ -238,41 +240,49 @@          "Commands:\n"       ++ unlines (         [ startGroup "global"-        , addCmd "update"-        , addCmd "install"-        , par+        , addCmd "user-config"         , addCmd "help"-        , addCmd "info"+        , par+        , startGroup "package database"+        , addCmd "update"         , addCmd "list"-        , addCmd "fetch"-        , addCmd "user-config"+        , addCmd "info"         , par-        , startGroup "package"-        , addCmd "get"-        , addCmd "unpack"+        , startGroup "initialization and download"         , addCmd "init"+        , addCmd "fetch"+        , addCmd "get"         , par+        , startGroup "project configuration"         , addCmd "configure"+        , addCmd "freeze"+        , addCmd "gen-bounds"+        , addCmd "outdated"+        , par+        , startGroup "project building and installing"         , addCmd "build"+        , addCmd "install"+        , addCmd "haddock"+        , addCmd "haddock-project"         , addCmd "clean"         , par-        , addCmd "run"+        , startGroup "running and testing"+        , addCmd "list-bin"         , addCmd "repl"-        , addCmd "test"+        , addCmd "run"         , addCmd "bench"+        , addCmd "test"+        , addCmd "exec"         , par+        , startGroup "sanity checks and shipping"         , addCmd "check"         , addCmd "sdist"         , addCmd "upload"         , addCmd "report"         , par-        , addCmd "freeze"-        , addCmd "gen-bounds"-        , addCmd "outdated"-        , addCmd "haddock"+        , startGroup "deprecated"+        , addCmd "unpack"         , addCmd "hscolour"-        , addCmd "exec"-        , addCmd "list-bin"         , par         , startGroup "new-style projects (forwards-compatible aliases)"         , addCmd "v2-build"@@ -298,12 +308,8 @@         , addCmd "v1-bench"         , addCmd "v1-freeze"         , addCmd "v1-haddock"-        , addCmd "v1-exec"-        , addCmd "v1-update"         , addCmd "v1-install"         , addCmd "v1-clean"-        , addCmd "v1-sdist"-        , addCmd "v1-doctest"         , addCmd "v1-copy"         , addCmd "v1-register"         , addCmd "v1-reconfigure"@@ -360,6 +366,11 @@       ,multiOption "nix"         globalNix (\v flags -> flags { globalNix = v })         [+          optArg' "(True or False)" (maybeToFlag . (readMaybe =<<)) (\case+            Flag True -> [Just "enable"]+            Flag False -> [Just "disable"]+            NoFlag -> [Just "disable"]) "" ["nix"]+            "Nix integration: run commands through nix-shell if a 'shell.nix' file exists (default is False)",           noArg (Flag True) [] ["enable-nix"]           "Enable Nix integration: run commands through nix-shell if a 'shell.nix' file exists",           noArg (Flag False) [] ["disable-nix"]@@ -409,7 +420,6 @@          "Set a location for a cabal.config file for projects without their own cabal.config freeze file."          globalConstraintsFile (\v flags -> flags {globalConstraintsFile = v})          (reqArgFlag "FILE")-       ]  -- ------------------------------------------------------------@@ -497,7 +507,7 @@     flags_2_5_0 = flags_3_7_0 {       -- Cabal < 2.5 does not understand --dependency=pkg:component=cid       -- (public sublibraries), so we convert it to the legacy-      -- --dependency=pkg_or_internal_compoent=cid+      -- --dependency=pkg_or_internal_component=cid         configDependencies =           let convertToLegacyInternalDep (GivenComponent _ (LSubLibName cn) cid) =                 Just $ GivenComponent@@ -943,6 +953,7 @@       fetchFineGrainedConflicts :: Flag FineGrainedConflicts,       fetchMinimizeConflictSet :: Flag MinimizeConflictSet,       fetchIndependentGoals :: Flag IndependentGoals,+      fetchPreferOldest     :: Flag PreferOldest,       fetchShadowPkgs       :: Flag ShadowPkgs,       fetchStrongFlags      :: Flag StrongFlags,       fetchAllowBootLibInstalls :: Flag AllowBootLibInstalls,@@ -964,6 +975,7 @@     fetchFineGrainedConflicts = Flag (FineGrainedConflicts True),     fetchMinimizeConflictSet = Flag (MinimizeConflictSet False),     fetchIndependentGoals = Flag (IndependentGoals False),+    fetchPreferOldest     = Flag (PreferOldest False),     fetchShadowPkgs       = Flag (ShadowPkgs False),     fetchStrongFlags      = Flag (StrongFlags False),     fetchAllowBootLibInstalls = Flag (AllowBootLibInstalls False),@@ -1027,6 +1039,7 @@                          fetchFineGrainedConflicts (\v flags -> flags { fetchFineGrainedConflicts = v })                          fetchMinimizeConflictSet (\v flags -> flags { fetchMinimizeConflictSet = v })                          fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v })+                         fetchPreferOldest     (\v flags -> flags { fetchPreferOldest = v })                          fetchShadowPkgs       (\v flags -> flags { fetchShadowPkgs       = v })                          fetchStrongFlags      (\v flags -> flags { fetchStrongFlags      = v })                          fetchAllowBootLibInstalls (\v flags -> flags { fetchAllowBootLibInstalls = v })@@ -1049,6 +1062,7 @@       freezeFineGrainedConflicts :: Flag FineGrainedConflicts,       freezeMinimizeConflictSet :: Flag MinimizeConflictSet,       freezeIndependentGoals :: Flag IndependentGoals,+      freezePreferOldest     :: Flag PreferOldest,       freezeShadowPkgs       :: Flag ShadowPkgs,       freezeStrongFlags      :: Flag StrongFlags,       freezeAllowBootLibInstalls :: Flag AllowBootLibInstalls,@@ -1068,6 +1082,7 @@     freezeFineGrainedConflicts = Flag (FineGrainedConflicts True),     freezeMinimizeConflictSet = Flag (MinimizeConflictSet False),     freezeIndependentGoals = Flag (IndependentGoals False),+    freezePreferOldest     = Flag (PreferOldest False),     freezeShadowPkgs       = Flag (ShadowPkgs False),     freezeStrongFlags      = Flag (StrongFlags False),     freezeAllowBootLibInstalls = Flag (AllowBootLibInstalls False),@@ -1122,6 +1137,7 @@                          freezeFineGrainedConflicts (\v flags -> flags { freezeFineGrainedConflicts = v })                          freezeMinimizeConflictSet (\v flags -> flags { freezeMinimizeConflictSet = v })                          freezeIndependentGoals (\v flags -> flags { freezeIndependentGoals = v })+                         freezePreferOldest     (\v flags -> flags { freezePreferOldest = v })                          freezeShadowPkgs       (\v flags -> flags { freezeShadowPkgs       = v })                          freezeStrongFlags      (\v flags -> flags { freezeStrongFlags      = v })                          freezeAllowBootLibInstalls (\v flags -> flags { freezeAllowBootLibInstalls = v })@@ -1264,7 +1280,7 @@     commandSynopsis     = "Upload build reports to a remote server.",     commandDescription  = Nothing,     commandNotes        = Just $ \_ ->-         "You can store your Hackage login in the ~/.cabal/config file\n",+         "You can store your Hackage login in the ~/.config/cabal/config file\n",     commandUsage        = usageAlternatives "report" ["[FLAGS]"],     commandDefaultFlags = defaultReportFlags,     commandOptions      = \_ ->@@ -1297,6 +1313,7 @@  data GetFlags = GetFlags {     getDestDir          :: Flag FilePath,+    getOnlyPkgDescr     :: Flag Bool,     getPristine         :: Flag Bool,     getIndexState       :: Flag TotalIndexState,     getActiveRepos      :: Flag ActiveRepos,@@ -1307,6 +1324,7 @@ defaultGetFlags :: GetFlags defaultGetFlags = GetFlags {     getDestDir          = mempty,+    getOnlyPkgDescr     = mempty,     getPristine         = mempty,     getIndexState       = mempty,     getActiveRepos      = mempty,@@ -1352,6 +1370,16 @@                                       (toFlag `fmap` parsec))                           (flagToList . fmap prettyShow)) +       , option [] ["only-package-description"]+           "Unpack only the package description file."+           getOnlyPkgDescr (\v flags -> flags { getOnlyPkgDescr = v })+           trueArg++       , option [] ["package-description-only"]+           "A synonym for --only-package-description."+           getOnlyPkgDescr (\v flags -> flags { getOnlyPkgDescr = v })+           trueArg+        , option [] ["pristine"]            ("Unpack the original pristine tarball, rather than updating the "            ++ ".cabal file with the latest revision from the package archive.")@@ -1556,6 +1584,7 @@     installFineGrainedConflicts :: Flag FineGrainedConflicts,     installMinimizeConflictSet :: Flag MinimizeConflictSet,     installIndependentGoals :: Flag IndependentGoals,+    installPreferOldest     :: Flag PreferOldest,     installShadowPkgs       :: Flag ShadowPkgs,     installStrongFlags      :: Flag StrongFlags,     installAllowBootLibInstalls :: Flag AllowBootLibInstalls,@@ -1598,6 +1627,7 @@     installFineGrainedConflicts = Flag (FineGrainedConflicts True),     installMinimizeConflictSet = Flag (MinimizeConflictSet False),     installIndependentGoals= Flag (IndependentGoals False),+    installPreferOldest    = Flag (PreferOldest False),     installShadowPkgs      = Flag (ShadowPkgs False),     installStrongFlags     = Flag (StrongFlags False),     installAllowBootLibInstalls = Flag (AllowBootLibInstalls False),@@ -1657,7 +1687,7 @@      ++ " `v1-configure` for a list of commands being affected.\n"      ++ "\n"      ++ "Installed executables will by default"-     ++ " be put into `~/.cabal/bin/`."+     ++ " be put into `~/.local/bin/`."      ++ " If you want installed executable to be available globally, make"      ++ " sure that the PATH environment variable contains that directory.\n"      ++ "\n",@@ -1749,7 +1779,7 @@     , name `elem` ["hoogle", "html", "html-location"                   ,"executables", "tests", "benchmarks", "all", "internal", "css"                   ,"hyperlink-source", "quickjump", "hscolour-css"-                  ,"contents-location", "for-hackage"]+                  ,"contents-location", "use-index", "for-hackage", "base-url", "lib"]     ]  testOptions :: ShowOrParseArgs -> [OptionField TestFlags]@@ -1823,6 +1853,7 @@                         installFineGrainedConflicts (\v flags -> flags { installFineGrainedConflicts = v })                         installMinimizeConflictSet (\v flags -> flags { installMinimizeConflictSet = v })                         installIndependentGoals (\v flags -> flags { installIndependentGoals = v })+                        installPreferOldest     (\v flags -> flags { installPreferOldest = v })                         installShadowPkgs       (\v flags -> flags { installShadowPkgs       = v })                         installStrongFlags      (\v flags -> flags { installStrongFlags      = v })                         installAllowBootLibInstalls (\v flags -> flags { installAllowBootLibInstalls = v })@@ -1978,7 +2009,7 @@     commandSynopsis     = "Uploads source packages or documentation to Hackage.",     commandDescription  = Nothing,     commandNotes        = Just $ \_ ->-         "You can store your Hackage login in the ~/.cabal/config file\n"+         "You can store your Hackage login in the ~/.config/cabal/config file\n"       ++ relevantConfigValuesText ["username", "password", "password-command"],     commandUsage        = \pname ->          "Usage: " ++ pname ++ " upload [FLAGS] TARFILES\n",@@ -2137,12 +2168,14 @@    , option ['x'] ["extra-source-file"]     "Extra source file to be distributed with tarball."-    IT.extraSrc (\v flags -> flags { IT.extraSrc = v })+    IT.extraSrc+    (\v flags -> flags { IT.extraSrc = mergeListFlag (IT.extraSrc flags) v })     (reqArg' "FILE" (Flag . (:[]))                     (fromFlagOrDefault []))   , option [] ["extra-doc-file"]     "Extra doc file to be distributed with tarball."-    IT.extraDoc (\v flags -> flags { IT.extraDoc = v })+    IT.extraDoc+    (\v flags -> flags { IT.extraDoc = mergeListFlag (IT.extraDoc flags) v })     (reqArg' "FILE" (Flag . (:[])) (fromFlagOrDefault []))    , option [] ["lib", "is-library"]@@ -2170,7 +2203,8 @@        , option [] ["test-dir"]         "Directory containing tests."-        IT.testDirs (\v flags -> flags { IT.testDirs = v })+        IT.testDirs (\v flags ->+          flags { IT.testDirs = mergeListFlag (IT.testDirs flags) v })         (reqArg' "DIR" (Flag . (:[]))                        (fromFlagOrDefault [])) @@ -2197,7 +2231,8 @@   , option ['o'] ["expose-module"]     "Export a module from the package."     IT.exposedModules-    (\v flags -> flags { IT.exposedModules = v })+    (\v flags -> flags { IT.exposedModules =+      mergeListFlag (IT.exposedModules flags) v})     (reqArg "MODULE" (parsecToReadE ("Cannot parse module name: "++)                                  (Flag . (:[]) <$> parsec))                      (flagElim [] (fmap prettyShow)))@@ -2205,33 +2240,38 @@   , option [] ["extension"]     "Use a LANGUAGE extension (in the other-extensions field)."     IT.otherExts-    (\v flags -> flags { IT.otherExts = v })+    (\v flags -> flags { IT.otherExts =+      mergeListFlag (IT.otherExts flags) v })     (reqArg "EXTENSION" (parsecToReadE ("Cannot parse extension: "++)                                     (Flag . (:[]) <$> parsec))                         (flagElim [] (fmap prettyShow)))    , option ['d'] ["dependency"]-    "Package dependency."-    IT.dependencies (\v flags -> flags { IT.dependencies = v })-    (reqArg "PACKAGE" (parsecToReadE ("Cannot parse dependency: "++)-                                  (Flag . (:[]) <$> parsec))-                      (flagElim [] (fmap prettyShow)))+    "Package dependencies. Permits comma separated list of dependencies."+    IT.dependencies+    (\v flags -> flags { IT.dependencies =+      mergeListFlag (IT.dependencies flags) v })+    (reqArg "DEPENDENCIES" (fmap Flag dependenciesReadE)+                           (fmap prettyShow . fromFlagOrDefault []))    , option [] ["application-dir"]     "Directory containing package application executable."-    IT.applicationDirs (\v flags -> flags { IT.applicationDirs = v})+    IT.applicationDirs (\v flags -> flags { IT.applicationDirs =+      mergeListFlag (IT.applicationDirs flags) v})     (reqArg' "DIR" (Flag . (:[]))                    (fromFlagOrDefault []))    , option [] ["source-dir", "sourcedir"]     "Directory containing package library source."-    IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v })+    IT.sourceDirs (\v flags -> flags { IT.sourceDirs =+      mergeListFlag (IT.sourceDirs flags) v })     (reqArg' "DIR" (Flag. (:[]))                    (fromFlagOrDefault []))    , option [] ["build-tool"]     "Required external build tool."-    IT.buildTools (\v flags -> flags { IT.buildTools = v })+    IT.buildTools (\v flags -> flags { IT.buildTools =+      mergeListFlag (IT.buildTools flags) v })     (reqArg' "TOOL" (Flag . (:[]))                     (fromFlagOrDefault [])) @@ -2243,7 +2283,17 @@    , optionVerbosity IT.initVerbosity (\v flags -> flags { IT.initVerbosity = v })   ]+  where+    dependenciesReadE :: ReadE [Dependency]+    dependenciesReadE =+      parsecToReadE+        ("Cannot parse dependencies: " ++)+        (parsecCommaList parsec) +    mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a]+    mergeListFlag currentFlags v =+      Flag $ concat (flagToList currentFlags ++ flagToList v)+ -- ------------------------------------------------------------ -- * Copy and Register -- ------------------------------------------------------------@@ -2333,18 +2383,18 @@   commandDescription  = Just $ \_ -> wrapText $        "When upgrading cabal, the set of configuration keys and their default"     ++ " values may change. This command provides means to merge the existing"-    ++ " config in ~/.cabal/config"+    ++ " config in ~/.config/cabal/config"     ++ " (i.e. all bindings that are actually defined and not commented out)"     ++ " and the default config of the new version.\n"     ++ "\n"-    ++ "init: Creates a new config file at either ~/.cabal/config or as"+    ++ "init: Creates a new config file at either ~/.config/cabal/config or as"     ++ " specified by --config-file, if given. An existing file won't be "     ++ " overwritten unless -f or --force is given.\n"-    ++ "diff: Shows a pseudo-diff of the user's ~/.cabal/config file and"+    ++ "diff: Shows a pseudo-diff of the user's ~/.config/cabal/config file and"     ++ " the default configuration that would be created by cabal if the"     ++ " config file did not exist.\n"     ++ "update: Applies the pseudo-diff to the configuration that would be"-    ++ " created by default, and write the result back to ~/.cabal/config.",+    ++ " created by default, and write the result back to ~/.config/cabal/config.",    commandNotes        = Nothing,   commandUsage        = usageAlternatives "user-config" ["init", "diff", "update"],@@ -2399,13 +2449,14 @@                   -> (flags -> Flag FineGrainedConflicts) -> (Flag FineGrainedConflicts -> flags -> flags)                   -> (flags -> Flag MinimizeConflictSet) -> (Flag MinimizeConflictSet -> flags -> flags)                   -> (flags -> Flag IndependentGoals) -> (Flag IndependentGoals -> flags -> flags)+                  -> (flags -> Flag PreferOldest) -> (Flag PreferOldest -> flags -> flags)                   -> (flags -> Flag ShadowPkgs)       -> (Flag ShadowPkgs       -> flags -> flags)                   -> (flags -> Flag StrongFlags)      -> (Flag StrongFlags      -> flags -> flags)                   -> (flags -> Flag AllowBootLibInstalls) -> (Flag AllowBootLibInstalls -> flags -> flags)                   -> (flags -> Flag OnlyConstrained)  -> (Flag OnlyConstrained  -> flags -> flags)                   -> [OptionField flags] optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg getcc setcc-                  getfgc setfgc getmc setmc getig setig getsip setsip+                  getfgc setfgc getmc setmc getig setig getpo setpo getsip setsip                   getstrfl setstrfl getib setib getoc setoc =   [ option [] ["max-backjumps"]       ("Maximum number of backjumps allowed while solving (default: " ++ show defaultMaxBackjumps ++ "). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely.")@@ -2438,6 +2489,11 @@       "Treat several goals on the command line as independent. If several goals depend on the same package, different versions can be chosen."       (fmap asBool . getig)       (setig . fmap IndependentGoals)+      (yesNoOpt showOrParseArgs)+  , option [] ["prefer-oldest"]+      "Prefer the oldest (instead of the latest) versions of packages available. Useful to determine lower bounds in the build-depends section."+      (fmap asBool . getpo)+      (setpo . fmap PreferOldest)       (yesNoOpt showOrParseArgs)   , option [] ["shadow-installed-packages"]       "If multiple package instances of the same version are installed, treat all but one as shadowed."

@@ -77,7 +77,7 @@ import qualified Distribution.InstalledPackageInfo as IPI import Distribution.Client.Types import Distribution.Client.Config-         ( getCabalDir )+         ( defaultCacheDir ) import Distribution.Client.IndexUtils          ( getInstalledPackages ) import Distribution.Client.JobControl@@ -87,8 +87,8 @@ import Distribution.Utils.Generic          ( safeHead ) import Distribution.Simple.Utils-         ( die', debug, info, infoNoWrap-         , cabalVersion, tryFindPackageDesc+         ( die', debug, info, infoNoWrap, maybeExit+         , cabalVersion, tryFindPackageDesc, rawSystemProc          , createDirectoryIfMissingVerbose, installExecutableFile          , copyFileVerbose, rewriteFileEx, rewriteFileLBS ) import Distribution.Client.Utils@@ -109,9 +109,8 @@ import System.Directory    ( doesFileExist ) import System.FilePath     ( (</>), (<.>) ) import System.IO           ( Handle, hPutStr )-import Distribution.Compat.Process (createProcess)-import System.Process      ( StdStream(..), proc, waitForProcess-                           , ProcessHandle )+import Distribution.Compat.Process (proc)+import System.Process      ( StdStream(..) ) import qualified System.Process as Process import Data.List           ( foldl1' ) import Distribution.Client.Compat.ExecutablePath  ( getExecutablePath )@@ -241,7 +240,7 @@     -- When we are installing in parallel, we always use the external setup     -- method. Since compiling the setup script each time adds noticeable     -- overhead, we use a shared setup script cache-    -- ('~/.cabal/setup-exe-cache'). For each (compiler, platform, Cabal+    -- ('$XDG_CACHE_HOME/cabal/setup-exe-cache'). For each (compiler, platform, Cabal     -- version) combination the cache holds a compiled setup script     -- executable. This only affects the Simple build type; for the Custom,     -- Configure and Make build types we always compile the setup script anew.@@ -437,35 +436,32 @@ buildTypeAction Make      = Make.defaultMainArgs buildTypeAction Custom               = error "buildTypeAction Custom" +invoke :: Verbosity -> FilePath -> [String] -> SetupScriptOptions -> IO ()+invoke verbosity path args options = do+  info verbosity $ unwords (path : args)+  case useLoggingHandle options of+    Nothing        -> return ()+    Just logHandle -> info verbosity $ "Redirecting build log to " ++ show logHandle --- | @runProcess'@ is a version of @runProcess@ where we have--- the additional option to decide whether or not we should--- delegate CTRL+C to the spawned process.-runProcess' :: FilePath                 -- ^ Filename of the executable-            -> [String]                 -- ^ Arguments to pass to executable-            -> Maybe FilePath           -- ^ Optional path to working directory-            -> Maybe [(String, String)] -- ^ Optional environment-            -> Maybe Handle             -- ^ Handle for @stdin@-            -> Maybe Handle             -- ^ Handle for @stdout@-            -> Maybe Handle             -- ^ Handle for @stderr@-            -> Bool                     -- ^ Delegate Ctrl+C ?-            -> IO ProcessHandle-runProcess' cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr _delegate = do-  (_,_,_,ph) <--    createProcess-      (proc cmd args){ Process.cwd = mb_cwd-                     , Process.env = mb_env-                     , Process.std_in  = mbToStd mb_stdin-                     , Process.std_out = mbToStd mb_stdout-                     , Process.std_err = mbToStd mb_stderr-                     , Process.delegate_ctlc = _delegate-                     }-  return ph-  where-    mbToStd :: Maybe Handle -> StdStream-    mbToStd Nothing = Inherit-    mbToStd (Just hdl) = UseHandle hdl+  searchpath <- programSearchPathAsPATHVar+                (map ProgramSearchPathDir (useExtraPathEnv options) +++                 getProgramSearchPath (useProgramDb options))+  env       <- getEffectiveEnvironment $+                 [ ("PATH", Just searchpath)+                 , ("HASKELL_DIST_DIR", Just (useDistPref options))+                 ] ++ useExtraEnvOverrides options +  let loggingHandle = case useLoggingHandle options of+                        Nothing -> Inherit+                        Just hdl -> UseHandle hdl+      cp = (proc path args) { Process.cwd = useWorkingDir options+                            , Process.env = env+                            , Process.std_out = loggingHandle+                            , Process.std_err = loggingHandle+                            , Process.delegate_ctlc = isInteractive options+                            }+  maybeExit $ rawSystemProc verbosity cp+ -- ------------------------------------------------------------ -- * Self-Exec SetupMethod -- ------------------------------------------------------------@@ -478,83 +474,43 @@   info verbosity $ "Using self-exec internal setup method with build-type "                  ++ show bt ++ " and args:\n  " ++ show args   path <- getExecutablePath-  info verbosity $ unwords (path : args)-  case useLoggingHandle options of-    Nothing        -> return ()-    Just logHandle -> info verbosity $ "Redirecting build log to "-                                    ++ show logHandle--  searchpath <- programSearchPathAsPATHVar-                (map ProgramSearchPathDir (useExtraPathEnv options) ++-                 getProgramSearchPath (useProgramDb options))-  env       <- getEffectiveEnvironment $-                 [ ("PATH", Just searchpath)-                 , ("HASKELL_DIST_DIR", Just (useDistPref options))-                 ] ++ useExtraEnvOverrides options-  process <- runProcess' path args-             (useWorkingDir options) env Nothing-             (useLoggingHandle options) (useLoggingHandle options)-             (isInteractive options)-  exitCode <- waitForProcess process-  unless (exitCode == ExitSuccess) $ exitWith exitCode+  invoke verbosity path args options  -- ------------------------------------------------------------ -- * External SetupMethod -- ------------------------------------------------------------  externalSetupMethod :: WithCallStack (FilePath -> SetupRunner)-externalSetupMethod path verbosity options _ args = do-  info verbosity $ unwords (path : args)-  case useLoggingHandle options of-    Nothing        -> return ()-    Just logHandle -> info verbosity $ "Redirecting build log to "-                                    ++ show logHandle--  -- See 'Note: win32 clean hack' above.-#ifdef mingw32_HOST_OS-  if useWin32CleanHack options then doWin32CleanHack path else doInvoke path+externalSetupMethod path verbosity options _ args =+#ifndef mingw32_HOST_OS+  invoke verbosity path args options #else-  doInvoke path-#endif-+  -- See 'Note: win32 clean hack' above.+  if useWin32CleanHack options+    then invokeWithWin32CleanHack path+    else invoke' path   where-    doInvoke path' = do-      searchpath <- programSearchPathAsPATHVar-                    (map ProgramSearchPathDir (useExtraPathEnv options) ++-                      getProgramSearchPath (useProgramDb options))-      env        <- getEffectiveEnvironment $-                      [ ("PATH", Just searchpath)-                      , ("HASKELL_DIST_DIR", Just (useDistPref options))-                      ] ++ useExtraEnvOverrides options--      debug verbosity $ "Setup arguments: "++unwords args-      process <- runProcess' path' args-                  (useWorkingDir options) env Nothing-                  (useLoggingHandle options) (useLoggingHandle options)-                  (isInteractive options)-      exitCode <- waitForProcess process-      unless (exitCode == ExitSuccess) $ exitWith exitCode+    invoke' p = invoke verbosity p args options -#ifdef mingw32_HOST_OS-    doWin32CleanHack path' = do+    invokeWithWin32CleanHack origPath = do       info verbosity $ "Using the Win32 clean hack."       -- Recursively removes the temp dir on exit.       withTempDirectory verbosity (workingDir options) "cabal-tmp" $ \tmpDir ->-          bracket (moveOutOfTheWay tmpDir path')-                  (maybeRestore path')-                  doInvoke+          bracket (moveOutOfTheWay tmpDir origPath)+                  (\tmpPath -> maybeRestore origPath tmpPath)+                  (\tmpPath -> invoke' tmpPath) -    moveOutOfTheWay tmpDir path' = do-      let newPath = tmpDir </> "setup" <.> exeExtension buildPlatform-      Win32.moveFile path' newPath-      return newPath+    moveOutOfTheWay tmpDir origPath = do+      let tmpPath = tmpDir </> "setup" <.> exeExtension buildPlatform+      Win32.moveFile origPath tmpPath+      return tmpPath -    maybeRestore oldPath path' = do-      let oldPathDir = takeDirectory oldPath-      oldPathDirExists <- doesDirectoryExist oldPathDir+    maybeRestore origPath tmpPath = do+      let origPathDir = takeDirectory origPath+      origPathDirExists <- doesDirectoryExist origPathDir       -- 'setup clean' didn't complete, 'dist/setup' still exists.-      when oldPathDirExists $-        Win32.moveFile path' oldPath+      when origPathDirExists $+        Win32.moveFile tmpPath origPath #endif  getExternalSetupMethod@@ -784,8 +740,8 @@   cachedSetupDirAndProg :: SetupScriptOptions -> Version                         -> IO (FilePath, FilePath)   cachedSetupDirAndProg options' cabalLibVersion = do-    cabalDir <- getCabalDir-    let setupCacheDir       = cabalDir </> "setup-exe-cache"+    cacheDir <- defaultCacheDir+    let setupCacheDir       = cacheDir </> "setup-exe-cache"         cachedSetupProgFile = setupCacheDir                               </> ("setup-" ++ buildTypeString ++ "-"                                    ++ cabalVersionString ++ "-"

@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}+module Distribution.Client.Signal+  ( installTerminationHandler+  , Terminated(..)+  )+where++import qualified Control.Exception as Exception++#ifndef mingw32_HOST_OS+import Control.Concurrent (myThreadId)+import Control.Monad (void)+import qualified System.Posix.Signals as Signals+#endif++-- | Terminated is an asynchronous exception, thrown when+-- SIGTERM is received. It's to 'kill' what 'UserInterrupt'+-- is to Ctrl-C.+data Terminated = Terminated++instance Exception.Exception Terminated where+  toException = Exception.asyncExceptionToException+  fromException = Exception.asyncExceptionFromException++instance Show Terminated where+  show Terminated = "terminated"++-- | Install a signal handler that initiates a controlled shutdown on receiving+-- SIGTERM by throwing an asynchronous exception at the main thread. Must be+-- called from the main thread.+--+-- It is a noop on Windows.+--+installTerminationHandler :: IO ()++#ifdef mingw32_HOST_OS++installTerminationHandler = return ()++#else++installTerminationHandler = do+  mainThreadId <- myThreadId+  void $ Signals.installHandler+    Signals.sigTERM+    (Signals.CatchOnce $ Exception.throwTo mainThreadId Terminated)+    Nothing++#endif

@@ -39,7 +39,7 @@  import Prelude () import Distribution.Client.Compat.Prelude-import Distribution.Verbosity (silent)+import Distribution.Verbosity (normal)  import System.FilePath @@ -150,7 +150,8 @@     -- A.hs-boot; need to track both.     findNeededModules ["hs", "lhs", "hsig", "lhsig"]     findNeededModules ["hs-boot", "lhs-boot"]-    expandedExtraSrcFiles <- liftIO $ fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchDirFileGlobWithDie silent (\ _ _ -> return []) (specVersion pkg_descr) "." fpath+    root <- askRoot+    expandedExtraSrcFiles <- liftIO $ fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchDirFileGlobWithDie normal (\ _ _ -> return []) (specVersion pkg_descr) root fpath     traverse_ needIfExists $ concat         [ cSources bi         , cxxSources bi

@@ -713,21 +713,26 @@     case [ (t, m, ms) | MatchingInternalError t m ms <- problems ] of       [] -> return ()       ((target, originalMatch, renderingsAndMatches):_) ->-        die' verbosity $ "Internal error in target matching. It should always "-           ++ "be possible to find a syntax that's sufficiently qualified to "-           ++ "give an unambiguous match. However when matching '"-           ++ showTargetString target ++ "'  we found "-           ++ showTargetSelector originalMatch-           ++ " (" ++ showTargetSelectorKind originalMatch ++ ") which does "-           ++ "not have an unambiguous syntax. The possible syntax and the "-           ++ "targets they match are as follows:\n"+        die' verbosity $ "Internal error in target matching: could not make an "+           ++ "unambiguous fully qualified target selector for '"+           ++ showTargetString target ++ "'.\n"+           ++ "We made the target '" ++ showTargetSelector originalMatch ++ "' ("+           ++ showTargetSelectorKind originalMatch ++ ") that was expected to "+           ++ "be unambiguous but matches the following targets:\n"            ++ unlines-                [ "'" ++ showTargetString rendering ++ "' which matches "-                  ++ intercalate ", "+                [ "'" ++ showTargetString rendering ++ "', matching:"+                  ++ concatMap ("\n  - " ++)                        [ showTargetSelector match ++                          " (" ++ showTargetSelectorKind match ++ ")"                        | match <- matches ]                 | (rendering, matches) <- renderingsAndMatches ]+           ++ "\nNote: Cabal expects to be able to make a single fully "+           ++ "qualified name for a target or provide a more specific error. "+           ++ "Our failure to do so is a bug in cabal. "+           ++ "Tracking issue: https://github.com/haskell/cabal/issues/8684"+           ++ "\n\nHint: this may be caused by trying to build a package that "+           ++ "exists in the project directory but is missing from "+           ++ "the 'packages' stanza in your cabal project file."      case [ (t, e, g) | TargetSelectorExpected t e g <- problems ] of       []      -> return ()

@@ -82,5 +82,3 @@ instance PackageInstalled (ConfiguredPackage loc) where   installedDepends = CD.flatDeps . depends --

@@ -183,9 +183,9 @@       let auth        :: (String, String)           auth        = (username, password) -      dotCabal <- getCabalDir+      reportsDir <- defaultReportsDir       let srcDir :: FilePath-          srcDir = dotCabal </> "reports" </> unRepoName (remoteRepoName remoteRepo)+          srcDir = reportsDir </> unRepoName (remoteRepoName remoteRepo)       -- We don't want to bomb out just because we haven't built any packages       -- from this repo yet.       srcExists <- doesDirectoryExist srcDir

@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-}+{-# LANGUAGE ScopedTypeVariables, CPP #-}  module Distribution.Client.Utils   ( MergeResult(..)@@ -28,6 +28,7 @@   , listFilesRecursive   , listFilesInside   , safeRead+  , hasElem   ) where  import Prelude ()@@ -47,7 +48,6 @@          ( zipWithM_ ) import Data.List          ( groupBy )-import Foreign.C.Types ( CInt(..) ) import qualified Control.Exception as Exception          ( finally ) import qualified Control.Exception.Safe as Safe@@ -61,6 +61,7 @@          ) import System.IO.Unsafe ( unsafePerformIO ) +import GHC.Conc.Sync ( getNumProcessors ) import GHC.IO.Encoding          ( recover, TextEncoding(TextEncoding) ) import GHC.IO.Encoding.Failure@@ -73,7 +74,7 @@ import qualified System.Directory as Dir import qualified System.IO.Error as IOError #endif-+import qualified Data.Set as Set  -- | Generic merging utility. For sorted input lists this is a full outer join. --@@ -145,9 +146,7 @@ withEnv k v m = do   mb_old <- lookupEnv k   setEnv k v-  m `Exception.finally` (case mb_old of-    Nothing -> unsetEnv k-    Just old -> setEnv k old)+  m `Exception.finally` setOrUnsetEnv k mb_old  -- | Executes the action with a list of environment variables and -- corresponding overrides, where@@ -160,15 +159,15 @@ withEnvOverrides :: [(String, Maybe FilePath)] -> IO a -> IO a withEnvOverrides overrides m = do   mb_olds <- traverse lookupEnv envVars-  traverse_ (uncurry update) overrides-  m `Exception.finally` zipWithM_ update envVars mb_olds+  traverse_ (uncurry setOrUnsetEnv) overrides+  m `Exception.finally` zipWithM_ setOrUnsetEnv envVars mb_olds    where     envVars :: [String]     envVars = map fst overrides -    update :: String -> Maybe FilePath -> IO ()-    update var Nothing    = unsetEnv var-    update var (Just val) = setEnv var val+setOrUnsetEnv :: String -> Maybe String -> IO ()+setOrUnsetEnv var Nothing    = unsetEnv var+setOrUnsetEnv var (Just val) = setEnv var val  -- | Executes the action, increasing the PATH environment -- in some way@@ -197,12 +196,10 @@   m `Exception.finally`     (l $ "cabal: Leaving directory '" ++ d ++ "'\n") -foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt- -- The number of processors is not going to change during the duration of the -- program, so unsafePerformIO is safe here. numberOfProcessors :: Int-numberOfProcessors = fromEnum $ unsafePerformIO c_getNumberOfProcessors+numberOfProcessors = unsafePerformIO getNumProcessors  -- | Determine the number of jobs to use given the value of the '-j' flag. determineNumJobs :: Flag (Maybe Int) -> Int@@ -433,7 +430,7 @@ -- | From System.Directory.Extra --   https://hackage.haskell.org/package/extra-1.7.9 listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]-listFilesInside test dir = ifM (notM $ test $ dropTrailingPathSeparator dir) (pure []) $ do+listFilesInside test dir = ifNotM (test $ dropTrailingPathSeparator dir) (pure []) $ do     (dirs,files) <- partitionM doesDirectoryExist =<< listContents dir     rest <- concatMapM (listFilesInside test) dirs     pure $ files ++ rest@@ -455,6 +452,11 @@ ifM :: Monad m => m Bool -> m a -> m a -> m a ifM b t f = do b' <- b; if b' then t else f +-- | 'ifM' with swapped branches:+--   @ifNotM b t f = ifM (not <$> b) t f@+ifNotM :: Monad m => m Bool -> m a -> m a -> m a+ifNotM = flip . ifM+ -- | From Control.Monad.Extra --   https://hackage.haskell.org/package/extra-1.7.9 concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]@@ -471,12 +473,18 @@     (as,bs) <- partitionM f xs     pure ([x | res]++as, [x | not res]++bs) --- | From Control.Monad.Extra---   https://hackage.haskell.org/package/extra-1.7.9-notM :: Functor m => m Bool -> m Bool-notM = fmap not- safeRead :: Read a => String -> Maybe a safeRead s   | [(x, "")] <- reads s = Just x   | otherwise = Nothing++-- | @hasElem xs x = elem x xs@ except that @xs@ is turned into a 'Set' first.+--   Use underapplied to speed up subsequent lookups, e.g. @filter (hasElem xs) ys@.+--   Only amortized when used several times!+--+--   Time complexity \(O((n+m) \log(n))\) for \(m\) lookups in a list of length \(n\).+--   (Compare this to 'elem''s \(O(nm)\).)+--+--   This is [Agda.Utils.List.hasElem](https://hackage.haskell.org/package/Agda-2.6.2.2/docs/Agda-Utils-List.html#v:hasElem).+hasElem :: Ord a => [a] -> a -> Bool+hasElem xs = (`Set.member` Set.fromList xs)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NamedFieldPuns, RecordWildCards, RankNTypes #-}@@ -53,8 +54,11 @@          ( mkVersion ) import qualified Distribution.PackageDescription as PD +#if !MIN_VERSION_base(4,18,0) import Control.Applicative          ( liftA2 )+#endif+ import Control.Exception          ( throw, try ) import Control.Monad.Trans@@ -205,7 +209,7 @@                                srcuri destdir  --- | Syncronise a set of 'SourceRepo's referring to the same repository with+-- | Synchronise a set of 'SourceRepo's referring to the same repository with -- corresponding local directories. The local directories may or may not -- already exist. --@@ -654,7 +658,7 @@ -- -- --                    ----->  foo on branch B ----->---    resolve confict                                  Initial patch+--    resolve conflict                                  Initial patch --                    ----->  foo on branch A -----> -- --    Which is seems reasonable.

@@ -7,10 +7,10 @@ import Distribution.Version  -- This value determines the `cabal-install --version` output.--- --- It is used in several places throughout the project, including anonymous build reports, client configuration, --- and project planning output. Historically, this was a @Paths_*@ module, however, this conflicted with --- program coverage information generated by HPC, and hence was moved to be a standalone value.   --+-- It is used in several places throughout the project, including anonymous build reports, client configuration,+-- and project planning output. Historically, this was a @Paths_*@ module, however, this conflicted with+-- program coverage information generated by HPC, and hence was moved to be a standalone value.+-- cabalInstallVersion :: Version-cabalInstallVersion = mkVersion [3,8,1,0]+cabalInstallVersion = mkVersion [3,10,1,0]

@@ -81,4 +81,3 @@ getChoiceByLongFlag _ _ =   error "Distribution.command.getChoiceByLongFlag: expected a choice option" -

@@ -15,7 +15,6 @@  import Distribution.Client.DistDirLayout import Distribution.Client.ProjectConfig-import Distribution.Client.Config (getCabalDir) import Distribution.Client.HttpUtils import Distribution.Client.TargetSelector hiding (DirActions(..)) import qualified Distribution.Client.TargetSelector as TS (DirActions(..))@@ -51,6 +50,7 @@ import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Simple.Setup (toFlag, HaddockFlags(..), defaultHaddockFlags) import Distribution.Client.Setup (globalCommand)+import Distribution.Client.Config (loadConfig, SavedConfig(savedGlobalFlags)) import Distribution.Simple.Compiler import Distribution.Simple.Command import qualified Distribution.Simple.Flag as Flag@@ -1678,8 +1678,7 @@  configureProject :: FilePath -> ProjectConfig -> IO ProjDetails configureProject testdir cliConfig = do-    cabalDir <- getCabalDir-    let cabalDirLayout = defaultCabalDirLayout cabalDir+    cabalDirLayout <- defaultCabalDirLayout      projectRootDir <- canonicalizePath (basedir </> testdir)     isexplict      <- doesFileExist (projectRootDir </> "cabal.project")@@ -1730,6 +1729,7 @@                          distDirLayout cabalDirLayout                          projectConfig                          localPackages+                         Nothing      return (projDetails,             elaboratedPlan,@@ -1956,6 +1956,15 @@   Just True @=? (fromFlag . globalNix . fromJust $ nixEnabledFlags)   Just False @=? (fromFlag . globalNix . fromJust $ nixDisabledFlags)   Nothing @=? (fromFlag . globalNix . fromJust $ nixDefaultFlags)++  -- Config file options+  defaultConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/default-config"))+  trueConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-true"))+  falseConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-false"))++  Nothing @=? (fromFlag . globalNix . savedGlobalFlags $ defaultConfig)+  Just True @=? (fromFlag . globalNix . savedGlobalFlags $ trueConfig)+  Just False @=? (fromFlag . globalNix . savedGlobalFlags $ falseConfig)   where     fromFlag :: Flag Bool -> Maybe Bool     fromFlag (Flag x) = Just x

@@ -18,26 +18,26 @@ import Distribution.Simple.Flag  tests :: [TestTree]-tests = +tests =     [ configureTests     ]  configureTests :: TestTree configureTests = testGroup "Configure tests"     [ testCase "New config" $ do-        let flags = (defaultNixStyleFlags ()) +        let flags = (defaultNixStyleFlags ())               { configFlags = mempty                   { configOptimization = Flag MaximumOptimisation                   , configVerbosity = Flag silent                   }               }         projConfig <- configureAction' flags [] defaultGlobalFlags-        +         Flag MaximumOptimisation @=?           (packageConfigOptimization . projectConfigLocalPackages $ snd projConfig)      , testCase "Replacement + new config" $ do-        let flags = (defaultNixStyleFlags ()) +        let flags = (defaultNixStyleFlags ())               { configExFlags = mempty                   { configAppend = Flag True }               , configFlags = mempty@@ -51,9 +51,9 @@          Flag NoOptimisation @=? packageConfigOptimization projectConfigLocalPackages         Flag silent         @=? projectConfigVerbosity projectConfigBuildOnly-    +     , testCase "Old + new config" $ do-        let flags = (defaultNixStyleFlags ()) +        let flags = (defaultNixStyleFlags ())               { configExFlags = mempty                   { configAppend = Flag True }               , configFlags = mempty@@ -65,9 +65,9 @@          Flag MaximumOptimisation @=? packageConfigOptimization projectConfigLocalPackages         Flag silent              @=? projectConfigVerbosity projectConfigBuildOnly-    +     , testCase "Old + new config, no appending" $ do-        let flags = (defaultNixStyleFlags ()) +        let flags = (defaultNixStyleFlags ())               { configFlags = mempty                   { configVerbosity = Flag silent }               , projectFlags = mempty@@ -77,9 +77,9 @@          NoFlag      @=? packageConfigOptimization projectConfigLocalPackages         Flag silent @=? projectConfigVerbosity projectConfigBuildOnly-    +     , testCase "Old + new config, backup check" $ do-        let flags = (defaultNixStyleFlags ()) +        let flags = (defaultNixStyleFlags ())               { configFlags = mempty                   { configVerbosity = Flag silent }               , projectFlags = mempty@@ -88,7 +88,7 @@             backup = projectFile <.> "local~"          exists <- doesFileExist backup-        when exists $ +        when exists $           removeFile backup          _ <- configureAction' flags [] defaultGlobalFlags

@@ -39,7 +39,7 @@   , askOption $ \(RunNetworkTests doRunNetTests) ->     testGroup "forkPackages, network tests" $     includeTestsIf doRunNetTests $-    [ testCase "git clone"                   testNetworkGitClone +    [ testCase "git clone"                   testNetworkGitClone     ]   ]   where@@ -234,7 +234,7 @@     case r of       Left e  -> return e       Right _ -> assertFailure $ "expected exception of type "-                              ++ show (typeOf (undefined :: e)) +                              ++ show (typeOf (undefined :: e))   -- | Expect that one line in a file matches exactly the given words (i.e. at

@@ -18,7 +18,7 @@ import Distribution.Simple.PackageIndex import Distribution.Verbosity -tests +tests     :: Verbosity     -> InitFlags     -> Compiler@@ -82,6 +82,6 @@            Left (BreakException ex) -> assertFailure $ show ex           Right _ -> return ()-        +      ]

@@ -68,7 +68,7 @@     pkgDir = evalPrompt (getPackageDir initFlags)       $ fromList ["."]     pkgName = evalPrompt (packageNamePrompt srcDb initFlags)-      $ fromList ["test-package", "y"]+      $ fromList ["test-package", "test-package", "y"]  goldenPkgDescTests     :: Verbosity@@ -215,7 +215,7 @@       (goldenTest "test-build-tools-with-comments.golden") $         let opts = WriteOpts False False False v pkgDir Library pkgName defaultCabalVersion         in runGoldenTest opts testArgs (emptyFlags {buildTools = Flag ["happy"]})-    +     , goldenVsString "Standalone tests, empty flags, not simple, no options, no comments"       (goldenTest "standalone-test-no-comments.golden") $         let opts = WriteOpts False False True v pkgDir TestSuite pkgName defaultCabalVersion@@ -256,7 +256,7 @@     , goldenVsString "Library, empty flags, not simple, no comments + no minimal"       (goldenCabal "cabal-lib-no-comments.golden") $         runGoldenTest (libProjArgs "N") emptyFlags-    +     , goldenVsString "Test suite, empty flags, not simple, with comments + no minimal"       (goldenCabal "cabal-test-suite-with-comments.golden") $         runGoldenTest (testProjArgs "Y") emptyFlags@@ -286,12 +286,12 @@               testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}            mkStanza $ pkgFields ++ [commonStanza, libStanza, testStanza]-        +         (Right (ProjectSettings opts pkgDesc Nothing Nothing (Just testTarget), _)) -> do           let pkgFields = mkPkgDescription opts pkgDesc               commonStanza = mkCommonStanza opts               testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}-          +           mkStanza $ pkgFields ++ [commonStanza, testStanza]          (Right (ProjectSettings _ _ l e t, _)) -> assertFailure $@@ -336,6 +336,7 @@ pkgArgs :: NonEmpty String pkgArgs = fromList     [ "5"+    , "foo-package"     , "foo-package"     , "y"     , "0.1.0.0"

@@ -140,6 +140,7 @@               -- package name               , "test-package"               , "test-package"+              , "test-package"               -- version               , "3.1.2.3"               -- license@@ -246,6 +247,7 @@               -- package name               , "test-package"               , "test-package"+              , "test-package"               -- version               , "3.1.2.3"               -- license@@ -322,7 +324,7 @@             exe  @?= Nothing             test @?! Nothing           Left e -> assertFailure $ show e-    +     , testCase "Check the interactive library workflow" $ do         let inputs = fromList               -- package type@@ -337,6 +339,7 @@               -- package name               , "test-package"               , "test-package"+              , "test-package"               -- version               , "3.1.2.3"               -- license@@ -415,6 +418,7 @@               -- package name               , "test-package"               , "test-package"+              , "test-package"               -- version               , "3.1.2.3"               -- license@@ -507,6 +511,7 @@               -- package name               , "test-package"               , "test-package"+              , "test-package"               -- version               , "3.1.2.3"               -- license@@ -584,6 +589,7 @@               -- package name               , "test-package"               , "test-package"+              , "test-package"               -- version               , "3.1.2.3"               -- license@@ -667,6 +673,7 @@               -- package name               , "test-package"               , "test-package"+              , "test-package"               -- version               , "3.1.2.3"               -- license@@ -739,6 +746,7 @@         let inputs = fromList               [ "1"               -- pick the first cabal version in the list               , "my-test-package" -- package name+              , "my-test-package" -- current dir for the purpose of guessing the package name               , "y"               -- "yes to prompt internal to package name"               , "0.2.0.1"         -- package version               , "2"               -- pick the second license in the list@@ -796,15 +804,18 @@           (packageNamePrompt srcDb) (mkPackageName "test-package")           [ "test-package"           , "test-package"+          , "test-package"           ]       , testSimplePrompt "New package name 2"           (packageNamePrompt srcDb) (mkPackageName "test-package")           [ "test-package"+          , "test-package"           , ""           ]       , testSimplePrompt "Existing package name 1"           (packageNamePrompt srcDb) (mkPackageName "test-package")           [ "test-package"+          , "test-package"           , "cabal-install"           , "y"           , "test-package"@@ -812,6 +823,7 @@       , testSimplePrompt "Existing package name 2"           (packageNamePrompt srcDb) (mkPackageName "cabal-install")           [ "test-package"+          , "test-package"           , "cabal-install"           , "n"           ]@@ -919,14 +931,13 @@             , "Haskell2022"             ]         , testSimplePrompt "Invalid language"-            (`languagePrompt` "test") Haskell2010+            (`languagePrompt` "test") (UnknownLanguage "Lang_TS!")             [ "4"             , "Lang_TS!"-            , "1"             ]         ]     , testGroup "Check srcDirsPrompt output"-        [ testNumberedPrompt "Soruce dirs indices" srcDirsPrompt+        [ testNumberedPrompt "Source dirs indices" srcDirsPrompt             [[defaultSourceDir], ["lib"], ["src-lib"]]         , testSimplePrompt "Other source dir"             srcDirsPrompt ["src"]

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} module UnitTests.Distribution.Client.Init.NonInteractive   ( tests   ) where@@ -24,6 +25,8 @@ import qualified Data.Set as Set import Distribution.Client.Init.Utils (mkPackageNameDep, mkStringyDep) import Distribution.FieldGrammar.Newtypes+import Distribution.Simple.Command+import Distribution.Client.Setup (initCommand)  tests     :: Verbosity@@ -43,6 +46,9 @@     , testGroup "non-interactive tests"       [ nonInteractiveTests pkgIx srcDb comp       ]+    , testGroup "cli parser tests"+      [ cliListParserTests+      ]     ]  driverFunctionTest@@ -331,7 +337,7 @@               , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/bar.y\"]"               ] -        case (_runPrompt $ createProject comp silent pkgIx srcDb (emptyFlags +        case (_runPrompt $ createProject comp silent pkgIx srcDb (emptyFlags             { initializeTestSuite = Flag True             , packageType = Flag LibraryAndExecutable             })) inputs of@@ -475,7 +481,7 @@               , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/bar.y\"]"               ] -        case (_runPrompt $ createProject comp silent pkgIx srcDb (emptyFlags +        case (_runPrompt $ createProject comp silent pkgIx srcDb (emptyFlags             { initializeTestSuite = Flag True             , packageType = Flag Library             })) inputs of@@ -515,7 +521,7 @@             _testOtherExts    test @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]             _testDependencies test @?! []             _testBuildTools   test @?= [mkStringyDep "happy:happy"]-            +             assertBool "The library should be a dependency of the test executable" $               mkPackageNameDep (_optPkgName opts) `elem` _testDependencies test @@ -1265,3 +1271,136 @@   case (_runPrompt $ f emptyFlags) (NEL.fromList inputs) of     Left  x -> g x     Right x -> h x++cliListParserTests :: TestTree+cliListParserTests = testGroup "cli list parser"+  [ testCase "Single extraSrc" $ do+      flags <- runParserTest ["-x", "Generated.hs"]+      flags @?= emptyFlags+        { extraSrc = Flag ["Generated.hs"]+        }+  , testCase "Multiple extraSrc" $ do+      flags <- runParserTest ["-x", "Gen1.hs", "-x", "Gen2.hs", "-x", "Gen3.hs"]+      flags @?= emptyFlags+        { extraSrc = Flag ["Gen1.hs", "Gen2.hs", "Gen3.hs"]+        }+  , testCase "Single extraDoc" $ do+      flags <- runParserTest ["--extra-doc-file", "README"]+      flags @?= emptyFlags+        { extraDoc = Flag $ ["README"]+        }+  , testCase "Multiple extraDoc" $ do+      flags <- runParserTest ["--extra-doc-file", "README",+                              "--extra-doc-file", "CHANGELOG",+                              "--extra-doc-file", "LICENSE"]+      flags @?= emptyFlags+        { extraDoc = Flag $ map fromString ["README", "CHANGELOG", "LICENSE"]+        }+  , testCase "Single exposedModules" $ do+      flags <- runParserTest ["-o", "Test"]+      flags @?= emptyFlags+        { exposedModules = Flag $ map fromString ["Test"]+        }+  , testCase "Multiple exposedModules" $ do+      flags <- runParserTest ["-o", "Test", "-o", "Test2", "-o", "Test3"]+      flags @?= emptyFlags+        { exposedModules = Flag $ map fromString ["Test", "Test2", "Test3"]+        }+  -- there is no otherModules cli flag+  -- , testCase "Single otherModules" $ do+  --     flags <- runParserTest ["-o", "Test"]+  --     flags @?= dummyFlags+  --       { otherModules = Flag $ map fromString ["Test"]+  --       }+  -- , testCase "Multiple otherModules" $ do+  --     flags <- runParserTest ["-o", "Test", "-o", "Test2", "-o", "Test3"]+  --     flags @?= dummyFlags+  --       { otherModules = Flag $ map fromString ["Test", "Test2", "Test3"]+  --       }+  , testCase "Single otherExts" $ do+      flags <- runParserTest ["--extension", "OverloadedStrings"]+      flags @?= emptyFlags+        { otherExts = Flag [EnableExtension OverloadedStrings]+        }+  , testCase "Multiple otherExts" $ do+      flags <- runParserTest ["--extension", "OverloadedStrings",+                              "--extension", "FlexibleInstances",+                              "--extension", "FlexibleContexts"]+      flags @?= emptyFlags+        { otherExts = Flag [EnableExtension OverloadedStrings,+                            EnableExtension FlexibleInstances,+                            EnableExtension FlexibleContexts]+        }+  , testCase "Single dependency" $ do+      flags <- runParserTest ["-d", "base"]+      flags @?= emptyFlags+        { dependencies = Flag [mkStringyDep "base"]+        }+  , testCase "Multiple dependency flags" $ do+      flags <- runParserTest ["-d", "base", "-d", "vector"]+      flags @?= emptyFlags+        { dependencies = Flag $ fmap mkStringyDep ["base", "vector"]+        }+  , testCase "Comma separated list of dependencies" $ do+      flags <- runParserTest ["-d", "base,vector"]+      flags @?= emptyFlags+        { dependencies = Flag $ fmap mkStringyDep ["base", "vector"]+        }+  , testCase "Single applicationDirs" $ do+      flags <- runParserTest ["--application-dir", "app"]+      flags @?= emptyFlags+        { applicationDirs = Flag ["app"]+        }+  , testCase "Multiple applicationDirs" $ do+      flags <- runParserTest ["--application-dir", "app",+                              "--application-dir", "exe",+                              "--application-dir", "srcapp"]+      flags @?= emptyFlags+        { applicationDirs = Flag ["app", "exe", "srcapp"]+        }+  , testCase "Single sourceDirs" $ do+      flags <- runParserTest ["--source-dir", "src"]+      flags @?= emptyFlags+        { sourceDirs = Flag ["src"]+        }+  , testCase "Multiple sourceDirs" $ do+      flags <- runParserTest ["--source-dir", "src",+                              "--source-dir", "lib",+                              "--source-dir", "sources"]+      flags @?= emptyFlags+        { sourceDirs = Flag ["src", "lib", "sources"]+        }+  , testCase "Single buildTools" $ do+      flags <- runParserTest ["--build-tool", "happy"]+      flags @?= emptyFlags+        { buildTools = Flag ["happy"]+        }+  , testCase "Multiple buildTools" $ do+      flags <- runParserTest ["--build-tool", "happy",+                              "--build-tool", "alex",+                              "--build-tool", "make"]+      flags @?= emptyFlags+        { buildTools = Flag ["happy", "alex", "make"]+        }+  , testCase "Single testDirs" $ do+      flags <- runParserTest ["--test-dir", "test"]+      flags @?= emptyFlags+        { testDirs = Flag ["test"]+        }+  , testCase "Multiple testDirs" $ do+      flags <- runParserTest ["--test-dir", "test",+                              "--test-dir", "tests",+                              "--test-dir", "testsuite"]+      flags @?= emptyFlags+        { testDirs = Flag ["test", "tests", "testsuite"]+        }+  ]+  where+    assumeAllParse :: CommandParse (InitFlags -> InitFlags, [String]) -> IO InitFlags+    assumeAllParse = \case+      CommandReadyToGo (flagsF, []) -> pure (flagsF emptyFlags)+      _ -> assertFailure "Expected successful parse"++    runParserTest :: [String] -> IO InitFlags+    runParserTest opts = do+      assumeAllParse $ commandParseArgs initCommand False opts

@@ -50,7 +50,12 @@     [ testCase "Simple lib createProject - no tests" $ do       let inputs = fromList             [ "1"           -- package type: Library-            , "simple-test" -- package dir (ignored, piped to current dir due to prompt monad)+            , "simple.test" -- package dir: used for determining package name;+                            -- note that . will be replaced with - in a sanitization step,+                            -- and we get the expected "simple-test" -- regression test for #8404+            , "simple.test" -- package dir again: the prompt monad needs extra parameter for every+                            -- IO call, and this one will be used for canonicalizePath,+                            -- which is called as a part of sanitization             , "n"           -- no tests             ] @@ -65,7 +70,7 @@         Right (settings', _) -> settings @=? settings'      , testCase "Simple lib createProject - with tests" $ do-      let inputs = fromList ["1", "simple-test", "y", "1"]+      let inputs = fromList ["1", "simple-test", "simple-test", "y", "1"]           flags = emptyFlags { packageType = Flag Library }           settings = ProjectSettings             (WriteOpts False False False v "/home/test/1" Library pkgName defaultCabalVersion)@@ -77,7 +82,7 @@         Right (settings', _) -> settings @=? settings'      , testCase "Simple exe createProject" $ do-      let inputs = fromList ["2", "simple-test"]+      let inputs = fromList ["2", "simple-test", "simple-test"]           flags = emptyFlags { packageType = Flag Executable }           settings = ProjectSettings             (WriteOpts False False False v "/home/test/2" Executable pkgName defaultCabalVersion)@@ -89,7 +94,7 @@         Right (settings', _) -> settings @=? settings'      , testCase "Simple lib+exe createProject - no tests" $ do-      let inputs = fromList ["2", "simple-test", "n"]+      let inputs = fromList ["2", "simple-test", "simple-test", "n"]           flags = emptyFlags { packageType = Flag LibraryAndExecutable }           settings = ProjectSettings             (WriteOpts False False False v "/home/test/2" LibraryAndExecutable pkgName defaultCabalVersion)@@ -100,7 +105,7 @@         Left e -> assertFailure $ "Failed to create simple lib+exe project: " ++ show e         Right (settings', _) -> settings @=? settings'     , testCase "Simple lib+exe createProject - with tests" $ do-      let inputs = fromList ["2", "simple-test", "y", "1"]+      let inputs = fromList ["2", "simple-test", "simple-test", "y", "1"]           flags = emptyFlags { packageType = Flag LibraryAndExecutable }           settings = ProjectSettings             (WriteOpts False False False v "/home/test/2" LibraryAndExecutable pkgName defaultCabalVersion)@@ -113,7 +118,7 @@         Right (settings', _) -> settings @=? settings'      , testCase "Simple standalone tests" $ do-      let inputs = fromList ["2", "simple-test", "y", "1"]+      let inputs = fromList ["2", "simple-test", "simple-test", "y", "1"]           flags = emptyFlags { packageType = Flag TestSuite }           settings = ProjectSettings             (WriteOpts False False False v "/home/test/2" TestSuite pkgName defaultCabalVersion)

@@ -51,7 +51,7 @@ emptyFlags :: InitFlags emptyFlags = mempty --- | Retireves the proper base version based on the GHC version+-- | Retrieves the proper base version based on the GHC version baseVersion :: Compiler -> VersionRange baseVersion Compiler {compilerId = CompilerId GHC ver} =   let ghcToBase = baseVersion' . prettyShow $ ver in@@ -67,7 +67,6 @@ baseVersion' "8.6.5"  = [4,12,0,0] baseVersion' "8.4.4"  = [4,11,1,0] baseVersion' "8.2.2"  = [4,10,1,0]-baseVersion' "8.0.2"  = [4,10,0,0] baseVersion' "7.10.3" = [4,9,0,0] baseVersion' "7.8.4"  = [4,8,0,0] baseVersion' "7.6.3"  = [4,7,0,0]

@@ -124,7 +124,7 @@             (Just ixu, Just ixv) -> ixu > ixv             _                    -> True         | let ixs = array (bounds g)-                          (zip (range (bounds g)) (repeat Nothing) ++ +                          (zip (range (bounds g)) (repeat Nothing) ++                            zip vs (map Just [0::Int ..]))         , (u,v) <- edges g ] 

@@ -29,6 +29,7 @@ import Distribution.Simple.Program.Types import Distribution.Simple.Program.Db import Distribution.Simple.Utils (toUTF8BS)+import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Types.PackageVersionConstraint  import Distribution.Parsec@@ -456,6 +457,7 @@         projectConfigHcPath               <- arbitraryFlag arbitraryShortToken         projectConfigHcPkg                <- arbitraryFlag arbitraryShortToken         projectConfigHaddockIndex         <- arbitrary+        projectConfigInstallDirs          <- fixInstallDirs <$> arbitrary         projectConfigPackageDBs           <- shortListOf 2 arbitrary         projectConfigRemoteRepos          <- arbitrary         projectConfigLocalNoIndexRepos    <- arbitrary@@ -479,12 +481,14 @@         projectConfigOnlyConstrained      <- arbitrary         projectConfigPerComponent         <- arbitrary         projectConfigIndependentGoals     <- arbitrary+        projectConfigPreferOldest         <- arbitrary         projectConfigProgPathExtra        <- toNubList <$> listOf arbitraryShortToken         return ProjectConfigShared {..}       where         arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)]         arbitraryConstraints =             fmap (\uc -> (uc, projectConfigConstraintSource)) <$> arbitrary+        fixInstallDirs x = x {InstallDirs.includedir = mempty, InstallDirs.mandir = mempty, InstallDirs.flibdir = mempty}      shrink ProjectConfigShared {..} = runShrinker $ pure ProjectConfigShared         <*> shrinker projectConfigDistDir@@ -495,6 +499,7 @@         <*> shrinkerAla (fmap NonEmpty) projectConfigHcPath         <*> shrinkerAla (fmap NonEmpty) projectConfigHcPkg         <*> shrinker projectConfigHaddockIndex+        <*> shrinker projectConfigInstallDirs         <*> shrinker projectConfigPackageDBs         <*> shrinker projectConfigRemoteRepos         <*> shrinker projectConfigLocalNoIndexRepos@@ -518,6 +523,7 @@         <*> shrinker projectConfigOnlyConstrained         <*> shrinker projectConfigPerComponent         <*> shrinker projectConfigIndependentGoals+        <*> shrinker projectConfigPreferOldest         <*> shrinker projectConfigProgPathExtra       where         preShrink_Constraints  = map fst@@ -571,10 +577,13 @@         <*> arbitraryFlag arbitraryShortToken         <*> arbitrary         <*> arbitrary+        <*> arbitraryFlag arbitraryShortToken+        <*> arbitraryFlag arbitraryShortToken         <*> arbitrary         <*> arbitrary         <*> arbitrary         <*> arbitrary+        <*> arbitrary         <*> arbitraryFlag arbitraryShortToken         <*> arbitrary         <*> shortListOf 5 arbitrary@@ -634,6 +643,9 @@                          , packageConfigHaddockHscolourCss = x39                          , packageConfigHaddockContents = x40                          , packageConfigHaddockForHackage = x41+                         , packageConfigHaddockIndex = x54+                         , packageConfigHaddockBaseUrl = x55+                         , packageConfigHaddockLib = x56                          , packageConfigTestHumanLog = x44                          , packageConfigTestMachineLog = x45                          , packageConfigTestShowDetails = x46@@ -691,6 +703,9 @@                       , packageConfigHaddockHscolourCss = fmap getNonEmpty x39'                       , packageConfigHaddockContents = x40'                       , packageConfigHaddockForHackage = x41'+                      , packageConfigHaddockIndex = x54'+                      , packageConfigHaddockBaseUrl = x55'+                      , packageConfigHaddockLib = x56'                       , packageConfigTestHumanLog = x44'                       , packageConfigTestMachineLog = x45'                       , packageConfigTestShowDetails = x46'@@ -708,7 +723,8 @@           (x30', x31', x32', (x33', x33_1'), x34'),           (x35', x36', x37', x38', x43', x39'),           (x40', x41'),-          (x44', x45', x46', x47', x48', x49', x51', x52')))+          (x44', x45', x46', x47', x48', x49', x51', x52', x54', x55'),+          x56'))           <- shrink              (((preShrink_Paths x00, preShrink_Args x01, x02, x03, x04),                 (x05, x42, x06, x50, x07, x08, x09),@@ -722,7 +738,7 @@                  (x30, x31, x32, (x33, x33_1), x34),                  (x35, x36, fmap NonEmpty x37, x38, x43, fmap NonEmpty x39),                  (x40, x41),-                 (x44, x45, x46, x47, x48, x49, x51, x52)))+                 (x44, x45, x46, x47, x48, x49, x51, x52, x54, x55), x56))       ]       where         preShrink_Paths  = Map.map NonEmpty@@ -794,6 +810,9 @@  instance Arbitrary IndependentGoals where     arbitrary = IndependentGoals <$> arbitrary++instance Arbitrary PreferOldest where+    arbitrary = PreferOldest <$> arbitrary  instance Arbitrary StrongFlags where     arbitrary = StrongFlags <$> arbitrary

@@ -54,6 +54,7 @@ instance ToExpr PackageConfig instance ToExpr PackageDB instance ToExpr PackageProperty+instance ToExpr PreferOldest instance ToExpr PreSolver instance ToExpr ProjectConfig instance ToExpr ProjectConfigBuildOnly

@@ -301,7 +301,7 @@ -- -- So, given a source repo dir, the corresponding 'RepoState' and a number of -- target repo dirs, pick a sequence of (lists of) sync targets from the--- 'RepoState' and syncronise the target dirs with those targets, checking for+-- 'RepoState' and synchronise the target dirs with those targets, checking for -- each one that the actual working state matches the expected repo state. -- checkSyncRepos

@@ -474,12 +474,14 @@               }             }         pkgCheckErrors =-          -- We ignore these warnings because some unit tests test that the-          -- solver allows unknown extensions/languages when the compiler-          -- supports them.-          let ignore = ["Unknown extensions:", "Unknown languages:"]-          in [ err | err <- C.checkPackage (srcpkgDescription package) Nothing-             , not $ any (`isPrefixOf` C.explanation err) ignore ]+          -- We ignore unknown extensions/languages warnings because+          -- some there are some unit tests test in which the solver allows+          -- unknown extensions/languages when the compiler supports them.+          -- Furthermore we ignore missing upper bound warnings because+          -- they are not related to this test suite, and are tested+          -- with golden tests.+          let checks = C.checkPackage (srcpkgDescription package) Nothing+          in filter (\x -> not (isMissingUpperBound x) && not (isUnknownLangExt x)) checks     in if null pkgCheckErrors        then package        else error $ "invalid GenericPackageDescription for package "@@ -666,6 +668,18 @@         (directDeps, []) -> map mkDirect directDeps         _                -> error "mkSetupDeps: custom setup has non-simple deps" +    -- Check for `UnknownLanguages` and `UnknownExtensions`. See+    isUnknownLangExt :: C.PackageCheck -> Bool+    isUnknownLangExt pc = case C.explanation pc of+                            C.UnknownExtensions {} -> True+                            C.UnknownLanguages {} -> True+                            _ -> False+    isMissingUpperBound :: C.PackageCheck -> Bool+    isMissingUpperBound pc = case C.explanation pc of+                            C.MissingUpperBounds {} -> True+                            _ -> False++ mkSimpleVersion :: ExamplePkgVersion -> C.Version mkSimpleVersion n = C.mkVersion [n, 0, 0] @@ -733,6 +747,7 @@           -> FineGrainedConflicts           -> MinimizeConflictSet           -> IndependentGoals+          -> PreferOldest           -> ReorderGoals           -> AllowBootLibInstalls           -> OnlyConstrained@@ -745,7 +760,7 @@           -> EnableAllTests           -> Progress String String CI.SolverInstallPlan.SolverInstallPlan exResolve db exts langs pkgConfigDb targets mbj countConflicts-          fineGrainedConflicts minimizeConflictSet indepGoals reorder+          fineGrainedConflicts minimizeConflictSet indepGoals prefOldest reorder           allowBootLibInstalls onlyConstrained enableBj solveExes goalOrder           constraints prefs verbosity enableAllTests     = resolveDependencies C.buildPlatform compiler pkgConfigDb Modular params@@ -774,6 +789,7 @@                    $ setFineGrainedConflicts fineGrainedConflicts                    $ setMinimizeConflictSet minimizeConflictSet                    $ setIndependentGoals indepGoals+                   $ (if asBool prefOldest then setPreferenceDefault PreferAllOldest else id)                    $ setReorderGoals reorder                    $ setMaxBackjumps mbj                    $ setAllowBootLibInstalls allowBootLibInstalls

@@ -7,6 +7,7 @@   , disableFineGrainedConflicts   , minimizeConflictSet   , independentGoals+  , preferOldest   , allowBootLibInstalls   , onlyConstrained   , disableBackjumping@@ -66,6 +67,10 @@ independentGoals :: SolverTest -> SolverTest independentGoals test = test { testIndepGoals = IndependentGoals True } +-- | Combinator to turn on --prefer-oldest+preferOldest :: SolverTest -> SolverTest+preferOldest test = test { testPreferOldest = PreferOldest True }+ allowBootLibInstalls :: SolverTest -> SolverTest allowBootLibInstalls test =     test { testAllowBootLibInstalls = AllowBootLibInstalls True }@@ -111,6 +116,7 @@   , testFineGrainedConflicts :: FineGrainedConflicts   , testMinimizeConflictSet  :: MinimizeConflictSet   , testIndepGoals           :: IndependentGoals+  , testPreferOldest         :: PreferOldest   , testAllowBootLibInstalls :: AllowBootLibInstalls   , testOnlyConstrained      :: OnlyConstrained   , testEnableBackjumping    :: EnableBackjumping@@ -208,6 +214,7 @@   , testFineGrainedConflicts = FineGrainedConflicts True   , testMinimizeConflictSet  = MinimizeConflictSet False   , testIndepGoals           = IndependentGoals False+  , testPreferOldest         = PreferOldest False   , testAllowBootLibInstalls = AllowBootLibInstalls False   , testOnlyConstrained      = OnlyConstrainedNone   , testEnableBackjumping    = EnableBackjumping True@@ -230,7 +237,7 @@                      testSupportedLangs testPkgConfigDb testTargets                      testMaxBackjumps (CountConflicts True)                      testFineGrainedConflicts testMinimizeConflictSet-                     testIndepGoals (ReorderGoals False) testAllowBootLibInstalls+                     testIndepGoals testPreferOldest (ReorderGoals False) testAllowBootLibInstalls                      testOnlyConstrained testEnableBackjumping testSolveExecutables                      (sortGoals <$> testGoalOrder) testConstraints                      testSoftConstraints testVerbosity testEnableAllTests

@@ -57,7 +57,7 @@                 r2 = solve' mGoalOrder2 test { testTargets = targets2 }                 solve' goalOrder =                     solve (EnableBackjumping True) (FineGrainedConflicts True)-                          (ReorderGoals False) (CountConflicts True) indepGoals+                          (ReorderGoals False) (CountConflicts True) indepGoals (PreferOldest False)                           (getBlind <$> goalOrder)                 targets = testTargets test                 targets2 = case targetOrder of@@ -74,7 +74,7 @@                 r2 = solve' (IndependentGoals True)  test                 solve' indep =                     solve (EnableBackjumping True) (FineGrainedConflicts True)-                          reorderGoals (CountConflicts True) indep Nothing+                          reorderGoals (CountConflicts True) indep (PreferOldest False)Nothing              in counterexample (showResults r1 r2) $                 noneReachedBackjumpLimit [r1, r2] ==>                 isRight (resultPlan r1) `implies` isRight (resultPlan r2)@@ -85,7 +85,7 @@                 r2 = solve' (EnableBackjumping False) test                 solve' enableBj =                     solve enableBj (FineGrainedConflicts False) reorderGoals-                          (CountConflicts True) indepGoals Nothing+                          (CountConflicts True) indepGoals (PreferOldest False) Nothing              in counterexample (showResults r1 r2) $                 noneReachedBackjumpLimit [r1, r2] ==>                 isRight (resultPlan r1) === isRight (resultPlan r2)@@ -96,11 +96,22 @@                 r2 = solve' (FineGrainedConflicts False) test                 solve' fineGrainedConflicts =                     solve (EnableBackjumping True) fineGrainedConflicts-                    reorderGoals (CountConflicts True) indepGoals Nothing+                    reorderGoals (CountConflicts True) indepGoals (PreferOldest False) Nothing              in counterexample (showResults r1 r2) $                 noneReachedBackjumpLimit [r1, r2] ==>                 isRight (resultPlan r1) === isRight (resultPlan r2) +    , testPropertyWithSeed "prefer oldest does not affect solvability" $+          \test reorderGoals indepGoals ->+            let r1 = solve' (PreferOldest True)  test+                r2 = solve' (PreferOldest False) test+                solve' prefOldest  =+                    solve (EnableBackjumping True) (FineGrainedConflicts True)+                    reorderGoals (CountConflicts True) indepGoals prefOldest Nothing+             in counterexample (showResults r1 r2) $+                noneReachedBackjumpLimit [r1, r2] ==>+                isRight (resultPlan r1) === isRight (resultPlan r2)+     -- The next two tests use --no-count-conflicts, because the goal order used     -- with --count-conflicts depends on the total set of conflicts seen by the     -- solver. The solver explores more of the tree and encounters more@@ -116,7 +127,7 @@                 r2 = solve' (EnableBackjumping False) test                 solve' enableBj =                     solve enableBj (FineGrainedConflicts False) reorderGoals-                          (CountConflicts False) indepGoals Nothing+                          (CountConflicts False) indepGoals (PreferOldest False) Nothing              in counterexample (showResults r1 r2) $                 noneReachedBackjumpLimit [r1, r2] ==>                 resultPlan r1 === resultPlan r2@@ -128,7 +139,7 @@                 r2 = solve' (FineGrainedConflicts False) test                 solve' fineGrainedConflicts =                     solve (EnableBackjumping True) fineGrainedConflicts-                          reorderGoals (CountConflicts False) indepGoals Nothing+                          reorderGoals (CountConflicts False) indepGoals (PreferOldest False) Nothing              in counterexample (showResults r1 r2) $                 noneReachedBackjumpLimit [r1, r2] ==>                 resultPlan r1 === resultPlan r2@@ -163,10 +174,11 @@       -> ReorderGoals       -> CountConflicts       -> IndependentGoals+      -> PreferOldest       -> Maybe VarOrdering       -> SolverTest       -> Result-solve enableBj fineGrainedConflicts reorder countConflicts indep goalOrder test =+solve enableBj fineGrainedConflicts reorder countConflicts indep prefOldest goalOrder test =   let (lg, result) =         runProgress $ exResolve (unTestDb (testDb test)) Nothing Nothing                   (pkgConfigDbFromList [])@@ -175,7 +187,7 @@                   -- too much time and memory.                   (Just defaultMaxBackjumps)                   countConflicts fineGrainedConflicts-                  (MinimizeConflictSet False) indep reorder+                  (MinimizeConflictSet False) indep prefOldest reorder                   (AllowBootLibInstalls False) OnlyConstrainedNone enableBj                   (SolveExecutables True) (unVarOrdering <$> goalOrder)                   (testConstraints test) (testPreferences test) normal

@@ -30,6 +30,8 @@       testGroup "Simple dependencies" [           runTest $         mkTest db1 "alreadyInstalled"   ["A"]      (solverSuccess [])         , runTest $         mkTest db1 "installLatest"      ["B"]      (solverSuccess [("B", 2)])+        , runTest $ preferOldest+                  $         mkTest db1 "installOldest"      ["B"]      (solverSuccess [("B", 1)])         , runTest $         mkTest db1 "simpleDep1"         ["C"]      (solverSuccess [("B", 1), ("C", 1)])         , runTest $         mkTest db1 "simpleDep2"         ["D"]      (solverSuccess [("B", 2), ("D", 1)])         , runTest $         mkTest db1 "failTwoVersions"    ["C", "D"] anySolverFailure@@ -146,11 +148,17 @@         , runTest $ mkTest db12 "baseShim5" ["D"] anySolverFailure         , runTest $ mkTest db12 "baseShim6" ["E"] (solverSuccess [("E", 1), ("syb", 2)])         ]-    , testGroup "Base" [+    , testGroup "Base and Nonupgradable" [           runTest $ mkTest dbBase "Refuse to install base without --allow-boot-library-installs" ["base"] $                       solverFailure (isInfixOf "only already installed instances can be used")         , runTest $ allowBootLibInstalls $ mkTest dbBase "Install base with --allow-boot-library-installs" ["base"] $                       solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)]+        , runTest $ mkTest dbNonupgrade "Refuse to install newer ghc requested by another library" ["A"] $+                      solverFailure (isInfixOf "rejecting: ghc-2.0.0 (constraint from non-upgradeable package requires installed instance)")+        , runTest $ mkTest dbNonupgrade "Refuse to install newer ghci requested by another library" ["B"] $+                      solverFailure (isInfixOf "rejecting: ghci-2.0.0 (constraint from non-upgradeable package requires installed instance)")+        , runTest $ mkTest dbNonupgrade "Refuse to install newer ghc-boot requested by another library" ["C"] $+                      solverFailure (isInfixOf "rejecting: ghc-boot-2.0.0 (constraint from non-upgradeable package requires installed instance)")         ]     , testGroup "reject-unconstrained" [           runTest $ onlyConstrained $ mkTest db12 "missing syb" ["E"] $@@ -1120,6 +1128,19 @@     , Right $ exAv "integer-simple" 1 []     , Right $ exAv "integer-gmp" 1 []     ]++dbNonupgrade :: ExampleDb+dbNonupgrade = [+    Left $ exInst "ghc" 1 "ghc-1" []+  , Left $ exInst "ghci" 1 "ghci-1" []+  , Left $ exInst "ghc-boot" 1 "ghc-boot-1" []+  , Right $ exAv "ghc" 2 []+  , Right $ exAv "ghci" 2 []+  , Right $ exAv "ghc-boot" 2 []+  , Right $ exAv "A" 1 [ExFix "ghc" 2]+  , Right $ exAv "B" 1 [ExFix "ghci" 2]+  , Right $ exAv "C" 1 [ExFix "ghc-boot" 2]+  ]  db13 :: ExampleDb db13 = [