cabal-install 3.12.1.0 → 3.14.1.0

raw patch · 91 files changed

+2484/−1619 lines, 91 filesdep −hashabledep ~Cabaldep ~Cabal-syntaxdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: hashable

Dependency ranges changed: Cabal, Cabal-syntax, base, cabal-install-solver, hackage-security, network-uri, open-browser, process, tasty-quickcheck

API changes (from Hackage documentation)

Files

• cabal-install.cabal +16/−16
• changelog +6/−1
• src/Distribution/Client/Check.hs +5/−3
• src/Distribution/Client/CmdBench.hs +2/−1
• src/Distribution/Client/CmdBuild.hs +3/−2
• src/Distribution/Client/CmdClean.hs +8/−3
• src/Distribution/Client/CmdConfigure.hs +3/−2
• src/Distribution/Client/CmdExec.hs +15/−10
• src/Distribution/Client/CmdFreeze.hs +4/−3
• src/Distribution/Client/CmdHaddock.hs +3/−2
• src/Distribution/Client/CmdHaddockProject.hs +111/−72
• src/Distribution/Client/CmdInstall.hs +21/−18
• src/Distribution/Client/CmdLegacy.hs +36/−16
• src/Distribution/Client/CmdListBin.hs +2/−2
• src/Distribution/Client/CmdOutdated.hs +3/−3
• src/Distribution/Client/CmdRepl.hs +2/−1
• src/Distribution/Client/CmdRun.hs +44/−12
• src/Distribution/Client/CmdSdist.hs +34/−22
• src/Distribution/Client/CmdTest.hs +2/−1
• src/Distribution/Client/CmdUpdate.hs +3/−2
• src/Distribution/Client/Compat/Orphans.hs +1/−1
• src/Distribution/Client/Config.hs +62/−32
• src/Distribution/Client/Configure.hs +32/−24
• src/Distribution/Client/Dependency.hs +20/−3
• src/Distribution/Client/DistDirLayout.hs +11/−11
• src/Distribution/Client/Fetch.hs +2/−6
• src/Distribution/Client/FileMonitor.hs +19/−161
• src/Distribution/Client/Freeze.hs +3/−7
• src/Distribution/Client/GenBounds.hs +4/−11
• src/Distribution/Client/Glob.hs +5/−58
• src/Distribution/Client/HttpUtils.hs +35/−14
• src/Distribution/Client/IndexUtils.hs +10/−15
• src/Distribution/Client/Init.hs +2/−3
• src/Distribution/Client/Init/Defaults.hs +1/−0
• src/Distribution/Client/Init/Format.hs +5/−5
• src/Distribution/Client/Init/Interactive/Command.hs +7/−1
• src/Distribution/Client/Init/NonInteractive/Heuristics.hs +11/−11
• src/Distribution/Client/Init/Types.hs +96/−36
• src/Distribution/Client/Init/Utils.hs +1/−1
• src/Distribution/Client/Install.hs +104/−88
• src/Distribution/Client/InstallSymlink.hs +4/−3
• src/Distribution/Client/List.hs +3/−6
• src/Distribution/Client/Main.hs +216/−105
• src/Distribution/Client/NixStyleOptions.hs +31/−1
• src/Distribution/Client/PackageHash.hs +6/−4
• src/Distribution/Client/ProjectBuilding.hs +27/−23
• src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs +2/−2
• src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs +66/−53
• src/Distribution/Client/ProjectConfig.hs +137/−82
• src/Distribution/Client/ProjectConfig/Legacy.hs +74/−47
• src/Distribution/Client/ProjectConfig/Types.hs +5/−3
• src/Distribution/Client/ProjectOrchestration.hs +17/−12
• src/Distribution/Client/ProjectPlanOutput.hs +12/−17
• src/Distribution/Client/ProjectPlanning.hs +298/−170
• src/Distribution/Client/ProjectPlanning/SetupPolicy.hs +7/−7
• src/Distribution/Client/ProjectPlanning/Types.hs +28/−17
• src/Distribution/Client/RebuildMonad.hs +1/−0
• src/Distribution/Client/Reconfigure.hs +34/−16
• src/Distribution/Client/Run.hs +49/−20
• src/Distribution/Client/Sandbox.hs +15/−6
• src/Distribution/Client/Sandbox/PackageEnvironment.hs +1/−0
• src/Distribution/Client/ScriptUtils.hs +13/−6
• src/Distribution/Client/Security/HTTP.hs +0/−5
• src/Distribution/Client/Setup.hs +97/−15
• src/Distribution/Client/SetupWrapper.hs +155/−93
• src/Distribution/Client/SourceFiles.hs +16/−13
• src/Distribution/Client/SrcDist.hs +23/−13
• src/Distribution/Client/Store.hs +1/−3
• src/Distribution/Client/TargetSelector.hs +27/−25
• src/Distribution/Client/Targets.hs +4/−8
• src/Distribution/Client/Utils.hs +79/−37
• src/Distribution/Client/VCS.hs +1/−1
• src/Distribution/Deprecated/ParseUtils.hs +0/−7
• src/Distribution/Deprecated/ReadP.hs +0/−12
• tests/IntegrationTests2.hs +18/−5
• tests/UnitTests/Distribution/Client/Configure.hs +12/−6
• tests/UnitTests/Distribution/Client/FileMonitor.hs +5/−12
• tests/UnitTests/Distribution/Client/Init.hs +2/−1
• tests/UnitTests/Distribution/Client/Init/FileCreators.hs +1/−1
• tests/UnitTests/Distribution/Client/Init/Golden.hs +5/−5
• tests/UnitTests/Distribution/Client/Init/Interactive.hs +24/−10
• tests/UnitTests/Distribution/Client/Init/NonInteractive.hs +12/−12
• tests/UnitTests/Distribution/Client/Init/Simple.hs +7/−7
• tests/UnitTests/Distribution/Client/ProjectConfig.hs +57/−8
• tests/UnitTests/Distribution/Client/TreeDiffInstances.hs +3/−2
• tests/UnitTests/Distribution/Client/UserConfig.hs +0/−3
• tests/UnitTests/Distribution/Solver/Modular/DSL.hs +9/−5
• tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs +2/−2
• tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs +38/−21
• tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs +86/−3
• tests/UnitTests/Distribution/Solver/Types/OptionalStanza.hs +0/−4

@@ -1,7 +1,7 @@ Cabal-Version:      3.0  Name:               cabal-install-Version:            3.12.1.0+Version:            3.14.1.0 Synopsis:           The command-line interface for Cabal and Hackage. Description:     The \'cabal\' command-line program simplifies the process of managing@@ -40,27 +40,28 @@   manual:       True  common warnings-    ghc-options: -Wall -Wcompat -Wnoncanonical-monad-instances -Wincomplete-uni-patterns -Wincomplete-record-updates+    ghc-options:+      -Wall+      -Wcompat+      -Wnoncanonical-monad-instances+      -Wincomplete-uni-patterns+      -Wincomplete-record-updates+      -Wno-unticked-promoted-constructors      if impl(ghc < 8.8)       ghc-options: -Wnoncanonical-monadfail-instances -    if impl(ghc >=9.0)-      -- Warning: even though introduced with GHC 8.10, -Wunused-packages-      -- gives false positives with GHC 8.10.-      ghc-options: -Wunused-packages- common base-dep-    build-depends: base >=4.11 && <4.21+    build-depends: base >=4.13 && <4.22  common cabal-dep-    build-depends: Cabal ^>=3.12.1.0+    build-depends: Cabal ^>=3.14  common cabal-syntax-dep-    build-depends: Cabal-syntax ^>=3.12.1.0+    build-depends: Cabal-syntax ^>=3.14  common cabal-install-solver-dep-    build-depends: cabal-install-solver ^>=3.12.1.0+    build-depends: cabal-install-solver ^>=3.14  library     import: warnings, base-dep, cabal-dep, cabal-syntax-dep, cabal-install-solver-dep@@ -230,7 +231,6 @@         edit-distance >= 0.2.2 && < 0.3,         exceptions >= 0.10.4   && < 0.11,         filepath   >= 1.4.0.0  && < 1.6,-        hashable   >= 1.0      && < 1.5,         HTTP       >= 4000.1.5 && < 4000.5,         mtl        >= 2.0      && < 2.4,         network-uri >= 2.6.0.2 && < 2.7,@@ -241,7 +241,7 @@         tar        >= 0.5.0.3  && < 0.7,         time       >= 1.5.0.1  && < 1.15,         zlib       >= 0.5.3    && < 0.8,-        hackage-security >= 0.6.2.6 && < 0.7,+        hackage-security >= 0.6.2.0 && < 0.7,         text       >= 1.2.3    && < 1.3 || >= 2.0 && < 2.2,         parsec     >= 3.1.13.0 && < 3.2,         open-browser >= 0.2.1.0 && < 0.3,@@ -349,7 +349,7 @@           zlib,           tasty >= 1.2.3 && <1.6,           tasty-golden >=2.3.1.1 && <2.4,-          tasty-quickcheck <0.11,+          tasty-quickcheck ^>=0.11,           tasty-expected-failure,           tasty-hunit >= 0.10,           tree-diff,@@ -398,6 +398,7 @@         containers,         directory,         filepath,+        process,         tasty >= 1.2.3 && <1.6,         tasty-hunit >= 0.10,         tagged@@ -429,7 +430,6 @@         containers,         directory,         filepath,-        hashable,         mtl,         network-uri >= 2.6.2.0 && <2.7,         random,@@ -437,6 +437,6 @@         tasty >= 1.2.3 && <1.6,         tasty-expected-failure,         tasty-hunit >= 0.10,-        tasty-quickcheck <0.11,+        tasty-quickcheck <0.12,         QuickCheck >= 2.14 && <2.16,         pretty-show >= 1.6.15

@@ -1,9 +1,14 @@ -*-change-log-*- +3.14.1.0 Hécate <hecate+github@glitchbra.in> November 2024+	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.14.1.0.md++3.14.0.0 Hécate <hecate+github@glitchbra.in> September 2024+	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.14.0.0.md+ 3.12.1.0 Artem Pelenitsyn <a.pelenitsyn@gmail.com> June 2024 	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.12.1.0.md -3.10.2.0 Hécate <hecate+github@glitchbra.in> August 2023 3.10.3.0 Hécate <hecate+github@glitchbra.in> January 2024 	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.3.0.md 

@@ -21,6 +21,7 @@ import Distribution.Client.Compat.Prelude import Prelude () +import Distribution.Client.Errors import Distribution.Client.Utils.Parsec (renderParseError) import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Check@@ -29,7 +30,9 @@   , runParseResult   ) import Distribution.Parsec (PWarning (..), showPError)-import Distribution.Simple.Utils (defaultPackageDesc, dieWithException, notice, warn, warnError)+import Distribution.Simple.Utils (defaultPackageDescCwd, dieWithException, notice, warn, warnError)+import Distribution.Utils.Path (getSymbolicPath)+ import System.IO (hPutStr, stderr)  import qualified Control.Monad as CM@@ -37,7 +40,6 @@ import qualified Data.Function as F import qualified Data.List as L import qualified Data.List.NonEmpty as NE-import Distribution.Client.Errors import qualified System.Directory as Dir  readGenericPackageDescriptionCheck :: Verbosity -> FilePath -> IO ([PWarning], GenericPackageDescription)@@ -66,7 +68,7 @@   -- (e.g. @invalid-path-win@) to ignore.   -> IO Bool check verbosity ignores = do-  pdfile <- defaultPackageDesc verbosity+  pdfile <- getSymbolicPath <$> defaultPackageDescCwd verbosity   (ws, ppd) <- readGenericPackageDescriptionCheck verbosity pdfile   -- convert parse warnings into PackageChecks   let ws' = map (wrapParseWarning pdfile) ws

@@ -50,6 +50,7 @@ import Distribution.Simple.Flag   ( fromFlagOrDefault   )+import Distribution.Simple.Setup (CommonSetupFlags (..)) import Distribution.Simple.Utils   ( dieWithException   , warn@@ -150,7 +151,7 @@   buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx   runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes   where-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     cliConfig =       commandLineFlagsToProjectConfig         globalFlags

@@ -40,7 +40,8 @@   , withContextAndSelectors   ) import Distribution.Client.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (..)+  , ConfigFlags (..)   , GlobalFlags   , yesNoOpt   )@@ -184,7 +185,7 @@     buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx     runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes   where-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)  -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE RecordWildCards #-}  module Distribution.Client.CmdClean (cleanCommand, cleanAction) where@@ -51,6 +52,10 @@   , info   , wrapText   )+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  ) import Distribution.Verbosity   ( normal   )@@ -77,7 +82,7 @@ data CleanFlags = CleanFlags   { cleanSaveConfig :: Flag Bool   , cleanVerbosity :: Flag Verbosity-  , cleanDistDir :: Flag FilePath+  , cleanDistDir :: Flag (SymbolicPath Pkg (Dir Dist))   }   deriving (Eq) @@ -132,7 +137,7 @@ cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do   let verbosity = fromFlagOrDefault normal cleanVerbosity       saveConfig = fromFlagOrDefault False cleanSaveConfig-      mdistDirectory = flagToMaybe cleanDistDir+      mdistDirectory = fmap getSymbolicPath $ flagToMaybe cleanDistDir       mprojectDir = flagToMaybe flagProjectDir       mprojectFile = flagToMaybe flagProjectFile @@ -165,7 +170,7 @@         info verbosity ("Deleting dist-newstyle (" ++ distRoot ++ ")")         handleDoesNotExist () $ removeDirectoryRecursive distRoot -    removeEnvFiles (distProjectRootDirectory distLayout)+    removeEnvFiles $ distProjectRootDirectory distLayout    -- Clean specified script build caches and orphaned caches.   -- There is currently no good way to specify to only clean orphaned caches.

@@ -22,6 +22,7 @@   ) import Distribution.Client.ProjectOrchestration import Distribution.Simple.Flag+import Distribution.Simple.Setup (CommonSetupFlags (..))  import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)@@ -123,7 +124,7 @@     then notice v "Config file not written due to flag(s)."     else writeProjectLocalExtraConfig (distDirLayout baseCtx) projConfig   where-    v = fromFlagOrDefault normal (configVerbosity configFlags)+    v = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)  configureAction' :: NixStyleFlags () -> [String] -> GlobalFlags -> IO (ProjectBaseContext, ProjectConfig) configureAction' flags@NixStyleFlags{..} _extraArgs globalFlags = do@@ -164,7 +165,7 @@           return (baseCtx, conf <> cliConfig)         else return (baseCtx, cliConfig)   where-    v = fromFlagOrDefault normal (configVerbosity configFlags)+    v = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     cliConfig =       commandLineFlagsToProjectConfig         globalFlags

@@ -54,8 +54,11 @@   , ElaboratedSharedConfig (..)   ) import qualified Distribution.Client.ProjectPlanning as Planning+import Distribution.Client.ProjectPlanning.Types+  ( dataDirsEnvironmentForPlan+  ) import Distribution.Client.Setup-  ( ConfigFlags (configVerbosity)+  ( ConfigFlags (configCommonFlags)   , GlobalFlags   ) import Distribution.Simple.Command@@ -84,6 +87,7 @@   ( programInvocation   , runProgramInvocation   )+import Distribution.Simple.Setup (CommonSetupFlags (..)) import Distribution.Simple.Utils   ( createDirectoryIfMissingVerbose   , dieWithException@@ -166,14 +170,14 @@    -- Some dependencies may have executables. Let's put those on the PATH.   let extraPaths = pathAdditions baseCtx buildCtx+      pkgProgs = pkgConfigCompilerProgs (elaboratedShared buildCtx)+      extraEnvVars =+        dataDirsEnvironmentForPlan+          (distDirLayout baseCtx)+          (elaboratedPlanToExecute buildCtx)    programDb <--    prependProgramSearchPath-      verbosity-      extraPaths-      . pkgConfigCompilerProgs-      . elaboratedShared-      $ buildCtx+    prependProgramSearchPath verbosity extraPaths extraEnvVars pkgProgs    -- Now that we have the packages, set up the environment. We accomplish this   -- by creating an environment file that selects the databases and packages we@@ -222,7 +226,7 @@             then notice verbosity "Running of executable suppressed by flag(s)"             else runProgramInvocation verbosity invocation   where-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     cliConfig =       commandLineFlagsToProjectConfig         globalFlags@@ -252,10 +256,11 @@   -> ([(String, Maybe String)] -> IO a)   -> IO a withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do-  createDirectoryIfMissingVerbose verbosity True (distTempDirectory (distDirLayout baseCtx))+  let tmpDirTemplate = distTempDirectory (distDirLayout baseCtx)+  createDirectoryIfMissingVerbose verbosity True tmpDirTemplate   withTempDirectory     verbosity-    (distTempDirectory (distDirLayout baseCtx))+    tmpDirTemplate     "environment."     ( \tmpDir -> do         envOverrides <-

@@ -40,7 +40,8 @@   )  import Distribution.Client.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (setupVerbosity)+  , ConfigFlags (..)   , GlobalFlags   ) import Distribution.Package@@ -157,9 +158,9 @@     else do       writeProjectLocalFreezeConfig distDirLayout freezeConfig       notice verbosity $-        "Wrote freeze file: " ++ distProjectFile distDirLayout "freeze"+        "Wrote freeze file: " ++ (distProjectFile distDirLayout "freeze")   where-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     cliConfig =       commandLineFlagsToProjectConfig         globalFlags

@@ -31,7 +31,8 @@   ( ElaboratedSharedConfig (..)   ) import Distribution.Client.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (..)+  , ConfigFlags (..)   , GlobalFlags   , InstallFlags (..)   )@@ -147,7 +148,7 @@   flags@NixStyleFlags{..} <- mkFlagsAbsolute relFlags    let-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     installDoc = fromFlagOrDefault True (installDocumentation installFlags)     flags' = flags{installFlags = installFlags{installDocumentation = Flag installDoc}}     cliConfig = commandLineFlagsToProjectConfig globalFlags flags' mempty -- ClientInstallFlags, not needed here

@@ -3,6 +3,7 @@   , haddockProjectAction   ) where +import Control.Monad (mapM) import Distribution.Client.Compat.Prelude hiding (get) import Prelude () @@ -11,8 +12,8 @@  import Distribution.Client.DistDirLayout   ( CabalDirLayout (..)-  , DistDirLayout (..)   , StoreDirLayout (..)+  , distBuildDirectory   ) import Distribution.Client.InstallPlan (foldPlanPackage) import qualified Distribution.Client.InstallPlan as InstallPlan@@ -24,7 +25,6 @@   , ProjectBaseContext (..)   , ProjectBuildContext (..)   , TargetSelector (..)-  , printPlan   , pruneInstallPlanToTargets   , resolveTargets   , runProjectPreBuildPhase@@ -46,11 +46,20 @@   , withContextAndSelectors   ) import Distribution.Client.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (setupVerbosity)+  , ConfigFlags (..)   , GlobalFlags (..)   ) import Distribution.Client.TargetProblem (TargetProblem (..)) +import Distribution.Simple.BuildPaths+  ( haddockBenchmarkDirPath+  , haddockDirName+  , haddockLibraryDirPath+  , haddockLibraryPath+  , haddockPath+  , haddockTestDirPath+  ) import Distribution.Simple.Command   ( CommandUI (..)   )@@ -74,7 +83,9 @@ import Distribution.Simple.Setup   ( HaddockFlags (..)   , HaddockProjectFlags (..)+  , HaddockTarget (..)   , Visibility (..)+  , defaultCommonSetupFlags   , defaultHaddockFlags   , haddockProjectCommand   )@@ -82,9 +93,11 @@   ( copyDirectoryRecursive   , createDirectoryIfMissingVerbose   , dieWithException+  , info   , warn   ) import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (..))+import Distribution.Types.PackageDescription (PackageDescription (benchmarks, subLibraries, testSuites)) import Distribution.Types.PackageId (pkgName) import Distribution.Types.PackageName (unPackageName) import Distribution.Types.UnitId (unUnitId)@@ -96,7 +109,7 @@  import Distribution.Client.Errors import System.Directory (doesDirectoryExist, doesFileExist)-import System.FilePath (normalise, takeDirectory, (<.>), (</>))+import System.FilePath (normalise, takeDirectory, (</>))  haddockProjectAction :: HaddockProjectFlags -> [String] -> GlobalFlags -> IO () haddockProjectAction flags _extraArgs globalFlags = do@@ -107,9 +120,14 @@   warn verbosity "haddock-project command is experimental, it might break in the future"    -- build all packages with appropriate haddock flags-  let haddockFlags =+  let commonFlags =+        defaultCommonSetupFlags+          { setupVerbosity = haddockProjectVerbosity flags+          }+      haddockFlags =         defaultHaddockFlags-          { haddockHtml = Flag True+          { haddockCommonFlags = commonFlags+          , haddockHtml = Flag True           , -- one can either use `--haddock-base-url` or             -- `--haddock-html-location`.             haddockBaseUrl =@@ -141,16 +159,19 @@                 then Flag (toPathTemplate "../doc-index.html")                 else NoFlag           , haddockKeepTempFiles = haddockProjectKeepTempFiles flags-          , haddockVerbosity = haddockProjectVerbosity flags-          , haddockLib = haddockProjectLib flags-          , haddockOutputDir = haddockProjectOutputDir flags+          , haddockResourcesDir = haddockProjectResourcesDir flags+          , haddockUseUnicode = haddockProjectUseUnicode flags+          -- NOTE: we don't pass `haddockOutputDir`. If we do, we'll need to+          -- make sure `InstalledPackageInfo` contains the right path to+          -- haddock interfaces.  Instead we build documentation inside+          -- `dist-newstyle` directory and copy it to the output directory.           }       nixFlags =         (commandDefaultFlags CmdHaddock.haddockCommand)           { NixStyleOptions.haddockFlags = haddockFlags           , NixStyleOptions.configFlags =               (NixStyleOptions.configFlags (commandDefaultFlags CmdBuild.buildCommand))-                { configVerbosity = haddockProjectVerbosity flags+                { configCommonFlags = commonFlags                 }           } @@ -193,8 +214,6 @@                   elaboratedPlan           return (elaboratedPlan', targets) -      printPlan verbosity baseCtx buildCtx-       let elaboratedPlan :: ElaboratedInstallPlan           elaboratedPlan = elaboratedPlanOriginal buildCtx @@ -249,61 +268,84 @@        packageInfos <- fmap (nub . concat) $ for pkgs $ \pkg ->         case pkg of-          Left _-            | not localStyle ->-                return []-          Left package -> do-            -- TODO: this might not work for public packages with sublibraries.-            -- Issue #9026.+          Left package | localStyle -> 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 ->+                True -> do                   copyDirectoryRecursive verbosity docDir destDir-                    >> return-                      ( Just-                          ( packageName-                          , interfacePath-                          , Hidden-                          )-                      )+                  return $ Just $ Right (packageName, interfacePath, Hidden)                 False -> return Nothing+          Left _ -> return []           Right package ->             case elabLocalToProject package of               True -> do                 let distDirParams = elabDistDirParams sharedConfig' package-                    unitId = unUnitId (elabUnitId package)+                    pkg_descr = elabPkgDescription package++                    packageName = pkgName $ elabPkgSourceId package+                    unitId = elabUnitId package+                    packageDir = haddockDirName ForDevelopment pkg_descr+                    destDir = outputDir </> packageDir+                    interfacePath = destDir </> haddockPath pkg_descr+                     buildDir = distBuildDirectory distLayout distDirParams-                    packageName = unPackageName (pkgName $ elabPkgSourceId package)-                let docDir =+                    docDir =                       buildDir                         </> "doc"                         </> "html"-                        </> packageName-                    destDir = outputDir </> unitId-                    interfacePath =-                      destDir-                        </> packageName-                        <.> "haddock"+                        </> packageDir+                 a <- doesDirectoryExist docDir-                case a of-                  True ->+                if a+                  then do                     copyDirectoryRecursive verbosity docDir destDir-                      >> return-                        [-                          ( unitId-                          , interfacePath-                          , Visible-                          )-                        ]-                  False -> do+                    let infos :: [(String, FilePath, Visibility)]+                        infos =+                          (unPackageName packageName, interfacePath, Visible)+                            : [ (sublibDirPath, sublibInterfacePath, Visible)+                              | lib <- subLibraries pkg_descr+                              , let sublibDirPath = haddockLibraryDirPath ForDevelopment pkg_descr lib+                                    sublibInterfacePath =+                                      outputDir+                                        </> sublibDirPath+                                        </> haddockLibraryPath pkg_descr lib+                              ]+                            ++ [ (testPath, testInterfacePath, Visible)+                               | test <- testSuites pkg_descr+                               , let testPath = haddockTestDirPath ForDevelopment pkg_descr test+                                     testInterfacePath =+                                      outputDir+                                        </> testPath+                                        </> haddockPath pkg_descr+                               ]+                            ++ [ (benchPath, benchInterfacePath, Visible)+                               | bench <- benchmarks pkg_descr+                               , let benchPath = haddockBenchmarkDirPath ForDevelopment pkg_descr bench+                                     benchInterfacePath =+                                      outputDir+                                        </> benchPath+                                        </> haddockPath pkg_descr+                               ]+                    infos' <-+                      mapM+                        ( \x@(_, path, _) -> do+                            e <- doesFileExist path+                            return $+                              if e+                                then Right x+                                else Left path+                        )+                        infos+                    return infos'+                  else do                     warn                       verbosity                       ( "haddocks of "-                          ++ show unitId+                          ++ unUnitId unitId                           ++ " not found in the store"                       )                     return []@@ -311,63 +353,60 @@                 | not localStyle ->                     return []               False -> do-                let packageName = unPackageName (pkgName $ elabPkgSourceId package)+                let pkg_descr = elabPkgDescription package                     unitId = unUnitId (elabUnitId package)                     packageDir =                       storePackageDirectory                         (cabalStoreDirLayout cabalLayout)                         (pkgConfigCompiler sharedConfig')                         (elabUnitId package)+                    -- TODO: use `InstallDirTemplates`                     docDir = packageDir </> "share" </> "doc" </> "html"-                    destDir = outputDir </> packageName-                    interfacePath =-                      destDir-                        </> packageName-                        <.> "haddock"+                    destDir = outputDir </> haddockDirName ForDevelopment pkg_descr+                    interfacePath = destDir </> haddockPath pkg_descr                 a <- doesDirectoryExist docDir                 case a of-                  True ->+                  True -> do                     copyDirectoryRecursive verbosity docDir destDir-                      -- non local packages will be hidden in haddock's-                      -- generated contents page-                      >> return-                        [-                          ( unitId-                          , interfacePath-                          , Hidden-                          )-                        ]+                    -- non local packages will be hidden in haddock's+                    -- generated contents page+                    return [Right (unitId, interfacePath, Hidden)]                   False -> do-                    warn-                      verbosity-                      ( "haddocks of "-                          ++ show unitId-                          ++ " not found in the store"-                      )-                    return []+                    return [Left unitId]        --       -- generate index, content, etc.       -- +      let (missingHaddocks, packageInfos') = partitionEithers packageInfos+      when (not (null missingHaddocks)) $ do+        warn verbosity "missing haddocks for some packages from the store"+        -- Show the package list if `-v1` is passed; it's usually a long list.+        -- One needs to add `package` stantza in `cabal.project` file for+        -- `cabal` to include a version which has haddocks (or set+        -- `documentation: True` in the global config).+        info verbosity (intercalate "\n" missingHaddocks)+       let flags' =             flags               { haddockProjectDir = Flag outputDir               , haddockProjectInterfaces =                   Flag                     [ ( interfacePath-                      , Just name-                      , Just name+                      , Just url+                      , Just url                       , visibility                       )-                    | (name, interfacePath, visibility) <- packageInfos+                    | (url, interfacePath, visibility) <- packageInfos'                     ]+              , haddockProjectUseUnicode = NoFlag               }       createHaddockIndex         verbosity         (pkgConfigCompilerProgs sharedConfig')         (pkgConfigCompiler sharedConfig')         (pkgConfigPlatform sharedConfig')+        Nothing         flags'   where     verbosity = fromFlagOrDefault normal (haddockProjectVerbosity flags)

@@ -97,7 +97,8 @@   ( runRebuild   ) import Distribution.Client.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (..)+  , ConfigFlags (..)   , GlobalFlags (..)   , InstallFlags (..)   )@@ -130,8 +131,9 @@   ( Compiler (..)   , CompilerFlavor (..)   , CompilerId (..)-  , PackageDB (..)-  , PackageDBStack+  , PackageDBCWD+  , PackageDBStackCWD+  , PackageDBX (..)   ) import Distribution.Simple.Configure   ( configCompilerEx@@ -425,8 +427,9 @@     hcFlavor = flagToMaybe projectConfigHcFlavor     hcPath = flagToMaybe projectConfigHcPath     hcPkg = flagToMaybe projectConfigHcPkg+    extraPath = fromNubList packageConfigProgramPathExtra ++ fromNubList projectConfigProgPathExtra -  configProgDb <- prependProgramSearchPath verbosity ((fromNubList packageConfigProgramPathExtra) ++ (fromNubList projectConfigProgPathExtra)) defaultProgramDb+  configProgDb <- prependProgramSearchPath verbosity extraPath [] defaultProgramDb   let     -- ProgramDb with directly user specified paths     preProgDb =@@ -539,7 +542,7 @@           traverseInstall (installCheckUnitExes InstallCheckInstall) installCfg   where     configFlags' = disableTestsBenchsByDefault . ignoreProgramAffixes $ configFlags-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags')+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags')     ignoreProject = flagIgnoreProject projectFlags     cliConfig =       commandLineFlagsToProjectConfig@@ -956,10 +959,10 @@   -> ProjectBuildContext   -> PI.PackageIndex InstalledPackageInfo   -> Compiler-  -> PackageDBStack+  -> PackageDBStackCWD   -> FilePath   -- ^ Environment file-  -> [GhcEnvironmentFileEntry]+  -> [GhcEnvironmentFileEntry FilePath]   -> Bool   -- ^ Whether we need to show a warning (i.e. we created a new environment   --   file, and the user did not use --package-env)@@ -1062,9 +1065,9 @@ -- | Return the package specifiers and non-global environment file entries. getEnvSpecsAndNonGlobalEntries   :: PI.InstalledPackageIndex-  -> [GhcEnvironmentFileEntry]+  -> [GhcEnvironmentFileEntry FilePath]   -> Bool-  -> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])+  -> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry FilePath)]) getEnvSpecsAndNonGlobalEntries installedIndex entries installLibs =   if installLibs     then (envSpecs, envEntries')@@ -1074,8 +1077,8 @@  environmentFileToSpecifiers   :: PI.InstalledPackageIndex-  -> [GhcEnvironmentFileEntry]-  -> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])+  -> [GhcEnvironmentFileEntry FilePath]+  -> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry FilePath)]) environmentFileToSpecifiers ipi = foldMap $ \case   (GhcEnvFilePackageId unitId)     | Just@@ -1123,8 +1126,8 @@       overwritePolicy       installDir       (mkSourceBinDir unit)-      (mkExeName exe)       (mkFinalExeName exe)+      (mkExeName exe)  -- | -- -- * When 'InstallCheckOnly', warn if install would fail overwrite policy@@ -1169,7 +1172,7 @@       errorMessage installdir exe = case overwritePolicy of         NeverOverwrite ->           "Path '"-            <> (installdir </> prettyShow exe)+            <> (installdir </> mkFinalExeName exe)             <> "' already exists. "             <> "Use --overwrite-policy=always to overwrite."         -- This shouldn't even be possible, but we keep it in case symlinking or@@ -1246,7 +1249,7 @@           overwrite  -- | Create 'GhcEnvironmentFileEntry's for packages with exposed libraries.-entriesForLibraryComponents :: TargetsMap -> [GhcEnvironmentFileEntry]+entriesForLibraryComponents :: TargetsMap -> [GhcEnvironmentFileEntry FilePath] entriesForLibraryComponents = Map.foldrWithKey' (\k v -> mappend (go k v)) []   where     hasLib :: (ComponentTarget, NonEmpty TargetSelector) -> Bool@@ -1256,7 +1259,7 @@     go       :: UnitId       -> [(ComponentTarget, NonEmpty TargetSelector)]-      -> [GhcEnvironmentFileEntry]+      -> [GhcEnvironmentFileEntry FilePath]     go unitId targets       | any hasLib targets = [GhcEnvFilePackageId unitId]       | otherwise = []@@ -1288,7 +1291,7 @@ -- | Returns the list of @GhcEnvFilePackageId@ values already existing in the --   environment being operated on. The @Bool@ is @True@ if we took settings --   from an existing file, @False@ otherwise.-getExistingEnvEntries :: Verbosity -> CompilerFlavor -> Bool -> FilePath -> IO (Bool, [GhcEnvironmentFileEntry])+getExistingEnvEntries :: Verbosity -> CompilerFlavor -> Bool -> FilePath -> IO (Bool, [GhcEnvironmentFileEntry FilePath]) getExistingEnvEntries verbosity compilerFlavor supportsPkgEnvFiles envFile = do   envFileExists <- doesFileExist envFile   (usedExisting, allEntries) <-@@ -1332,8 +1335,8 @@   :: Compiler   -> Flag FilePath   -> Flag FilePath-  -> [Maybe PackageDB]-  -> IO PackageDBStack+  -> [Maybe PackageDBCWD]+  -> IO PackageDBStackCWD getPackageDbStack compiler storeDirFlag logsDirFlag packageDbs = do   mstoreDir <- traverse makeAbsolute $ flagToMaybe storeDirFlag   let

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -37,23 +38,37 @@ regularCmd ui action =   CommandSpec ui ((flip commandAddAction) (\flags extra globals -> action flags extra globals)) NormalCommand -wrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> CommandSpec (Client.GlobalFlags -> IO ())-wrapperCmd ui verbosity' distPref =-  CommandSpec ui (\ui' -> wrapperAction ui' verbosity' distPref) NormalCommand+wrapperCmd+  :: Monoid flags+  => CommandUI flags+  -> (flags -> Setup.CommonSetupFlags)+  -> CommandSpec (Client.GlobalFlags -> IO ())+wrapperCmd ui getCommonFlags =+  CommandSpec ui (\ui' -> wrapperAction ui' getCommonFlags) NormalCommand -wrapperAction :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> Command (Client.GlobalFlags -> IO ())-wrapperAction command verbosityFlag distPrefFlag =+wrapperAction+  :: Monoid flags+  => CommandUI flags+  -> (flags -> Setup.CommonSetupFlags)+  -> Command (Client.GlobalFlags -> IO ())+wrapperAction command getCommonFlags =   commandAddAction     command       { commandDefaultFlags = mempty       }     $ \flags extraArgs globalFlags -> do-      let verbosity' = Setup.fromFlagOrDefault normal (verbosityFlag flags)+      let common = getCommonFlags flags+          verbosity' = Setup.fromFlagOrDefault normal (Setup.setupVerbosity common)+          mbWorkDir = Setup.flagToMaybe $ Setup.setupWorkingDir common        load <- try (loadConfigOrSandboxConfig verbosity' globalFlags)       let config = either (\(SomeException _) -> mempty) id load-      distPref <- findSavedDistPref config (distPrefFlag flags)-      let setupScriptOptions = defaultSetupScriptOptions{useDistPref = distPref}+      distPref <- findSavedDistPref config (Setup.setupDistPref common)+      let setupScriptOptions =+            defaultSetupScriptOptions+              { useDistPref = distPref+              , useWorkingDir = mbWorkDir+              }        let command' = command{commandName = T.unpack . T.replace "v1-" "" . T.pack . commandName $ command} @@ -62,7 +77,8 @@         setupScriptOptions         Nothing         command'-        (const flags)+        getCommonFlags+        (const (return flags))         (const extraArgs)  --@@ -89,25 +105,25 @@   verbosity (a, _, _, _, _, _) = verbosity a  instance HasVerbosity Setup.BuildFlags where-  verbosity = verbosity . Setup.buildVerbosity+  verbosity = verbosity . Setup.setupVerbosity . Setup.buildCommonFlags  instance HasVerbosity Setup.ConfigFlags where-  verbosity = verbosity . Setup.configVerbosity+  verbosity = verbosity . Setup.setupVerbosity . Setup.configCommonFlags  instance HasVerbosity Setup.ReplFlags where-  verbosity = verbosity . Setup.replVerbosity+  verbosity = verbosity . Setup.setupVerbosity . Setup.replCommonFlags  instance HasVerbosity Client.FreezeFlags where   verbosity = verbosity . Client.freezeVerbosity  instance HasVerbosity Setup.HaddockFlags where-  verbosity = verbosity . Setup.haddockVerbosity+  verbosity = verbosity . Setup.setupVerbosity . Setup.haddockCommonFlags  instance HasVerbosity Client.UpdateFlags where   verbosity = verbosity . Client.updateVerbosity  instance HasVerbosity Setup.CleanFlags where-  verbosity = verbosity . Setup.cleanVerbosity+  verbosity = verbosity . Setup.setupVerbosity . Setup.cleanCommonFlags  -- @@ -138,8 +154,12 @@ legacyCmd :: HasVerbosity flags => CommandUI flags -> (flags -> [String] -> globals -> IO action) -> [CommandSpec (globals -> IO action)] legacyCmd ui action = toLegacyCmd (regularCmd ui action) -legacyWrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> [CommandSpec (Client.GlobalFlags -> IO ())]-legacyWrapperCmd ui verbosity' distPref = toLegacyCmd (wrapperCmd ui verbosity' distPref)+legacyWrapperCmd+  :: Monoid flags+  => CommandUI flags+  -> (flags -> Setup.CommonSetupFlags)+  -> [CommandSpec (Client.GlobalFlags -> IO ())]+legacyWrapperCmd ui commonFlags = toLegacyCmd (wrapperCmd ui commonFlags)  newCmd :: CommandUI flags -> (flags -> [String] -> globals -> IO action) -> [CommandSpec (globals -> IO action)] newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi]

@@ -49,7 +49,7 @@ import Distribution.Client.TargetProblem (TargetProblem (..)) import Distribution.Simple.BuildPaths (dllExtension, exeExtension) import Distribution.Simple.Command (CommandUI (..))-import Distribution.Simple.Setup (configVerbosity, fromFlagOrDefault)+import Distribution.Simple.Setup (configCommonFlags, fromFlagOrDefault, setupVerbosity) import Distribution.Simple.Utils (dieWithException, withOutputMarker, wrapText) import Distribution.System (Platform) import Distribution.Types.ComponentName (showComponentName)@@ -173,7 +173,7 @@       _ -> dieWithException verbosity MultipleTargetsFound   where     defaultVerbosity = verboseStderr silent-    verbosity = fromFlagOrDefault defaultVerbosity (configVerbosity configFlags)+    verbosity = fromFlagOrDefault defaultVerbosity (setupVerbosity $ configCommonFlags configFlags)      -- this is copied from     elaboratedPackage

@@ -152,6 +152,7 @@  import qualified Data.Set as S import Distribution.Client.Errors+import Distribution.Utils.Path (relativeSymbolicPath) import System.Directory   ( doesFileExist   , getCurrentDirectory@@ -435,9 +436,8 @@ -- | Read the list of dependencies from the package description. depsFromPkgDesc :: Verbosity -> Compiler -> Platform -> IO [PackageVersionConstraint] depsFromPkgDesc verbosity comp platform = do-  cwd <- getCurrentDirectory-  path <- tryFindPackageDesc verbosity cwd-  gpd <- readGenericPackageDescription verbosity path+  path <- tryFindPackageDesc verbosity Nothing+  gpd <- readGenericPackageDescription verbosity Nothing (relativeSymbolicPath path)   let cinfo = compilerInfo comp       epd =         finalizePD

@@ -103,6 +103,7 @@   ) import Distribution.Simple.Setup   ( ReplOptions (..)+  , setupVerbosity   ) import Distribution.Simple.Utils   ( TempFileOptions (..)@@ -505,7 +506,7 @@         go m ("PATH", Just s) = foldl' (\m' f -> Map.insertWith (+) f 1 m') m (splitSearchPath s)         go m _ = m -    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     keepTempFiles = fromFlagOrDefault False replKeepTempFiles      validatedTargets ctx compiler elaboratedPlan targetSelectors = do

@@ -59,9 +59,11 @@   , binDirectoryFor   ) import Distribution.Client.ProjectPlanning.Types-  ( dataDirsEnvironmentForPlan+  ( ElaboratedPackageOrComponent (..)+  , dataDirsEnvironmentForPlan   , elabExeDependencyPaths   )+ import Distribution.Client.ScriptUtils   ( AcceptNoTargets (..)   , TargetContext (..)@@ -70,7 +72,8 @@   , withContextAndSelectors   ) import Distribution.Client.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (setupVerbosity)+  , ConfigFlags (..)   , GlobalFlags (..)   ) import Distribution.Client.TargetProblem@@ -80,6 +83,10 @@   ( giveRTSWarning   , occursOnlyOrBefore   )++import Distribution.Simple.BuildToolDepends+  ( getAllInternalToolDependencies+  ) import Distribution.Simple.Command   ( CommandUI (..)   , usageAlternatives@@ -106,9 +113,17 @@   , warn   , wrapText   )+ import Distribution.Types.ComponentName   ( componentNameRaw   )+import Distribution.Types.Executable as PD+  ( buildInfo+  , exeName+  )+import qualified Distribution.Types.PackageDescription as PD+  ( executables+  ) import Distribution.Types.UnitId   ( UnitId   )@@ -199,7 +214,7 @@       GlobalContext -> return (ctx, normal)       ScriptContext path exemeta -> (,silent) <$> updateContextAndWriteProjectFile ctx path exemeta -    let verbosity = fromFlagOrDefault defaultVerbosity (configVerbosity configFlags)+    let verbosity = fromFlagOrDefault defaultVerbosity (setupVerbosity $ configCommonFlags configFlags)      buildCtx <-       runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do@@ -302,17 +317,34 @@           buildSettingDryRun (buildSettings baseCtx)             || buildSettingOnlyDownload (buildSettings baseCtx) -    let extraPath =-          elabExeDependencyPaths pkg-            ++ ( fromNubList-                  . projectConfigProgPathExtra-                  . projectConfigShared-                  . projectConfig-                  $ baseCtx-               )+    let+      -- HACK alert: when doing a per-package build (e.g. with a Custom setup),+      -- 'elabExeDependencyPaths' will not contain any internal executables+      -- (they are deliberately filtered out; and even if they weren't, they have the wrong paths).+      -- We add them back in here to ensure that any "build-tool-depends" of+      -- the current executable is available in PATH at runtime.+      internalToolDepsOfThisExe+        | ElabPackage{} <- elabPkgOrComp pkg+        , let pkg_descr = elabPkgDescription pkg+        , thisExe : _ <- filter ((== exeName) . unUnqualComponentName . PD.exeName) $ PD.executables pkg_descr+        , let thisExeBI = PD.buildInfo thisExe =+            [ binDirectoryFor (distDirLayout baseCtx) (elaboratedShared buildCtx) pkg depExeNm+            | depExe <- getAllInternalToolDependencies pkg_descr thisExeBI+            , let depExeNm = unUnqualComponentName depExe+            ]+        | otherwise =+            []+      extraPath =+        elabExeDependencyPaths pkg+          ++ ( fromNubList+                . projectConfigProgPathExtra+                . projectConfigShared+                . projectConfig+                $ baseCtx+             )+          ++ internalToolDepsOfThisExe      logExtraProgramSearchPath verbosity extraPath-     progPath <- programSearchPathAsPATHVar (map ProgramSearchPathDir extraPath ++ defaultProgramSearchPath)      if dryRun

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}@@ -26,6 +27,7 @@ import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)   , defaultNixStyleFlags+  , updNixStyleCommonSetupFlags   ) import Distribution.Client.ProjectConfig   ( ProjectConfig@@ -47,7 +49,8 @@   , establishProjectBaseContextWithRoot   ) import Distribution.Client.Setup-  ( GlobalFlags (..)+  ( CommonSetupFlags (..)+  , GlobalFlags (..)   ) import Distribution.Client.TargetSelector   ( ComponentKind@@ -63,6 +66,10 @@ import Distribution.Solver.Types.SourcePackage   ( SourcePackage (..)   )+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  )  import Distribution.Client.Errors import Distribution.Client.SrcDist@@ -94,8 +101,6 @@   ) import Distribution.Simple.Setup   ( Flag (..)-  , configDistPref-  , configVerbosity   , flagToList   , flagToMaybe   , fromFlagOrDefault@@ -166,7 +171,7 @@  data SdistFlags = SdistFlags   { sdistVerbosity :: Flag Verbosity-  , sdistDistDir :: Flag FilePath+  , sdistDistDir :: Flag (SymbolicPath Pkg (Dir Dist))   , sdistListSources :: Flag Bool   , sdistNulSeparated :: Flag Bool   , sdistOutputPath :: Flag FilePath@@ -270,7 +275,13 @@       , Just "-" <- mOutputPath' ->           dieWithException verbosity Can'tWriteMultipleTarballs       | otherwise ->-          traverse_ (\pkg -> packageToSdist verbosity (distProjectRootDirectory distDirLayout) format (outputPath pkg) pkg) pkgs+          for_ pkgs $ \pkg ->+            packageToSdist+              verbosity+              (distProjectRootDirectory distDirLayout)+              format+              (outputPath pkg)+              pkg   where     verbosity = fromFlagOrDefault normal sdistVerbosity     listSources = fromFlagOrDefault False sdistListSources@@ -281,15 +292,15 @@     prjConfig =       commandLineFlagsToProjectConfig         globalFlags-        (defaultNixStyleFlags ())-          { configFlags =-              (configFlags $ defaultNixStyleFlags ())-                { configVerbosity = sdistVerbosity-                , configDistPref = sdistDistDir-                }-          , projectFlags = pf+        (updNixStyleCommonSetupFlags (const commonFlags) $ defaultNixStyleFlags ())+          { projectFlags = pf           }         mempty+    commonFlags =+      mempty+        { setupVerbosity = sdistVerbosity+        , setupDistPref = sdistDistDir+        }      globalConfigFlag = projectConfigConfigFile (projectConfigShared prjConfig) @@ -341,17 +352,18 @@         TarGzArchive -> do           writeLBS =<< BSL.readFile tgz         _ -> dieWithException verbosity $ CannotConvertTarballPackage (show format)-    Right dir -> case format of-      SourceList nulSep -> do-        let gpd :: GenericPackageDescription-            gpd = srcpkgDescription pkg+    Right dir -> do+      case format of+        SourceList nulSep -> do+          let gpd :: GenericPackageDescription+              gpd = srcpkgDescription pkg -        files' <- listPackageSourcesWithDie verbosity dieWithException dir (flattenPackageDescription gpd) knownSuffixHandlers-        let files = nub $ sort $ map normalise files'-        let prefix = makeRelative projectRootDir dir-        write $ concat [prefix </> i ++ [nulSep] | i <- files]-      TarGzArchive -> do-        packageDirToSdist verbosity (srcpkgDescription pkg) dir >>= writeLBS+          files' <- listPackageSourcesWithDie verbosity dieWithException (Just $ makeSymbolicPath dir) (flattenPackageDescription gpd) knownSuffixHandlers+          let files = nub $ sort $ map (normalise . getSymbolicPath) files'+          let prefix = makeRelative (normalise projectRootDir) dir+          write $ concat [prefix </> i ++ [nulSep] | i <- files]+        TarGzArchive -> do+          packageDirToSdist verbosity (srcpkgDescription pkg) dir >>= writeLBS  -- 

@@ -66,6 +66,7 @@ import qualified System.Exit (exitSuccess)  import Distribution.Client.Errors+import Distribution.Client.Setup (CommonSetupFlags (..)) import GHC.Environment   ( getFullArgs   )@@ -163,7 +164,7 @@   runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes   where     failWhenNoTestSuites = testFailWhenNoTestSuites testFlags-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags  -- | This defines what a 'TargetSelector' means for the @test@ command.

@@ -56,7 +56,8 @@   ) import Distribution.Client.ProjectOrchestration import Distribution.Client.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (..)+  , ConfigFlags (..)   , GlobalFlags   , RepoContext (..)   , UpdateFlags@@ -223,7 +224,7 @@           reposToUpdate         traverse_ (\_ -> collectJob jobCtrl) reposToUpdate   where-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here     globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) 

@@ -4,8 +4,8 @@ module Distribution.Client.Compat.Orphans () where  import Control.Exception (SomeException)+import Data.Typeable (typeRep) import Distribution.Compat.Binary (Binary (..))-import Distribution.Compat.Typeable (typeRep) import Distribution.Utils.Structured (Structure (Nominal), Structured (..)) import Network.URI (URI (..), URIAuth (..)) import Prelude (error, return)

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}  -----------------------------------------------------------------------------@@ -177,6 +178,7 @@   ) import Distribution.Simple.Setup   ( BenchmarkFlags (..)+  , CommonSetupFlags (..)   , ConfigFlags (..)   , Flag (..)   , HaddockFlags (..)@@ -204,6 +206,7 @@   , warn   ) import Distribution.Solver.Types.ConstraintSource+import Distribution.Utils.Path (getSymbolicPath, unsafeMakeSymbolicPath) import Distribution.Verbosity   ( normal   )@@ -459,9 +462,21 @@         where           combine = combine' savedClientInstallFlags +      combinedSavedCommonFlags which =+        CommonSetupFlags+          { setupDistPref = combine setupDistPref+          , setupWorkingDir = combine setupWorkingDir+          , setupCabalFilePath = combine setupCabalFilePath+          , setupVerbosity = combine setupVerbosity+          , setupTargets = lastNonEmpty setupTargets+          }+        where+          lastNonEmpty = lastNonEmpty' which+          combine = combine' which+       combinedSavedConfigureFlags =         ConfigFlags-          { configArgs = lastNonEmpty configArgs+          { configCommonFlags = combinedSavedCommonFlags (configCommonFlags . savedConfigureFlags)           , configPrograms_ = configPrograms_ . savedConfigureFlags $ b           , -- TODO: NubListify             configProgramPaths = lastNonEmpty configProgramPaths@@ -475,6 +490,7 @@           , configVanillaLib = combine configVanillaLib           , configProfLib = combine configProfLib           , configProf = combine configProf+          , configProfShared = combine configProfShared           , configSharedLib = combine configSharedLib           , configStaticLib = combine configStaticLib           , configDynExe = combine configDynExe@@ -503,9 +519,6 @@           , configDeterministic = combine configDeterministic           , configIPID = combine configIPID           , configCID = combine configCID-          , configDistPref = combine configDistPref-          , configCabalFilePath = combine configCabalFilePath-          , configVerbosity = combine configVerbosity           , configUserInstall = combine configUserInstall           , -- TODO: NubListify             configPackageDBs = lastNonEmpty configPackageDBs@@ -533,6 +546,7 @@           , configAllowDependingOnPrivateLibs =               combine configAllowDependingOnPrivateLibs           , configCoverageFor = combine configCoverageFor+          , configIgnoreBuildTools = combine configIgnoreBuildTools           }         where           combine = combine' savedConfigureFlags@@ -596,7 +610,8 @@        combinedSavedHaddockFlags =         HaddockFlags-          { -- TODO: NubListify+          { haddockCommonFlags = combinedSavedCommonFlags (haddockCommonFlags . savedHaddockFlags)+          , -- TODO: NubListify             haddockProgramPaths = lastNonEmpty haddockProgramPaths           , -- TODO: NubListify             haddockProgramArgs = lastNonEmpty haddockProgramArgs@@ -614,15 +629,12 @@           , haddockQuickJump = combine haddockQuickJump           , haddockHscolourCss = combine haddockHscolourCss           , haddockContents = combine haddockContents-          , haddockDistPref = combine haddockDistPref           , haddockKeepTempFiles = combine haddockKeepTempFiles-          , haddockVerbosity = combine haddockVerbosity-          , haddockCabalFilePath = combine haddockCabalFilePath           , haddockIndex = combine haddockIndex           , haddockBaseUrl = combine haddockBaseUrl-          , haddockLib = combine haddockLib+          , haddockResourcesDir = combine haddockResourcesDir           , haddockOutputDir = combine haddockOutputDir-          , haddockArgs = lastNonEmpty haddockArgs+          , haddockUseUnicode = combine haddockUseUnicode           }         where           combine = combine' savedHaddockFlags@@ -630,8 +642,7 @@        combinedSavedTestFlags =         TestFlags-          { testDistPref = combine testDistPref-          , testVerbosity = combine testVerbosity+          { testCommonFlags = combinedSavedCommonFlags (testCommonFlags . savedTestFlags)           , testHumanLog = combine testHumanLog           , testMachineLog = combine testMachineLog           , testShowDetails = combine testShowDetails@@ -646,12 +657,10 @@        combinedSavedBenchmarkFlags =         BenchmarkFlags-          { benchmarkDistPref = combine benchmarkDistPref-          , benchmarkVerbosity = combine benchmarkVerbosity+          { benchmarkCommonFlags = combinedSavedCommonFlags (benchmarkCommonFlags . savedBenchmarkFlags)           , benchmarkOptions = lastNonEmpty benchmarkOptions           }         where-          combine = combine' savedBenchmarkFlags           lastNonEmpty = lastNonEmpty' savedBenchmarkFlags        combinedSavedReplMulti = combine' savedReplMulti id@@ -686,7 +695,10 @@           mempty             { configHcFlavor = toFlag defaultCompiler             , configUserInstall = toFlag defaultUserInstall-            , configVerbosity = toFlag normal+            , configCommonFlags =+                mempty+                  { setupVerbosity = toFlag normal+                  }             }       , savedUserInstallDirs =           mempty@@ -1295,18 +1307,9 @@       []     ++ [ viewAsFieldDescr $           optionDistPref-            (configDistPref . savedConfigureFlags)-            ( \distPref config ->-                config-                  { savedConfigureFlags =-                      (savedConfigureFlags config)-                        { configDistPref = distPref-                        }-                  , savedHaddockFlags =-                      (savedHaddockFlags config)-                        { haddockDistPref = distPref-                        }-                  }+            (setupDistPref . configCommonFlags . savedConfigureFlags)+            ( \distPref ->+                updSavedCommonSetupFlags (\common -> common{setupDistPref = distPref})             )             ParseArgs        ]@@ -1328,6 +1331,30 @@     toRelaxDeps True = RelaxDepsAll     toRelaxDeps False = mempty +updSavedCommonSetupFlags+  :: (CommonSetupFlags -> CommonSetupFlags)+  -> SavedConfig+  -> SavedConfig+updSavedCommonSetupFlags setFlag config =+  config+    { savedConfigureFlags =+        let flags = savedConfigureFlags config+            common = configCommonFlags flags+         in flags{configCommonFlags = setFlag common}+    , savedHaddockFlags =+        let flags = savedHaddockFlags config+            common = haddockCommonFlags flags+         in flags{haddockCommonFlags = setFlag common}+    , savedTestFlags =+        let flags = savedTestFlags config+            common = testCommonFlags flags+         in flags{testCommonFlags = setFlag common}+    , savedBenchmarkFlags =+        let flags = savedBenchmarkFlags config+            common = benchmarkCommonFlags flags+         in flags{benchmarkCommonFlags = setFlag common}+    }+ -- TODO: next step, make the deprecated fields elicit a warning. -- deprecatedFieldDescriptions :: [FieldDescr SavedConfig]@@ -1517,6 +1544,9 @@       _ -> [s]     splitMultiPath xs = xs +    splitMultiSymPath =+      map unsafeMakeSymbolicPath . splitMultiPath . map getSymbolicPath+     -- This is a fixup, pending a full config parser rewrite, to     -- ensure that config fields which can be comma-separated lists     -- actually parse as comma-separated lists.@@ -1530,16 +1560,16 @@                         splitMultiPath                           (fromNubList $ configProgramPathExtra scf)                   , configExtraLibDirs =-                      splitMultiPath+                      splitMultiSymPath                         (configExtraLibDirs scf)                   , configExtraLibDirsStatic =-                      splitMultiPath+                      splitMultiSymPath                         (configExtraLibDirsStatic scf)                   , configExtraFrameworkDirs =-                      splitMultiPath+                      splitMultiSymPath                         (configExtraFrameworkDirs scf)                   , configExtraIncludeDirs =-                      splitMultiPath+                      splitMultiSymPath                         (configExtraIncludeDirs scf)                   , configConfigureArgs =                       splitMultiPath

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}  ----------------------------------------------------------------------------- @@ -23,7 +24,6 @@     -- * Saved configure flags   , readConfigFlagsFrom   , readConfigFlags-  , cabalConfigFlagsFile   , writeConfigFlagsTo   , writeConfigFlags   ) where@@ -86,8 +86,8 @@ import Distribution.Simple.Compiler   ( Compiler   , CompilerInfo-  , PackageDB (..)-  , PackageDBStack+  , PackageDBStackCWD+  , PackageDBX (..)   , compilerInfo   ) import Distribution.Simple.PackageDescription@@ -99,14 +99,16 @@   ) import Distribution.Simple.Program (ProgramDb) import Distribution.Simple.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (..)+  , ConfigFlags (..)   , flagToMaybe   , fromFlagOrDefault+  , maybeToFlag   , toFlag   ) import Distribution.Simple.Utils as Utils   ( debug-  , defaultPackageDesc+  , defaultPackageDescCwd   , dieWithException   , notice   , warn@@ -121,6 +123,7 @@   ( PackageVersionConstraint (..)   , thisPackageVersionConstraint   )+import Distribution.Utils.Path import Distribution.Version   ( Version   , VersionRange@@ -129,7 +132,6 @@   )  import Distribution.Client.Errors-import System.FilePath ((</>))  -- | Choose the Cabal version such that the setup scripts compiled against this -- version will support the given command-line flags. Currently, it implements no@@ -142,7 +144,7 @@ -- | Configure the package found in the local directory configure   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Compiler   -> Platform@@ -200,7 +202,8 @@           (setupScriptOptions installedPkgIndex Nothing)           Nothing           configureCommand-          (const configFlags)+          configCommonFlags+          (const (return configFlags))           (const extraArgs)       Right installPlan0 ->         let installPlan = InstallPlan.configureInstallPlan configFlags installPlan0@@ -238,7 +241,7 @@           progdb           ( fromFlagOrDefault               (useDistPref defaultSetupScriptOptions)-              (configDistPref configFlags)+              (setupDistPref $ configCommonFlags configFlags)           )           ( chooseCabalVersion               configExFlags@@ -250,11 +253,11 @@       logMsg message rest = debug verbosity message >> rest  configureSetupScript-  :: PackageDBStack+  :: PackageDBStackCWD   -> Compiler   -> Platform   -> ProgramDb-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -> VersionRange   -> Maybe Lock   -> Bool@@ -305,7 +308,7 @@       -- finding the Cabal lib when compiling any Setup.hs even if we're doing       -- a global install. However we also allow looking in a specific package       -- db.-      packageDBs' :: PackageDBStack+      packageDBs' :: PackageDBStackCWD       index' :: Maybe InstalledPackageIndex       (packageDBs', index') =         case packageDBs of@@ -387,7 +390,7 @@   -> ConfigExFlags   -> InstalledPackageIndex   -> SourcePackageDb-  -> PkgConfigDb+  -> Maybe PkgConfigDb   -> IO (Progress String String SolverInstallPlan) planLocalPackage   verbosity@@ -399,9 +402,9 @@   (SourcePackageDb _ packagePrefs)   pkgConfigDb = do     pkg <--      readGenericPackageDescription verbosity-        =<< case flagToMaybe (configCabalFilePath configFlags) of-          Nothing -> defaultPackageDesc verbosity+      readGenericPackageDescription verbosity Nothing+        =<< case flagToMaybe (setupCabalFilePath $ configCommonFlags configFlags) of+          Nothing -> relativeSymbolicPath <$> defaultPackageDescCwd verbosity           Just fp -> return fp      let@@ -501,7 +504,8 @@       scriptOptions       (Just pkg)       configureCommand-      configureFlags+      configCommonFlags+      (return . configureFlags)       (const extraArgs)     where       gpkg :: PkgDesc.GenericPackageDescription@@ -510,7 +514,12 @@       configureFlags =         filterConfigureFlags           configFlags-            { configIPID =+            { configCommonFlags =+                (configCommonFlags configFlags)+                  { setupVerbosity = toFlag verbosity+                  , setupWorkingDir = maybeToFlag $ useWorkingDir scriptOptions+                  }+            , configIPID =                 if isJust (flagToMaybe (configIPID configFlags))                   then -- Make sure cabal configure --ipid works.                     configIPID configFlags@@ -531,7 +540,6 @@                 ]             , -- Use '--exact-configuration' if supported.               configExactConfiguration = toFlag True-            , configVerbosity = toFlag verbosity             , -- NB: if the user explicitly specified               -- --enable-tests/--enable-benchmarks, always respect it.               -- (But if they didn't, let solver decide.)@@ -570,7 +578,7 @@ readConfigFlagsFrom flags = do   readCommandFlags flags configureExCommand --- | The path (relative to @--build-dir@) where the arguments to @configure@+-- | The path (relative to the package root) where the arguments to @configure@ -- should be saved. cabalConfigFlagsFile :: FilePath -> FilePath cabalConfigFlagsFile dist = dist </> "cabal-config-flags"@@ -586,12 +594,12 @@  -- | Save the configure flags and environment to the specified files. writeConfigFlagsTo-  :: FilePath+  :: Verbosity+  -> FilePath   -- ^ path to saved flags file-  -> Verbosity   -> (ConfigFlags, ConfigExFlags)   -> IO ()-writeConfigFlagsTo file verb flags = do+writeConfigFlagsTo verb file flags = do   writeCommandFlags verb file configureExCommand flags  -- | Save the build flags to the usual location.@@ -602,4 +610,4 @@   -> (ConfigFlags, ConfigExFlags)   -> IO () writeConfigFlags verb dist =-  writeConfigFlagsTo (cabalConfigFlagsFile dist) verb+  writeConfigFlagsTo verb (cabalConfigFlagsFile dist)

@@ -64,6 +64,7 @@   , addDefaultSetupDependencies   , addSetupCabalMinVersionConstraint   , addSetupCabalMaxVersionConstraint+  , addSetupCabalProfiledDynamic   ) where  import Distribution.Client.Compat.Prelude@@ -631,7 +632,7 @@               }         }       where-        isCustom = PD.buildType pkgdesc == PD.Custom+        isCustom = PD.buildType pkgdesc == PD.Custom || PD.buildType pkgdesc == PD.Hooks         gpkgdesc = srcpkgDescription srcpkg         pkgdesc = PD.packageDescription gpkgdesc @@ -671,6 +672,22 @@   where     cabalPkgname = mkPackageName "Cabal" +-- | Add an a lower bound @setup.Cabal >= 3.13@ labeled with 'ConstraintSourceProfiledDynamic'+addSetupCabalProfiledDynamic+  :: DepResolverParams+  -> DepResolverParams+addSetupCabalProfiledDynamic =+  addConstraints+    [ LabeledPackageConstraint+        ( PackageConstraint+            (ScopeAnySetupQualifier cabalPkgname)+            (PackagePropertyVersion $ orLaterVersion (mkVersion [3, 13, 0]))+        )+        ConstraintSourceProfiledDynamic+    ]+  where+    cabalPkgname = mkPackageName "Cabal"+ upgradeDependencies :: DepResolverParams -> DepResolverParams upgradeDependencies = setPreferenceDefault PreferAllLatest @@ -730,7 +747,7 @@         gpkgdesc = srcpkgDescription srcpkg         pkgdesc = PD.packageDescription gpkgdesc         bt = PD.buildType pkgdesc-        affected = bt == PD.Custom && hasBuildableFalse gpkgdesc+        affected = (bt == PD.Custom || bt == PD.Hooks) && hasBuildableFalse gpkgdesc      -- Does this package contain any components with non-empty 'build-depends'     -- and a 'buildable' field that could potentially be set to 'False'? False@@ -764,7 +781,7 @@ resolveDependencies   :: Platform   -> CompilerInfo-  -> PkgConfigDb+  -> Maybe PkgConfigDb   -> DepResolverParams   -> Progress String String SolverInstallPlan resolveDependencies platform comp pkgConfigDB params =

@@ -43,8 +43,9 @@ import Distribution.Simple.Compiler   ( Compiler (..)   , OptimisationLevel (..)-  , PackageDB (..)-  , PackageDBStack+  , PackageDBCWD+  , PackageDBStackCWD+  , PackageDBX (..)   ) import Distribution.Simple.Configure (interpretPackageDbFlags) import Distribution.System@@ -111,7 +112,7 @@   , distSdistDirectory :: FilePath   , distTempDirectory :: FilePath   , distBinDirectory :: FilePath-  , distPackageDB :: CompilerId -> PackageDB+  , distPackageDB :: CompilerId -> PackageDBCWD   , distHaddockOutputDir :: Maybe FilePath   -- ^ Is needed when `--haddock-output-dir` flag is used.   }@@ -121,8 +122,8 @@   { storeDirectory :: Compiler -> FilePath   , storePackageDirectory :: Compiler -> UnitId -> FilePath   , storePackageDBPath :: Compiler -> FilePath-  , storePackageDB :: Compiler -> PackageDB-  , storePackageDBStack :: Compiler -> [Maybe PackageDB] -> PackageDBStack+  , storePackageDB :: Compiler -> PackageDBCWD+  , storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD   , storeIncomingDirectory :: Compiler -> FilePath   , storeIncomingLock :: Compiler -> UnitId -> FilePath   }@@ -144,7 +145,7 @@ -- -- It can either be an implicit project root in the current dir if no -- @cabal.project@ file is found, or an explicit root if either--- the file is found or the project root directory was specicied.+-- the file is found or the project root directory was specified. data ProjectRoot   = -- | An implicit project root. It contains the absolute project     -- root dir.@@ -167,8 +168,7 @@   :: ProjectRoot   -- ^ the project root   -> Maybe FilePath-  -- ^ the @dist@ directory or default-  -- (absolute or relative to the root)+  -- ^ the @dist@ directory (relative to package root)   -> Maybe FilePath   -- ^ the documentation directory   -> DistDirLayout@@ -259,7 +259,7 @@     distPackageDBPath :: CompilerId -> FilePath     distPackageDBPath compid = distDirectory </> "packagedb" </> prettyShow compid -    distPackageDB :: CompilerId -> PackageDB+    distPackageDB :: CompilerId -> PackageDBCWD     distPackageDB = SpecificPackageDB . distPackageDBPath      distHaddockOutputDir :: Maybe FilePath@@ -283,11 +283,11 @@     storePackageDBPath compiler =       storeDirectory compiler </> "package.db" -    storePackageDB :: Compiler -> PackageDB+    storePackageDB :: Compiler -> PackageDBCWD     storePackageDB compiler =       SpecificPackageDB (storePackageDBPath compiler) -    storePackageDBStack :: Compiler -> [Maybe PackageDB] -> PackageDBStack+    storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD     storePackageDBStack compiler extraPackageDB =       (interpretPackageDbFlags False extraPackageDB)         ++ [storePackageDB compiler]

@@ -44,10 +44,6 @@   ( packageId   ) import Distribution.Simple.Compiler-  ( Compiler-  , PackageDBStack-  , compilerInfo-  ) import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Simple.Program   ( ProgramDb@@ -88,7 +84,7 @@ -- | Fetch a list of packages and their dependencies. fetch   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Compiler   -> Platform@@ -161,7 +157,7 @@   -> FetchFlags   -> InstalledPackageIndex   -> SourcePackageDb-  -> PkgConfigDb+  -> Maybe PkgConfigDb   -> [PackageSpecifier UnresolvedSourcePackage]   -> IO [UnresolvedSourcePackage] planPackages

@@ -11,22 +11,7 @@ -- input values they depend on have changed. module Distribution.Client.FileMonitor   ( -- * Declaring files to monitor-    MonitorFilePath (..)-  , MonitorKindFile (..)-  , MonitorKindDir (..)-  , RootedGlob (..)-  , monitorFile-  , monitorFileHashed-  , monitorNonExistentFile-  , monitorFileExistence-  , monitorDirectory-  , monitorNonExistentDirectory-  , monitorDirectoryExistence-  , monitorFileOrDirectory-  , monitorFileGlob-  , monitorFileGlobExistence-  , monitorFileSearchPath-  , monitorFileHashedSearchPath+      module Distribution.Simple.FileMonitor.Types      -- * Creating and checking sets of monitored files   , FileMonitor (..)@@ -50,7 +35,6 @@  import Data.Binary.Get (runGetOrFail) import qualified Data.ByteString.Lazy as BS-import qualified Data.Hashable as Hashable import qualified Data.Map.Strict as Map  import Control.Exception@@ -66,133 +50,18 @@ import Control.Monad.Trans (MonadIO, liftIO)  import Distribution.Client.Glob+import Distribution.Client.HashValue import Distribution.Client.Utils (MergeResult (..), mergeBy) import Distribution.Compat.Time+import Distribution.Simple.FileMonitor.Types import Distribution.Simple.Utils (handleDoesNotExist, writeFileAtomic) import Distribution.Utils.Structured (Tag (..), structuredEncode)+ import System.Directory import System.FilePath import System.IO  --------------------------------------------------------------------------------- Types for specifying files to monitor------- | A description of a file (or set of files) to monitor for changes.------ Where file paths are relative they are relative to a common directory--- (e.g. project root), not necessarily the process current directory.-data MonitorFilePath-  = MonitorFile-      { monitorKindFile :: !MonitorKindFile-      , monitorKindDir :: !MonitorKindDir-      , monitorPath :: !FilePath-      }-  | MonitorFileGlob-      { monitorKindFile :: !MonitorKindFile-      , monitorKindDir :: !MonitorKindDir-      , monitorPathGlob :: !RootedGlob-      }-  deriving (Eq, Show, Generic)--data MonitorKindFile-  = FileExists-  | FileModTime-  | FileHashed-  | FileNotExists-  deriving (Eq, Show, Generic)--data MonitorKindDir-  = DirExists-  | DirModTime-  | DirNotExists-  deriving (Eq, Show, Generic)--instance Binary MonitorFilePath-instance Binary MonitorKindFile-instance Binary MonitorKindDir--instance Structured MonitorFilePath-instance Structured MonitorKindFile-instance Structured MonitorKindDir---- | Monitor a single file for changes, based on its modification time.--- The monitored file is considered to have changed if it no longer--- exists or if its modification time has changed.-monitorFile :: FilePath -> MonitorFilePath-monitorFile = MonitorFile FileModTime DirNotExists---- | Monitor a single file for changes, based on its modification time--- and content hash. The monitored file is considered to have changed if--- it no longer exists or if its modification time and content hash have--- changed.-monitorFileHashed :: FilePath -> MonitorFilePath-monitorFileHashed = MonitorFile FileHashed DirNotExists---- | Monitor a single non-existent file for changes. The monitored file--- is considered to have changed if it exists.-monitorNonExistentFile :: FilePath -> MonitorFilePath-monitorNonExistentFile = MonitorFile FileNotExists DirNotExists---- | Monitor a single file for existence only. The monitored file is--- considered to have changed if it no longer exists.-monitorFileExistence :: FilePath -> MonitorFilePath-monitorFileExistence = MonitorFile FileExists DirNotExists---- | Monitor a single directory for changes, based on its modification--- time. The monitored directory is considered to have changed if it no--- longer exists or if its modification time has changed.-monitorDirectory :: FilePath -> MonitorFilePath-monitorDirectory = MonitorFile FileNotExists DirModTime---- | Monitor a single non-existent directory for changes.  The monitored--- directory is considered to have changed if it exists.-monitorNonExistentDirectory :: FilePath -> MonitorFilePath--- Just an alias for monitorNonExistentFile, since you can't--- tell the difference between a non-existent directory and--- a non-existent file :)-monitorNonExistentDirectory = monitorNonExistentFile---- | Monitor a single directory for existence. The monitored directory is--- considered to have changed only if it no longer exists.-monitorDirectoryExistence :: FilePath -> MonitorFilePath-monitorDirectoryExistence = MonitorFile FileNotExists DirExists---- | Monitor a single file or directory for changes, based on its modification--- time. The monitored file is considered to have changed if it no longer--- exists or if its modification time has changed.-monitorFileOrDirectory :: FilePath -> MonitorFilePath-monitorFileOrDirectory = MonitorFile FileModTime DirModTime---- | Monitor a set of files (or directories) identified by a file glob.--- The monitored glob is considered to have changed if the set of files--- matching the glob changes (i.e. creations or deletions), or for files if the--- modification time and content hash of any matching file has changed.-monitorFileGlob :: RootedGlob -> MonitorFilePath-monitorFileGlob = MonitorFileGlob FileHashed DirExists---- | Monitor a set of files (or directories) identified by a file glob for--- existence only. The monitored glob is considered to have changed if the set--- of files matching the glob changes (i.e. creations or deletions).-monitorFileGlobExistence :: RootedGlob -> MonitorFilePath-monitorFileGlobExistence = MonitorFileGlob FileExists DirExists---- | Creates a list of files to monitor when you search for a file which--- unsuccessfully looked in @notFoundAtPaths@ before finding it at--- @foundAtPath@.-monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]-monitorFileSearchPath notFoundAtPaths foundAtPath =-  monitorFile foundAtPath-    : map monitorNonExistentFile notFoundAtPaths---- | Similar to 'monitorFileSearchPath', but also instructs us to--- monitor the hash of the found file.-monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]-monitorFileHashedSearchPath notFoundAtPaths foundAtPath =-  monitorFileHashed foundAtPath-    : map monitorNonExistentFile notFoundAtPaths-------------------------------------------------------------------------------- -- Implementation types, files status -- @@ -214,8 +83,6 @@ instance Binary MonitorStateFileSet instance Structured MonitorStateFileSet -type Hash = Int- -- | The state necessary to determine whether a monitored file has changed. -- -- This covers all the cases of 'MonitorFilePath' except for globs which is@@ -238,7 +105,7 @@   | -- | cached file mtime     MonitorStateFileModTime !ModTime   | -- | cached mtime and content hash-    MonitorStateFileHashed !ModTime !Hash+    MonitorStateFileHashed !ModTime !HashValue   | MonitorStateDirExists   | -- | cached dir mtime     MonitorStateDirModTime !ModTime@@ -1092,21 +959,21 @@ -- updating a file monitor the set of files is the same or largely the same so -- we can grab the previously known content hashes with their corresponding -- mtimes.-type FileHashCache = Map FilePath (ModTime, Hash)+type FileHashCache = Map FilePath (ModTime, HashValue)  -- | We declare it a cache hit if the mtime of a file is the same as before.-lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe Hash+lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe HashValue lookupFileHashCache hashcache file mtime = do   (mtime', hash) <- Map.lookup file hashcache   guard (mtime' == mtime)   return hash  -- | Either get it from the cache or go read the file-getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO Hash+getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO HashValue getFileHash hashcache relfile absfile mtime =   case lookupFileHashCache hashcache relfile mtime of     Just hash -> return hash-    Nothing -> readFileHash absfile+    Nothing -> readFileHashValue absfile  -- | Build a 'FileHashCache' from the previous 'MonitorStateFileSet'. While -- in principle we could preserve the structure of the previous state, given@@ -1129,7 +996,7 @@       collectAllFileHashes singlePaths         `Map.union` collectAllGlobHashes globPaths -    collectAllFileHashes :: [MonitorStateFile] -> Map FilePath (ModTime, Hash)+    collectAllFileHashes :: [MonitorStateFile] -> Map FilePath (ModTime, HashValue)     collectAllFileHashes singlePaths =       Map.fromList         [ (fpath, (mtime, hash))@@ -1141,7 +1008,7 @@             singlePaths         ] -    collectAllGlobHashes :: [MonitorStateGlob] -> Map FilePath (ModTime, Hash)+    collectAllGlobHashes :: [MonitorStateGlob] -> Map FilePath (ModTime, HashValue)     collectAllGlobHashes globPaths =       Map.fromList         [ (fpath, (mtime, hash))@@ -1149,7 +1016,7 @@         , (fpath, (mtime, hash)) <- collectGlobHashes "" gstate         ] -    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Hash))]+    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, HashValue))]     collectGlobHashes dir (MonitorStateGlobDirs _ _ _ entries) =       [ res       | (subdir, fstate) <- entries@@ -1174,13 +1041,13 @@   unless unchanged (somethingChanged file)  -- | Within the @root@ directory, check if @file@ has its 'ModTime' and--- 'Hash' is the same as @mtime@ and @hash@, short-circuiting if it is+-- 'HashValue' is the same as @mtime@ and @hash@, short-circuiting if it is -- different. probeFileModificationTimeAndHash   :: FilePath   -> FilePath   -> ModTime-  -> Hash+  -> HashValue   -> ChangedM () probeFileModificationTimeAndHash root file mtime hash = do   unchanged <-@@ -1223,12 +1090,12 @@     return (mtime == mtime')  -- | Returns @True@ if, inside the @root@ directory, @file@ has the--- same 'ModTime' and 'Hash' as @mtime and @chash@.+-- same 'ModTime' and 'HashValue' as @mtime and @chash@. checkFileModificationTimeAndHashUnchanged   :: FilePath   -> FilePath   -> ModTime-  -> Hash+  -> HashValue   -> IO Bool checkFileModificationTimeAndHashUnchanged root file mtime chash =   handleIOException False $ do@@ -1236,15 +1103,9 @@     if mtime == mtime'       then return True       else do-        chash' <- readFileHash (root </> file)+        chash' <- readFileHashValue (root </> file)         return (chash == chash') --- | Read a non-cryptographic hash of a @file@.-readFileHash :: FilePath -> IO Hash-readFileHash file =-  withBinaryFile file ReadMode $ \hnd ->-    evaluate . Hashable.hash =<< BS.hGetContents hnd- -- | Given a directory @dir@, return @Nothing@ if its 'ModTime' -- is the same as @mtime@, and the new 'ModTime' if it is not. checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)@@ -1258,12 +1119,9 @@ -- | Run an IO computation, returning the first argument @e@ if there is an 'error' -- call. ('ErrorCall') handleErrorCall :: a -> IO a -> IO a-handleErrorCall e = handle handler where-#if MIN_VERSION_base(4,9,0)+handleErrorCall e = handle handler+  where     handler (ErrorCallWithLocation _ _) = return e-#else-    handler (ErrorCall _) = return e-#endif  -- | Run an IO computation, returning @e@ if there is any 'IOException'. --

@@ -61,10 +61,6 @@   , packageVersion   ) import Distribution.Simple.Compiler-  ( Compiler-  , PackageDBStack-  , compilerInfo-  ) import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Simple.Program   ( ProgramDb@@ -98,7 +94,7 @@ -- constraining each dependency to an exact version. freeze   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Compiler   -> Platform@@ -146,7 +142,7 @@ -- command. getFreezePkgs   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Compiler   -> Platform@@ -199,7 +195,7 @@   -> FreezeFlags   -> InstalledPackageIndex   -> SourcePackageDb-  -> PkgConfigDb+  -> Maybe PkgConfigDb   -> [PackageSpecifier UnresolvedSourcePackage]   -> IO [SolverPlanPackage] planPackages

@@ -46,10 +46,6 @@   ( finalizePD   ) import Distribution.Simple.Compiler-  ( Compiler-  , PackageDBStack-  , compilerInfo-  ) import Distribution.Simple.PackageDescription   ( readGenericPackageDescription   )@@ -67,6 +63,7 @@   ( defaultComponentRequestedSpec   ) import Distribution.Types.Dependency+import Distribution.Utils.Path (relativeSymbolicPath) import Distribution.Version   ( LowerBound (..)   , UpperBound (..)@@ -80,9 +77,6 @@   , intersectVersionRanges   , orLaterVersion   )-import System.Directory-  ( getCurrentDirectory-  )  -- | Given a version, return an API-compatible (according to PVP) version range. --@@ -121,7 +115,7 @@ -- | Entry point for the @gen-bounds@ command. genBounds   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Compiler   -> Platform@@ -132,9 +126,8 @@ genBounds verbosity packageDBs repoCtxt comp platform progdb globalFlags freezeFlags = do   let cinfo = compilerInfo comp -  cwd <- getCurrentDirectory-  path <- tryFindPackageDesc verbosity cwd-  gpd <- readGenericPackageDescription verbosity path+  path <- relativeSymbolicPath <$> tryFindPackageDesc verbosity Nothing+  gpd <- readGenericPackageDescription verbosity Nothing path   -- NB: We don't enable tests or benchmarks, since often they   -- don't really have useful bounds.   let epd =

@@ -12,48 +12,25 @@   , Glob (..)   , GlobPiece (..)   , GlobPieces-  , matchGlob-  , matchGlobPieces   , matchFileGlob   ) where  import Distribution.Client.Compat.Prelude import Prelude () +import Distribution.Simple.FileMonitor.Types import Distribution.Simple.Glob import Distribution.Simple.Glob.Internal+  ( Glob (..)+  , GlobPiece (..)+  , GlobPieces+  )  import System.Directory import System.FilePath -import qualified Distribution.Compat.CharParsing as P-import qualified Text.PrettyPrint as Disp- -------------------------------------------------------------------------------- --- | A file path specified by globbing, relative--- to some root directory.-data RootedGlob-  = RootedGlob-      FilePathRoot-      -- ^ what the glob is relative to-      Glob-      -- ^ the glob-  deriving (Eq, Show, Generic)--instance Binary RootedGlob-instance Structured RootedGlob--data FilePathRoot-  = FilePathRelative-  | -- | e.g. @"/"@, @"c:\"@ or result of 'takeDrive'-    FilePathRoot FilePath-  | FilePathHomeDir-  deriving (Eq, Show, Generic)--instance Binary FilePathRoot-instance Structured FilePathRoot- -- | Check if a 'RootedGlob' doesn't actually make use of any globbing and -- is in fact equivalent to a non-glob 'FilePath'. --@@ -105,33 +82,3 @@   case globroot of     FilePathRelative -> return matches     _ -> return (map (root </>) matches)----------------------------------------------------------------------------------- Parsing & pretty-printing-----instance Pretty RootedGlob where-  pretty (RootedGlob root pathglob) = pretty root Disp.<> pretty pathglob--instance Parsec RootedGlob where-  parsec = do-    root <- parsec-    case root of-      FilePathRelative -> RootedGlob root <$> parsec-      _ -> RootedGlob root <$> parsec <|> pure (RootedGlob root GlobDirTrailing)--instance Pretty FilePathRoot where-  pretty FilePathRelative = Disp.empty-  pretty (FilePathRoot root) = Disp.text root-  pretty FilePathHomeDir = Disp.char '~' Disp.<> Disp.char '/'--instance Parsec FilePathRoot where-  parsec = root <|> P.try home <|> P.try drive <|> pure FilePathRelative-    where-      root = FilePathRoot "/" <$ P.char '/'-      home = FilePathHomeDir <$ P.string "~/"-      drive = do-        dr <- P.satisfy $ \c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')-        _ <- P.char ':'-        _ <- P.char '/' <|> P.char '\\'-        return (FilePathRoot (toUpper dr : ":\\"))

@@ -192,7 +192,7 @@   -- Only use the external http transports if we actually have to   -- (or have been told to do so)   let transport'-        | uriScheme uri == "http:"+        | isHttpURI uri         , not (transportManuallySelected transport) =             plainHttpTransport         | otherwise =@@ -251,20 +251,35 @@ -- Utilities for repo url management -- +-- | If the remote repo is accessed over HTTPS, ensure that the transport+-- supports HTTPS. remoteRepoCheckHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO ()-remoteRepoCheckHttps verbosity transport repo-  | uriScheme (remoteRepoURI repo) == "https:"-  , not (transportSupportsHttps transport) =-      dieWithException verbosity $ RemoteRepoCheckHttps (unRepoName (remoteRepoName repo)) requiresHttpsErrorMessage-  | otherwise = return ()+remoteRepoCheckHttps verbosity transport repo =+  transportCheckHttpsWithError verbosity transport (remoteRepoURI repo) $+    RemoteRepoCheckHttps (unRepoName (remoteRepoName repo)) requiresHttpsErrorMessage +-- | If the URI scheme is HTTPS, ensure the transport supports HTTPS. transportCheckHttps :: Verbosity -> HttpTransport -> URI -> IO ()-transportCheckHttps verbosity transport uri-  | uriScheme uri == "https:"+transportCheckHttps verbosity transport uri =+  transportCheckHttpsWithError verbosity transport uri $+    TransportCheckHttps uri requiresHttpsErrorMessage++-- | If the URI scheme is HTTPS, ensure the transport supports HTTPS.+-- If not, fail with the given error.+transportCheckHttpsWithError+  :: Verbosity -> HttpTransport -> URI -> CabalInstallException -> IO ()+transportCheckHttpsWithError verbosity transport uri err+  | isHttpsURI uri   , not (transportSupportsHttps transport) =-      dieWithException verbosity $ TransportCheckHttps uri requiresHttpsErrorMessage+      dieWithException verbosity err   | otherwise = return () +isHttpsURI :: URI -> Bool+isHttpsURI uri = uriScheme uri == "https:"++isHttpURI :: URI -> Bool+isHttpURI uri = uriScheme uri == "http:"+ requiresHttpsErrorMessage :: String requiresHttpsErrorMessage =   "requires HTTPS however the built-in HTTP implementation "@@ -280,12 +295,12 @@ remoteRepoTryUpgradeToHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO RemoteRepo remoteRepoTryUpgradeToHttps verbosity transport repo   | remoteRepoShouldTryHttps repo-  , uriScheme (remoteRepoURI repo) == "http:"+  , isHttpURI (remoteRepoURI repo)   , not (transportSupportsHttps transport)   , not (transportManuallySelected transport) =       dieWithException verbosity $ TryUpgradeToHttps [name | (name, _, True, _) <- supportedTransports]   | remoteRepoShouldTryHttps repo-  , uriScheme (remoteRepoURI repo) == "http:"+  , isHttpURI (remoteRepoURI repo)   , transportSupportsHttps transport =       return         repo@@ -408,7 +423,7 @@    case find (\(name', _, _, _) -> name' == name) supportedTransports of     Just (_, mprog, _tls, mkTrans) -> do-      baseProgDb <- prependProgramSearchPath verbosity extraPath emptyProgramDb+      baseProgDb <- prependProgramSearchPath verbosity extraPath [] emptyProgramDb       progdb <- case mprog of         Nothing -> return emptyProgramDb         Just prog -> snd <$> requireProgram verbosity prog baseProgDb@@ -424,7 +439,7 @@    -- for all the transports except plain-http we need to try and find   -- their external executable-  baseProgDb <- prependProgramSearchPath verbosity extraPath emptyProgramDb+  baseProgDb <- prependProgramSearchPath verbosity extraPath [] emptyProgramDb   progdb <-     configureAllKnownPrograms verbosity $       addKnownPrograms@@ -505,12 +520,18 @@             (Just (Left (uname, passwd)), _) -> Just $ Left (uname ++ ":" ++ passwd)             (Nothing, Just a) -> Just $ Left a             (Nothing, Nothing) -> Nothing+      let authnSchemeArg+            -- When using TLS, we can accept Basic authentication.  Let curl+            -- decide based on the scheme(s) offered by the server.+            | isHttpsURI uri = "--anyauth"+            -- When not using TLS, force Digest scheme+            | otherwise = "--digest"       case mbAuthStringToken of         Just (Left up) ->           progInvocation             { progInvokeInput =                 Just . IODataText . unlines $-                  [ "--digest"+                  [ authnSchemeArg                   , "--user " ++ up                   ]             , progInvokeArgs = ["--config", "-"] ++ progInvokeArgs progInvocation

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}@@ -82,9 +83,6 @@   , emptyPackageDescription   ) import Distribution.Simple.Compiler-  ( Compiler-  , PackageDBStack-  ) import qualified Distribution.Simple.Configure as Configure   ( getInstalledPackages   , getInstalledPackagesMonitorFiles@@ -114,7 +112,6 @@   , parseGenericPackageDescriptionMaybe   ) import qualified Distribution.PackageDescription.Parsec as PackageDesc.Parse-import qualified Distribution.Simple.PackageDescription as PackageDesc.Parse  import Distribution.Solver.Types.PackageIndex (PackageIndex) import qualified Distribution.Solver.Types.PackageIndex as PackageIndex@@ -134,7 +131,7 @@ import Distribution.Client.GZipUtils (maybeDecompress) import Distribution.Client.Utils   ( byteStringToFilePath-  , tryFindAddSourcePackageDesc+  , tryReadAddSourcePackageDesc   ) import Distribution.Compat.Directory (listDirectory) import Distribution.Compat.Time (getFileAge, getModTime)@@ -150,7 +147,7 @@   , (<.>)   , (</>)   )-import qualified System.FilePath.Posix as FilePath.Posix+import qualified System.FilePath as FilePath import System.IO import System.IO.Error (isDoesNotExistError) import System.IO.Unsafe (unsafeInterleaveIO)@@ -163,11 +160,11 @@ getInstalledPackages   :: Verbosity   -> Compiler-  -> PackageDBStack+  -> PackageDBStackCWD   -> ProgramDb   -> IO InstalledPackageIndex getInstalledPackages verbosity comp packageDbs progdb =-  Configure.getInstalledPackages verbosity' comp packageDbs progdb+  Configure.getInstalledPackages verbosity' comp Nothing (coercePackageDBStack packageDbs) progdb   where     verbosity' = lessVerbose verbosity @@ -460,8 +457,8 @@       if isDoesNotExistError e         then do           case repo of-            RepoRemote{..} -> dieWithException verbosity $ MissingPackageList repoRemote-            RepoSecure{..} -> dieWithException verbosity $ MissingPackageList repoRemote+            RepoRemote{..} -> warn verbosity $ exceptionMessageCabalInstall $ MissingPackageList repoRemote+            RepoSecure{..} -> warn verbosity $ exceptionMessageCabalInstall $ MissingPackageList repoRemote             RepoLocalNoIndex local _ ->               warn verbosity $                 "Error during construction of local+noindex "@@ -638,8 +635,7 @@           if not dirExists             then return Nothing             else do-              cabalFile <- tryFindAddSourcePackageDesc verbosity path "Error reading package index."-              descr <- PackageDesc.Parse.readGenericPackageDescription normal cabalFile+              descr <- tryReadAddSourcePackageDesc verbosity path "Error reading package index."               return . Just $                 BuildTreeRef                   (refTypeFromTypeCode typeCode)@@ -930,7 +926,7 @@           let bs = BS.toStrict contents            in ((`CacheGPD` bs) <$> parseGenericPackageDescriptionMaybe bs)       where-        filename = prettyShow pkgId FilePath.Posix.</> prettyShow (packageName pkgId) ++ ".cabal"+        filename = prettyShow pkgId FilePath.</> prettyShow (packageName pkgId) ++ ".cabal"     readCabalEntry _ _ x = x withIndexEntries verbosity index callback _ = do   -- non-secure repositories@@ -1044,8 +1040,7 @@       path <- fmap byteStringToFilePath . getEntryContent $ blockno       pkg <- do         let err = "Error reading package index from cache."-        file <- tryFindAddSourcePackageDesc verbosity path err-        PackageDesc.Parse.readGenericPackageDescription normal file+        tryReadAddSourcePackageDesc verbosity path err       let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)       accum srcpkgs (srcpkg : btrs) prefs entries     accum srcpkgs btrs prefs (CachePreference pref@(Dependency pn _ _) _ _ : entries) =

@@ -31,7 +31,7 @@ -- | This is the main driver for the init script. initCmd   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Compiler   -> ProgramDb@@ -41,8 +41,7 @@   installedPkgIndex <- getInstalledPackages v comp packageDBs progdb   sourcePkgDb <- getSourcePackages v repoCtxt   hSetBuffering stdout NoBuffering-  settings <- createProject v installedPkgIndex sourcePkgDb initFlags-  writeProject settings+  runPromptIO (writeProject =<< createProject v installedPkgIndex sourcePkgDb initFlags)   where     -- When no flag is set, default to interactive.     --

@@ -135,6 +135,7 @@   , CabalSpecV2_4   , CabalSpecV3_0   , CabalSpecV3_4+  , CabalSpecV3_14   ]  defaultInitFlags :: InitFlags

@@ -180,7 +180,7 @@     , field         "hs-source-dirs"         formatHsSourceDirs-        (unsafeMakeSymbolicPath <$> srcDirs)+        (makeSymbolicPath <$> srcDirs)         ["Directories containing source files."]         True         opts@@ -247,7 +247,7 @@     , field         "hs-source-dirs"         formatHsSourceDirs-        (unsafeMakeSymbolicPath <$> appDirs)+        (makeSymbolicPath <$> appDirs)         ["Directories containing source files."]         True         opts@@ -316,7 +316,7 @@     , field         "hs-source-dirs"         formatHsSourceDirs-        (unsafeMakeSymbolicPath <$> dirs)+        (makeSymbolicPath <$> dirs)         ["Directories containing source files."]         True         opts@@ -473,14 +473,14 @@       Just fs ->         field           "extra-doc-files"-          formatExtraSourceFiles+          (formatExtraSourceFiles . map unsafeMakeSymbolicPath)           (toList fs)           ["Extra doc files to be distributed with the package, such as a CHANGELOG or a README."]           True           opts   , field       "extra-source-files"-      formatExtraSourceFiles+      (formatExtraSourceFiles . map unsafeMakeSymbolicPath)       (toList $ _pkgExtraSrcFiles pkgDesc)       ["Extra source files to be distributed with the package, such as examples, or a tutorial module."]       True

@@ -313,6 +313,7 @@     parseCabalVersion "3.0" = CabalSpecV3_0     parseCabalVersion "3.4" = CabalSpecV3_4     parseCabalVersion "3.12" = CabalSpecV3_12+    parseCabalVersion "3.14" = CabalSpecV3_14     parseCabalVersion _ = defaultCabalVersion -- 2.4     displayCabalVersion :: CabalSpecVersion -> String     displayCabalVersion v = case v of@@ -321,6 +322,7 @@       CabalSpecV2_4 -> "2.4   (+ support for '**' globbing)"       CabalSpecV3_0 -> "3.0   (+ set notation for ==, common stanzas in ifs, more redundant commas, better pkgconfig-depends)"       CabalSpecV3_4 -> "3.4   (+ sublibraries in 'mixins', optional 'default-language')"+      CabalSpecV3_14 -> "3.14  (+ build-type: Hooks)"       _ -> showCabalSpecVersion v  packageNamePrompt :: Interactive m => SourcePackageDb -> InitFlags -> m PackageName@@ -458,13 +460,17 @@       ghc2021 = "GHC2021 (requires at least GHC 9.2)"       ghc2024 = "GHC2024 (requires at least GHC 9.10)" +  lastChosenLanguage <- getLastChosenLanguage+   l <-     promptList       ("Choose a language for your " ++ pkgType)       [h2010, h98, ghc2021, ghc2024]-      (DefaultPrompt h2010)+      (DefaultPrompt (maybe h2010 id lastChosenLanguage))       Nothing       True++  setLastChosenLanguage (Just l)    if       | l == h2010 -> return Haskell2010

@@ -165,14 +165,14 @@  guessGitInfo :: Interactive m => String -> m (Maybe String) guessGitInfo target = do-  localInfo <- readProcessWithExitCode "git" ["config", "--local", target] ""-  if null $ snd' localInfo-    then do-      globalInfo <- readProcessWithExitCode "git" ["config", "--global", target] ""-      case fst' globalInfo of-        ExitSuccess -> return $ Just (trim $ snd' globalInfo)-        _ -> return Nothing-    else return $ Just (trim $ snd' localInfo)-  where-    fst' (x, _, _) = x-    snd' (_, x, _) = x+  localInfo <- maybeReadProcessWithExitCode "git" ["config", "--local", target] ""+  case localInfo of+    Nothing -> return Nothing+    Just (_, localStdout, _) ->+      if null localStdout+        then do+          globalInfo <- maybeReadProcessWithExitCode "git" ["config", "--global", target] ""+          case globalInfo of+            Just (ExitSuccess, globalStdout, _) -> return $ Just (trim globalStdout)+            _ -> return Nothing+        else return $ Just (trim localStdout)

@@ -1,7 +1,9 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}  -- | -- Module      :  Distribution.Client.Init.Types@@ -39,7 +41,11 @@     -- * Typeclasses   , Interactive (..)   , BreakException (..)-  , PurePrompt (..)+  , PromptIO+  , runPromptIO+  , Inputs+  , PurePrompt+  , runPrompt   , evalPrompt   , Severity (..) @@ -63,9 +69,12 @@ import Prelude (read)  import Control.Monad.Catch+import Control.Monad.IO.Class+import Control.Monad.Reader  import Data.List.NonEmpty (fromList) +import qualified Data.IORef import Distribution.CabalSpecVersion import Distribution.Client.Utils as P import Distribution.Fields.Pretty@@ -282,15 +291,33 @@ -- -------------------------------------------------------------------- -- -- Interactive prompt monad +newtype PromptIO a = PromptIO (ReaderT (Data.IORef.IORef SessionState) IO a)+  deriving (Functor, Applicative, Monad, MonadIO)++sessionState :: PromptIO (Data.IORef.IORef SessionState)+sessionState = PromptIO ask++runPromptIO :: PromptIO a -> IO a+runPromptIO (PromptIO pio) =+  (Data.IORef.newIORef newSessionState) >>= (runReaderT pio)++type Inputs = NonEmpty String+ newtype PurePrompt a = PurePrompt-  { _runPrompt-      :: NonEmpty String-      -> Either BreakException (a, NonEmpty String)+  { runPromptState+      :: (Inputs, SessionState)+      -> Either BreakException (a, (Inputs, SessionState))   }   deriving (Functor) -evalPrompt :: PurePrompt a -> NonEmpty String -> a-evalPrompt act s = case _runPrompt act s of+runPrompt :: PurePrompt a -> Inputs -> Either BreakException (a, Inputs)+runPrompt act args =+  fmap+    (\(a, (s, _)) -> (a, s))+    (runPromptState act (args, newSessionState))++evalPrompt :: PurePrompt a -> Inputs -> a+evalPrompt act s = case runPrompt act s of   Left e -> error $ show e   Right (a, _) -> a @@ -306,7 +333,7 @@   return = pure   PurePrompt a >>= k = PurePrompt $ \s -> case a s of     Left e -> Left e-    Right (a', s') -> _runPrompt (k a') s'+    Right (a', s') -> runPromptState (k a') s'  class Monad m => Interactive m where   -- input functions@@ -320,6 +347,7 @@   doesFileExist :: FilePath -> m Bool   canonicalizePathNoThrow :: FilePath -> m FilePath   readProcessWithExitCode :: FilePath -> [String] -> String -> m (ExitCode, String, String)+  maybeReadProcessWithExitCode :: FilePath -> [String] -> String -> m (Maybe (ExitCode, String, String))   getEnvironment :: m [(String, String)]   getCurrentYear :: m Integer   listFilesInside :: (FilePath -> m Bool) -> FilePath -> m [FilePath]@@ -341,37 +369,63 @@   break :: m Bool   throwPrompt :: BreakException -> m a -instance Interactive IO where-  getLine = P.getLine-  readFile = P.readFile-  getCurrentDirectory = P.getCurrentDirectory-  getHomeDirectory = P.getHomeDirectory-  getDirectoryContents = P.getDirectoryContents-  listDirectory = P.listDirectory-  doesDirectoryExist = P.doesDirectoryExist-  doesFileExist = P.doesFileExist-  canonicalizePathNoThrow = P.canonicalizePathNoThrow-  readProcessWithExitCode = Process.readProcessWithExitCode-  getEnvironment = P.getEnvironment-  getCurrentYear = P.getCurrentYear-  listFilesInside = P.listFilesInside-  listFilesRecursive = P.listFilesRecursive+  -- session state functions+  getLastChosenLanguage :: m (Maybe String)+  setLastChosenLanguage :: (Maybe String) -> m () -  putStr = P.putStr-  putStrLn = P.putStrLn-  createDirectory = P.createDirectory-  removeDirectory = P.removeDirectoryRecursive-  writeFile = P.writeFile-  removeExistingFile = P.removeExistingFile-  copyFile = P.copyFile-  renameDirectory = P.renameDirectory-  hFlush = System.IO.hFlush+newtype SessionState = SessionState+  { lastChosenLanguage :: (Maybe String)+  }++newSessionState :: SessionState+newSessionState = SessionState{lastChosenLanguage = Nothing}++instance Interactive PromptIO where+  getLine = liftIO P.getLine+  readFile = liftIO <$> P.readFile+  getCurrentDirectory = liftIO P.getCurrentDirectory+  getHomeDirectory = liftIO P.getHomeDirectory+  getDirectoryContents = liftIO <$> P.getDirectoryContents+  listDirectory = liftIO <$> P.listDirectory+  doesDirectoryExist = liftIO <$> P.doesDirectoryExist+  doesFileExist = liftIO <$> P.doesFileExist+  canonicalizePathNoThrow = liftIO <$> P.canonicalizePathNoThrow+  readProcessWithExitCode a b c = liftIO $ Process.readProcessWithExitCode a b c+  maybeReadProcessWithExitCode a b c = liftIO $ (Just <$> Process.readProcessWithExitCode a b c) `P.catch` const @_ @IOError (pure Nothing)+  getEnvironment = liftIO P.getEnvironment+  getCurrentYear = liftIO P.getCurrentYear+  listFilesInside test dir = do+    -- test is run within a new env and not the current env+    -- all usages of listFilesInside are pure functions actually+    liftIO $ P.listFilesInside (\f -> liftIO $ runPromptIO (test f)) dir+  listFilesRecursive = liftIO <$> P.listFilesRecursive++  putStr = liftIO <$> P.putStr+  putStrLn = liftIO <$> P.putStrLn+  createDirectory = liftIO <$> P.createDirectory+  removeDirectory = liftIO <$> P.removeDirectoryRecursive+  writeFile a b = liftIO $ P.writeFile a b+  removeExistingFile = liftIO <$> P.removeExistingFile+  copyFile a b = liftIO $ P.copyFile a b+  renameDirectory a b = liftIO $ P.renameDirectory a b+  hFlush = liftIO <$> System.IO.hFlush   message q severity msg     | q == silent = pure ()     | otherwise = putStrLn $ "[" ++ displaySeverity severity ++ "] " ++ msg   break = return False-  throwPrompt = throwM+  throwPrompt = liftIO <$> throwM +  getLastChosenLanguage = do+    stateRef <- sessionState+    liftIO $ lastChosenLanguage <$> Data.IORef.readIORef stateRef++  setLastChosenLanguage value = do+    stateRef <- sessionState+    liftIO $+      Data.IORef.modifyIORef+        stateRef+        (\state -> state{lastChosenLanguage = value})+ instance Interactive PurePrompt where   getLine = pop   readFile !_ = pop@@ -387,6 +441,7 @@   readProcessWithExitCode !_ !_ !_ = do     input <- pop     return (ExitSuccess, input, "")+  maybeReadProcessWithExitCode a b c = Just <$> readProcessWithExitCode a b c   getEnvironment = fmap (map read) popList   getCurrentYear = fmap read pop   listFilesInside pred' !_ = do@@ -411,13 +466,18 @@     _ -> return ()    break = return True-  throwPrompt (BreakException e) = PurePrompt $ \s ->+  throwPrompt (BreakException e) = PurePrompt $ \(i, _) ->     Left $       BreakException-        ("Error: " ++ e ++ "\nStacktrace: " ++ show s)+        ("Error: " ++ e ++ "\nStacktrace: " ++ show i) +  getLastChosenLanguage = PurePrompt $ \(i, s) ->+    Right (lastChosenLanguage s, (i, s))+  setLastChosenLanguage l = PurePrompt $ \(i, s) ->+    Right ((), (i, s{lastChosenLanguage = l}))+ pop :: PurePrompt String-pop = PurePrompt $ \(p :| ps) -> Right (p, fromList ps)+pop = PurePrompt $ \(i :| is, s) -> Right (i, (fromList is, s))  popAbsolute :: PurePrompt String popAbsolute = do@@ -429,7 +489,7 @@   pop >>= \case     "True" -> pure True     "False" -> pure False-    s -> throwPrompt $ BreakException $ "popBool: " ++ s+    i -> throwPrompt $ BreakException $ "popBool: " ++ i  popList :: PurePrompt [String] popList =

@@ -128,7 +128,7 @@               Nothing -> return Nothing               Just moduleName -> do                 let fileExtension = takeExtension f-                relativeSourcePath <- makeRelative f <$> getCurrentDirectory+                relativeSourcePath <- makeRelative (normalise f) <$> getCurrentDirectory                 imports <- retrieveModuleImports f                 extensions <- retrieveModuleExtensions f 

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}  ----------------------------------------------------------------------------- @@ -56,7 +57,6 @@   ( equalFilePath   , takeDirectory   , (<.>)-  , (</>)   ) import System.IO   ( IOMode (AppendMode)@@ -111,6 +111,7 @@   , InstallFlags (..)   , RepoContext (..)   , configureCommand+  , filterCommonFlags   , filterConfigureFlags   , filterTestFlags   )@@ -172,8 +173,9 @@   ( Compiler (compilerId)   , CompilerId (..)   , CompilerInfo (..)-  , PackageDB (..)-  , PackageDBStack+  , PackageDBCWD+  , PackageDBStackCWD+  , PackageDBX (..)   , compilerFlavor   , compilerInfo   )@@ -193,30 +195,35 @@ import Distribution.Simple.Program (ProgramDb) import Distribution.Simple.Register (defaultRegisterOptions, registerPackage) import Distribution.Simple.Setup-  ( BenchmarkFlags+  ( BenchmarkFlags (..)   , BuildFlags (..)+  , CommonSetupFlags (..)+  , CopyFlags (..)   , HaddockFlags (..)-  , TestFlags+  , RegisterFlags (..)+  , TestFlags (..)   , buildCommand+  , copyCommonFlags+  , defaultCommonSetupFlags   , defaultDistPref   , emptyBuildFlags   , flagToMaybe   , fromFlag   , fromFlagOrDefault   , haddockCommand+  , maybeToFlag+  , registerCommonFlags+  , setupDistPref+  , setupVerbosity+  , setupWorkingDir+  , testCommonFlags   , toFlag   ) import qualified Distribution.Simple.Setup as Cabal-  ( CopyFlags (..)-  , Flag (..)-  , RegisterFlags (..)-  , TestFlags (..)-  , copyCommand-  , emptyCopyFlags-  , emptyRegisterFlags-  , registerCommand-  , testCommand+import Distribution.Utils.Path hiding+  ( (<.>)   )+ import Distribution.Simple.Utils   ( VerboseException   , createDirectoryIfMissingVerbose@@ -293,7 +300,7 @@ -- | Installs the packages needed to satisfy a list of dependencies. install   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Compiler   -> Platform@@ -373,7 +380,7 @@ type InstallContext =   ( InstalledPackageIndex   , SourcePackageDb-  , PkgConfigDb+  , Maybe PkgConfigDb   , [UserTarget]   , [PackageSpecifier UnresolvedSourcePackage]   , HttpTransport@@ -384,7 +391,7 @@  -- | Initial arguments given to 'install' or 'makeInstallContext'. type InstallArgs =-  ( PackageDBStack+  ( PackageDBStackCWD   , RepoContext   , Compiler   , Platform@@ -559,7 +566,7 @@   -> InstallFlags   -> InstalledPackageIndex   -> SourcePackageDb-  -> PkgConfigDb+  -> Maybe PkgConfigDb   -> [PackageSpecifier UnresolvedSourcePackage]   -> Progress String String SolverInstallPlan planPackages@@ -1217,7 +1224,7 @@  regenerateHaddockIndex   :: Verbosity-  -> [PackageDB]+  -> [PackageDBCWD]   -> Compiler   -> Platform   -> ProgramDb@@ -1482,7 +1489,7 @@       distPref =         fromFlagOrDefault           (useDistPref defaultSetupScriptOptions)-          (configDistPref configFlags)+          (setupDistPref $ configCommonFlags configFlags)        setupScriptOptions index lock rpkg =         configureSetupScript@@ -1698,7 +1705,7 @@   :: Verbosity   -> PackageIdentifier   -> ResolvedPkgLoc-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -> (Maybe FilePath -> IO BuildOutcome)   -> IO BuildOutcome installLocalPackage verbosity pkgid location distPref installPkg =@@ -1733,7 +1740,7 @@   :: Verbosity   -> PackageIdentifier   -> FilePath-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -> (Maybe FilePath -> IO BuildOutcome)   -> IO BuildOutcome installLocalTarballPackage@@ -1774,9 +1781,9 @@       -- fails even with this workaround. We probably can live with that.       maybeRenameDistDir :: FilePath -> IO ()       maybeRenameDistDir absUnpackedPath = do-        let distDirPath = absUnpackedPath </> defaultDistPref-            distDirPathTmp = absUnpackedPath </> (defaultDistPref ++ "-tmp")-            distDirPathNew = absUnpackedPath </> distPref+        let distDirPath = absUnpackedPath </> getSymbolicPath defaultDistPref+            distDirPathTmp = absUnpackedPath </> (getSymbolicPath defaultDistPref ++ "-tmp")+            distDirPathNew = absUnpackedPath </> getSymbolicPath distPref         distDirExists <- doesDirectoryExist distDirPath         when           ( distDirExists@@ -1854,6 +1861,15 @@             ++ " with the latest revision from the index."         writeFileAtomic descFilePath pkgtxt +    let mbWorkDir = fmap makeSymbolicPath workingDir+        commonFlags ver =+          (`filterCommonFlags` ver) $+            defaultCommonSetupFlags+              { setupDistPref = setupDistPref $ configCommonFlags configFlags+              , setupVerbosity = toFlag verbosity'+              , setupWorkingDir = maybeToFlag mbWorkDir+              }+     -- Make sure that we pass --libsubdir etc to 'setup configure' (necessary if     -- the setup script was compiled against an old version of the Cabal lib).     configFlags' <- addDefaultInstallDirs configFlags@@ -1862,9 +1878,34 @@         configureFlags =           filterConfigureFlags             configFlags'-              { configVerbosity = toFlag verbosity'+              { configCommonFlags =+                  (configCommonFlags (configFlags'))+                    { setupVerbosity = toFlag verbosity'+                    }               } +        buildFlags vers =+          emptyBuildFlags{buildCommonFlags = commonFlags vers}+        shouldHaddock = fromFlag (installDocumentation installFlags)+        haddockFlags' vers =+          haddockFlags{haddockCommonFlags = commonFlags vers}+        testsEnabled =+          fromFlag (configTests configFlags)+            && fromFlagOrDefault False (installRunTests installFlags)+        testFlags' vers =+          (`filterTestFlags` vers) $+            testFlags{testCommonFlags = commonFlags vers}+        copyFlags vers =+          Cabal.emptyCopyFlags+            { Cabal.copyDest = toFlag InstallDirs.NoCopyDest+            , copyCommonFlags = commonFlags vers+            }+        shouldRegister = PackageDescription.hasLibs pkg+        registerFlags vers =+          Cabal.emptyRegisterFlags+            { registerCommonFlags = commonFlags vers+            }+     -- Path to the optional log file.     mLogPath <- maybeLogPath @@ -1872,19 +1913,19 @@       -- Configure phase       onFailure ConfigureFailed $ do         noticeProgress ProgressStarting-        setup configureCommand configureFlags mLogPath+        setup configureCommand configCommonFlags (return . configureFlags) mLogPath          -- Build phase         onFailure BuildFailed $ do           noticeProgress ProgressBuilding-          setup buildCommand' buildFlags mLogPath+          setup buildCommand' buildCommonFlags (return . buildFlags) mLogPath            -- Doc generation phase           docsResult <-             if shouldHaddock               then                 ( do-                    setup haddockCommand haddockFlags' mLogPath+                    setup haddockCommand haddockCommonFlags (return . haddockFlags') mLogPath                     return DocsOk                 )                   `catchIO` (\_ -> return DocsFailed)@@ -1894,7 +1935,7 @@           -- Tests phase           onFailure TestsFailed $ do             when (testsEnabled && PackageDescription.hasTests pkg) $-              setup Cabal.testCommand testFlags' mLogPath+              setup Cabal.testCommand testCommonFlags (return . testFlags') mLogPath              let testsResult                   | testsEnabled = TestsOk@@ -1911,11 +1952,14 @@                 platform                 pkg                 $ do-                  setup Cabal.copyCommand copyFlags mLogPath+                  setup Cabal.copyCommand copyCommonFlags (return . copyFlags) mLogPath                -- Capture installed package configuration file, so that               -- it can be incorporated into the final InstallPlan-              ipkgs <- genPkgConfs mLogPath+              ipkgs <-+                if shouldRegister+                  then genPkgConfs registerFlags mLogPath+                  else return []               let ipkgs' = case ipkgs of                     [ipkg] -> [ipkg{Installed.installedUnitId = uid}]                     _ -> ipkgs@@ -1928,6 +1972,7 @@                   verbosity                   comp                   progdb+                  mbWorkDir                   packageDBs                   ipkg'                   defaultRegisterOptions@@ -1944,38 +1989,6 @@       noticeProgress phase =         when isParallelBuild $           progressMessage verbosity phase dispname--      buildFlags _ =-        emptyBuildFlags-          { buildDistPref = configDistPref configFlags-          , buildVerbosity = toFlag verbosity'-          }-      shouldHaddock = fromFlag (installDocumentation installFlags)-      haddockFlags' _ =-        haddockFlags-          { haddockVerbosity = toFlag verbosity'-          , haddockDistPref = configDistPref configFlags-          }-      testsEnabled =-        fromFlag (configTests configFlags)-          && fromFlagOrDefault False (installRunTests installFlags)-      testFlags' =-        filterTestFlags-          testFlags-            { Cabal.testDistPref = configDistPref configFlags-            }-      copyFlags _ =-        Cabal.emptyCopyFlags-          { Cabal.copyDistPref = configDistPref configFlags-          , Cabal.copyDest = toFlag InstallDirs.NoCopyDest-          , Cabal.copyVerbosity = toFlag verbosity'-          }-      shouldRegister = PackageDescription.hasLibs pkg-      registerFlags _ =-        Cabal.emptyRegisterFlags-          { Cabal.regDistPref = configDistPref configFlags-          , Cabal.regVerbosity = toFlag verbosity'-          }       verbosity' = maybe verbosity snd useLogFile       tempTemplate name = name ++ "-" ++ prettyShow pkgid @@ -2001,30 +2014,32 @@               (configUserInstall configFlags')        genPkgConfs-        :: Maybe FilePath+        :: (Version -> Cabal.RegisterFlags)+        -> Maybe FilePath         -> IO [Installed.InstalledPackageInfo]-      genPkgConfs mLogPath =-        if shouldRegister-          then do-            tmp <- getTemporaryDirectory-            withTempDirectory verbosity tmp (tempTemplate "pkgConf") $ \dir -> do-              let pkgConfDest = dir </> "pkgConf"-                  registerFlags' version =-                    (registerFlags version)-                      { Cabal.regGenPkgConf = toFlag (Just pkgConfDest)-                      }-              setup Cabal.registerCommand registerFlags' mLogPath-              is_dir <- doesDirectoryExist pkgConfDest-              let notHidden = not . isHidden-                  isHidden name = "." `isPrefixOf` name-              if is_dir-                then -- Sort so that each prefix of the package-                -- configurations is well formed+      genPkgConfs flags mLogPath = do+        tmp <- getTemporaryDirectory+        withTempDirectory verbosity tmp (tempTemplate "pkgConf") $ \dir -> do+          let pkgConfDest = makeSymbolicPath dir </> makeRelativePathEx "pkgConf"+              registerFlags' version =+                (flags version)+                  { Cabal.regGenPkgConf = toFlag (Just pkgConfDest)+                  }+          setup+            Cabal.registerCommand+            registerCommonFlags+            (return . registerFlags')+            mLogPath+          is_dir <- doesDirectoryExist (interpretSymbolicPathCWD pkgConfDest)+          let notHidden = not . isHidden+              isHidden name = "." `isPrefixOf` name+          if is_dir+            then -- Sort so that each prefix of the package+            -- configurations is well formed -                  traverse (readPkgConf pkgConfDest) . sort . filter notHidden-                    =<< getDirectoryContents pkgConfDest-                else fmap (: []) $ readPkgConf "." pkgConfDest-          else return []+              traverse (readPkgConf (getSymbolicPath pkgConfDest)) . sort . filter notHidden+                =<< getDirectoryContents (getSymbolicPath pkgConfDest)+            else fmap (: []) $ readPkgConf "." (getSymbolicPath pkgConfDest)        readPkgConf         :: FilePath@@ -2056,7 +2071,7 @@             when logFileExists $ removeFile logFileName             return (Just logFileName) -      setup cmd flags mLogPath =+      setup cmd getCommonFlags flags mLogPath =         Exception.bracket           (traverse (\path -> openFile path AppendMode) mLogPath)           (traverse_ hClose)@@ -2065,10 +2080,11 @@                 verbosity                 scriptOptions                   { useLoggingHandle = logFileHandle-                  , useWorkingDir = workingDir+                  , useWorkingDir = makeSymbolicPath <$> workingDir                   }                 (Just pkg)                 cmd+                getCommonFlags                 flags                 (const [])           )

@@ -84,6 +84,7 @@ import System.FilePath   ( isAbsolute   , joinPath+  , normalise   , splitPath   , (</>)   )@@ -98,7 +99,7 @@  import Distribution.Client.Compat.Directory (createFileLink, getSymbolicLinkTarget, pathIsSymbolicLink) import Distribution.Client.Init.Prompt (promptYesNo)-import Distribution.Client.Init.Types (DefaultPrompt (MandatoryPrompt))+import Distribution.Client.Init.Types (DefaultPrompt (MandatoryPrompt), runPromptIO) import Distribution.Client.Types.OverwritePolicy  import qualified Data.ByteString as BS@@ -316,7 +317,7 @@ symlinkBinary inputs@Symlink{publicBindir, privateBindir, publicName, privateName} = do   onSymlinkBinary mkLink overwrite (return False) maybeOverwrite inputs   where-    relativeBindir = makeRelative publicBindir privateBindir+    relativeBindir = makeRelative (normalise publicBindir) privateBindir      mkLink :: IO Bool     mkLink = True <$ createFileLink (relativeBindir </> privateName) (publicBindir </> publicName)@@ -335,7 +336,7 @@  promptRun :: String -> IO Bool -> IO Bool promptRun s m = do-  a <- promptYesNo s MandatoryPrompt+  a <- runPromptIO $ promptYesNo s MandatoryPrompt   if a then m else pure a  -- | Check a file path of a symlink that we would like to create to see if it

@@ -43,9 +43,6 @@ import Distribution.Types.UnqualComponentName  import Distribution.Simple.Compiler-  ( Compiler-  , PackageDBStack-  ) import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex import Distribution.Simple.Program (ProgramDb)@@ -141,7 +138,7 @@ -- | Return a list of packages matching given search strings. getPkgList   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Maybe (Compiler, ProgramDb)   -> ListFlags@@ -213,7 +210,7 @@ -- | Show information about packages. list   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Maybe (Compiler, ProgramDb)   -> ListFlags@@ -249,7 +246,7 @@  info   :: Verbosity-  -> PackageDBStack+  -> PackageDBStackCWD   -> RepoContext   -> Compiler   -> ProgramDb

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -24,6 +25,7 @@   ( ActAsSetupFlags (..)   , BuildFlags (..)   , CheckFlags (..)+  , CommonSetupFlags (..)   , ConfigExFlags (..)   , ConfigFlags (..)   , FetchFlags (..)@@ -49,6 +51,7 @@   , defaultConfigExFlags   , defaultInstallFlags   , fetchCommand+  , filterCommonFlags   , formatCommand   , freezeCommand   , genBoundsCommand@@ -83,7 +86,6 @@   , RegisterFlags (..)   , ReplFlags (..)   , TestFlags (..)-  , configAbsolutePaths   , defaultHaddockFlags   , flagToMaybe   , fromFlag@@ -181,6 +183,8 @@   , buildable   ) +import Distribution.Client.Errors+import Distribution.Compat.ResponseFile import qualified Distribution.Make as Make import Distribution.PackageDescription.PrettyPrint   ( writeGenericPackageDescription@@ -202,7 +206,7 @@   , defaultCommandFallback   , hiddenCommand   )-import Distribution.Simple.Compiler (PackageDBStack)+import Distribution.Simple.Compiler (PackageDBStack, interpretPackageDBStack) import Distribution.Simple.Configure   ( ConfigStateFileError (..)   , configCompilerAuxEx@@ -237,6 +241,10 @@   ( display   ) import qualified Distribution.Types.UnqualComponentName as Make+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  ) import Distribution.Verbosity as Verbosity   ( normal   )@@ -248,11 +256,8 @@  import Control.Exception (AssertionFailed, assert, try) import Data.Monoid (Any (..))-import Distribution.Client.Errors-import Distribution.Compat.ResponseFile import System.Directory   ( doesFileExist-  , getCurrentDirectory   , withCurrentDirectory   ) import System.Environment (getEnvironment, getExecutablePath, getProgName)@@ -427,7 +432,7 @@       , regularCmd CmdPath.pathCommand CmdPath.pathAction       , regularCmd genBoundsCommand genBoundsAction       , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction-      , wrapperCmd hscolourCommand hscolourVerbosity hscolourDistPref+      , wrapperCmd hscolourCommand hscolourCommonFlags       , hiddenCmd formatCommand formatAction       , hiddenCmd actAsSetupCommand actAsSetupAction       , hiddenCmd manpageCommand (manpageAction commandSpecs)@@ -460,8 +465,8 @@           , legacyCmd testCommand testAction           , legacyCmd benchmarkCommand benchmarkAction           , legacyCmd cleanCommand cleanAction-          , legacyWrapperCmd copyCommand copyVerbosity copyDistPref-          , legacyWrapperCmd registerCommand regVerbosity regDistPref+          , legacyWrapperCmd copyCommand copyCommonFlags+          , legacyWrapperCmd registerCommand registerCommonFlags           , legacyCmd reconfigureCommand reconfigureAction           ] @@ -489,35 +494,40 @@ wrapperCmd   :: Monoid flags   => CommandUI flags-  -> (flags -> Flag Verbosity)-  -> (flags -> Flag String)+  -> (flags -> CommonSetupFlags)   -> CommandSpec Action-wrapperCmd ui verbosity distPref =-  CommandSpec ui (\ui' -> wrapperAction ui' verbosity distPref) NormalCommand+wrapperCmd ui getCommonFlags =+  CommandSpec ui (\ui' -> wrapperAction ui' getCommonFlags) NormalCommand  wrapperAction   :: Monoid flags   => CommandUI flags-  -> (flags -> Flag Verbosity)-  -> (flags -> Flag String)+  -> (flags -> CommonSetupFlags)   -> Command Action-wrapperAction command verbosityFlag distPrefFlag =+wrapperAction command getCommonFlags =   commandAddAction     command       { commandDefaultFlags = mempty       }     $ \flags extraArgs globalFlags -> do-      let verbosity = fromFlagOrDefault normal (verbosityFlag flags)+      let common = getCommonFlags flags+          verbosity = fromFlagOrDefault normal $ setupVerbosity common+          mbWorkDir = flagToMaybe $ setupWorkingDir common       load <- try (loadConfigOrSandboxConfig verbosity globalFlags)       let config = either (\(SomeException _) -> mempty) id load-      distPref <- findSavedDistPref config (distPrefFlag flags)-      let setupScriptOptions = defaultSetupScriptOptions{useDistPref = distPref}+      distPref <- findSavedDistPref config (setupDistPref common)+      let setupScriptOptions =+            defaultSetupScriptOptions+              { useDistPref = distPref+              , useWorkingDir = mbWorkDir+              }       setupWrapper         verbosity         setupScriptOptions         Nothing         command-        (const flags)+        getCommonFlags+        (const (return flags))         (const extraArgs)  configureAction@@ -525,11 +535,12 @@   -> [String]   -> Action configureAction (configFlags, configExFlags) extraArgs globalFlags = do-  let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+  let common = configCommonFlags configFlags+      verbosity = fromFlagOrDefault normal $ setupVerbosity common   config <-     updateInstallDirs (configUserInstall configFlags)       <$> loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (configDistPref configFlags)+  distPref <- getSymbolicPath <$> findSavedDistPref config (setupDistPref common)   nixInstantiate verbosity distPref True globalFlags config   nixShell verbosity distPref globalFlags config $ do     let configFlags' = savedConfigureFlags config `mappend` configFlags@@ -549,7 +560,7 @@     withRepoContext verbosity globalFlags' $ \repoContext ->       configure         verbosity-        packageDBs+        (interpretPackageDBStack Nothing packageDBs)         repoContext         comp         platform@@ -563,11 +574,12 @@   -> [String]   -> Action reconfigureAction flags@(configFlags, _) _ globalFlags = do-  let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+  let common = configCommonFlags configFlags+      verbosity = fromFlagOrDefault normal (setupVerbosity common)   config <-     updateInstallDirs (configUserInstall configFlags)       <$> loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (configDistPref configFlags)+  distPref <- findSavedDistPref config (setupDistPref common)   let checkFlags = Check $ \_ saved -> do         let flags' = saved <> flags         unless (saved == flags') $ info verbosity message@@ -579,7 +591,7 @@           message =             "flags changed: "               ++ unwords (commandShowOptions configureExCommand flags)-  nixInstantiate verbosity distPref True globalFlags config+  nixInstantiate verbosity (getSymbolicPath distPref) True globalFlags config   _ <-     reconfigure       configureAction@@ -594,9 +606,10 @@  buildAction :: BuildFlags -> [String] -> Action buildAction buildFlags extraArgs globalFlags = do-  let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)+  let common = buildCommonFlags buildFlags+      verbosity = fromFlagOrDefault normal $ setupVerbosity common   config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (buildDistPref buildFlags)+  distPref <- findSavedDistPref config (setupDistPref common)   -- Calls 'configureAction' to do the real work, so nothing special has to be   -- done to support sandboxes.   config' <-@@ -609,36 +622,49 @@       []       globalFlags       config-  nixShell verbosity distPref globalFlags config $ do+  nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do     build verbosity config' distPref buildFlags extraArgs  -- | Actually do the work of building the package. This is separate from -- 'buildAction' so that 'testAction' and 'benchmarkAction' do not invoke -- 'reconfigure' twice.-build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO ()+build :: Verbosity -> SavedConfig -> SymbolicPath Pkg (Dir Dist) -> BuildFlags -> [String] -> IO () build verbosity config distPref buildFlags extraArgs =   setupWrapper     verbosity     setupOptions     Nothing     (Cabal.buildCommand progDb)-    mkBuildFlags+    buildCommonFlags+    (return . mkBuildFlags)     (const extraArgs)   where     progDb = defaultProgramDb     setupOptions = defaultSetupScriptOptions{useDistPref = distPref}      mkBuildFlags version = filterBuildFlags version config buildFlags'+    commonFlags = buildCommonFlags buildFlags     buildFlags' =       buildFlags-        { buildVerbosity = toFlag verbosity-        , buildDistPref = toFlag distPref+        { buildCommonFlags =+            commonFlags+              { setupVerbosity = toFlag verbosity+              , setupDistPref = toFlag distPref+              }         }  -- | Make sure that we don't pass new flags to setup scripts compiled against -- old versions of Cabal. filterBuildFlags :: Version -> SavedConfig -> BuildFlags -> BuildFlags-filterBuildFlags version config buildFlags+filterBuildFlags version config buildFlags =+  let flags' = filterBuildFlags' version config buildFlags+   in flags'+        { buildCommonFlags =+            filterCommonFlags (buildCommonFlags flags') version+        }++filterBuildFlags' :: Version -> SavedConfig -> BuildFlags -> BuildFlags+filterBuildFlags' version config buildFlags   | version >= mkVersion [1, 19, 1] = buildFlags_latest   -- Cabal < 1.19.1 doesn't support 'build -j'.   | otherwise = buildFlags_pre_1_19_1@@ -659,11 +685,11 @@  replAction :: ReplFlags -> [String] -> Action replAction replFlags extraArgs globalFlags = do-  let verbosity = fromFlagOrDefault normal (replVerbosity replFlags)+  let common = replCommonFlags replFlags+      verbosity = fromFlagOrDefault normal $ setupVerbosity common   config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (replDistPref replFlags)-  cwd <- getCurrentDirectory-  pkgDesc <- findPackageDesc cwd+  distPref <- findSavedDistPref config (setupDistPref common)+  pkgDesc <- findPackageDesc Nothing   let     -- There is a .cabal file in the current directory: start a REPL and load     -- the project's modules.@@ -686,14 +712,25 @@               { useCabalVersion = orLaterVersion $ mkVersion [1, 18, 0]               , useDistPref = distPref               }+          commonFlags = replCommonFlags replFlags           replFlags' =             replFlags-              { replVerbosity = toFlag verbosity-              , replDistPref = toFlag distPref+              { replCommonFlags =+                  commonFlags+                    { setupVerbosity = toFlag verbosity+                    , setupDistPref = toFlag distPref+                    }               } -      nixShell verbosity distPref globalFlags config $-        setupWrapper verbosity setupOptions Nothing (Cabal.replCommand progDb) (const replFlags') (const extraArgs)+      nixShell verbosity (getSymbolicPath distPref) globalFlags config $+        setupWrapper+          verbosity+          setupOptions+          Nothing+          (Cabal.replCommand progDb)+          Cabal.replCommonFlags+          (const (return replFlags'))+          (const extraArgs)      -- No .cabal file in the current directory: just start the REPL (possibly     -- using the sandbox package DB).@@ -706,7 +743,7 @@           (replProgramPaths replFlags)           (replProgramArgs replFlags)           programDb-      nixShell verbosity distPref globalFlags config $ do+      nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do         startInterpreter           verbosity           programDb'@@ -728,16 +765,18 @@   -> Action installAction (configFlags, _, installFlags, _, _, _) _ globalFlags   | fromFlagOrDefault False (installOnly installFlags) = do-      let verb = fromFlagOrDefault normal (configVerbosity configFlags)+      let common = configCommonFlags configFlags+          verb = fromFlagOrDefault normal (setupVerbosity common)       config <- loadConfigOrSandboxConfig verb globalFlags-      dist <- findSavedDistPref config (configDistPref configFlags)+      dist <- findSavedDistPref config (setupDistPref common)       let setupOpts = defaultSetupScriptOptions{useDistPref = dist}       setupWrapper         verb         setupOpts         Nothing         installCommand-        (const (mempty, mempty, mempty, mempty, mempty, mempty))+        (const common)+        (const (return (mempty, mempty, mempty, mempty, mempty, mempty)))         (const []) installAction   ( configFlags@@ -749,12 +788,13 @@     )   extraArgs   globalFlags = do-    let verb = fromFlagOrDefault normal (configVerbosity configFlags)+    let common = configCommonFlags configFlags+        verb = fromFlagOrDefault normal $ setupVerbosity common     config <-       updateInstallDirs (configUserInstall configFlags)         <$> loadConfigOrSandboxConfig verb globalFlags -    dist <- findSavedDistPref config (configDistPref configFlags)+    dist <- findSavedDistPref config $ setupDistPref common      do       targets <- readUserTargets verb extraArgs@@ -762,7 +802,12 @@       let configFlags' =             maybeForceTests installFlags' $               savedConfigureFlags config-                `mappend` configFlags{configDistPref = toFlag dist}+                `mappend` configFlags+                  { configCommonFlags =+                      (configCommonFlags configFlags)+                        { setupDistPref = toFlag dist+                        }+                  }           configExFlags' =             defaultConfigExFlags               `mappend` savedConfigureExFlags config@@ -774,15 +819,30 @@           haddockFlags' =             defaultHaddockFlags               `mappend` savedHaddockFlags config-              `mappend` haddockFlags{haddockDistPref = toFlag dist}+              `mappend` haddockFlags+                { haddockCommonFlags =+                    (haddockCommonFlags haddockFlags)+                      { setupDistPref = toFlag dist+                      }+                }           testFlags' =             Cabal.defaultTestFlags               `mappend` savedTestFlags config-              `mappend` testFlags{testDistPref = toFlag dist}+              `mappend` testFlags+                { testCommonFlags =+                    (testCommonFlags testFlags)+                      { setupDistPref = toFlag dist+                      }+                }           benchmarkFlags' =             Cabal.defaultBenchmarkFlags               `mappend` savedBenchmarkFlags config-              `mappend` benchmarkFlags{benchmarkDistPref = toFlag dist}+              `mappend` benchmarkFlags+                { benchmarkCommonFlags =+                    (benchmarkCommonFlags benchmarkFlags)+                      { setupDistPref = toFlag dist+                      }+                }           globalFlags' = savedGlobalFlags config `mappend` globalFlags       (comp, platform, progdb) <- configCompilerAux' configFlags' @@ -790,18 +850,16 @@       -- future.       progdb' <- configureAllKnownPrograms verb progdb -      configFlags'' <- configAbsolutePaths configFlags'-       withRepoContext verb globalFlags' $ \repoContext ->         install           verb-          (configPackageDB' configFlags'')+          (interpretPackageDBStack Nothing (configPackageDB' configFlags'))           repoContext           comp           platform           progdb'           globalFlags'-          configFlags''+          configFlags'           configExFlags'           installFlags'           haddockFlags'@@ -821,12 +879,15 @@   -> GlobalFlags   -> IO () testAction (buildFlags, testFlags) extraArgs globalFlags = do-  let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)+  let verbosity = fromFlagOrDefault normal (setupVerbosity $ buildCommonFlags buildFlags)   config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (testDistPref testFlags)+  distPref <- findSavedDistPref config (setupDistPref $ testCommonFlags testFlags)   let buildFlags' =         buildFlags-          { buildVerbosity = testVerbosity testFlags+          { buildCommonFlags =+              (buildCommonFlags buildFlags)+                { setupVerbosity = setupVerbosity $ testCommonFlags testFlags+                }           }       checkFlags = Check $ \_ flags@(configFlags, configExFlags) ->         if fromFlagOrDefault False (configTests configFlags)@@ -849,14 +910,20 @@       []       globalFlags       config-  nixShell verbosity distPref globalFlags config $ do+  nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do     let setupOptions = defaultSetupScriptOptions{useDistPref = distPref}-        testFlags' = testFlags{testDistPref = toFlag distPref}+        testFlags' =+          testFlags+            { testCommonFlags =+                (testCommonFlags testFlags){setupDistPref = toFlag distPref}+            }+        mbWorkDir = flagToMaybe $ testWorkingDir testFlags      -- The package was just configured, so the LBI must be available.     names <-       componentNamesFromLBI         verbosity+        mbWorkDir         distPref         "test suites"         (\c -> case c of LBI.CTest{} -> True; _ -> False)@@ -870,7 +937,14 @@           | otherwise = extraArgs      build verbosity config distPref buildFlags' extraArgs'-    setupWrapper verbosity setupOptions Nothing Cabal.testCommand (const testFlags') (const extraArgs')+    setupWrapper+      verbosity+      setupOptions+      Nothing+      Cabal.testCommand+      Cabal.testCommonFlags+      (const (return testFlags'))+      (const extraArgs')  data ComponentNames   = ComponentNamesUnknown@@ -879,12 +953,14 @@ -- | Return the names of all buildable components matching a given predicate. componentNamesFromLBI   :: Verbosity-  -> FilePath+  -> Maybe (SymbolicPath CWD (Dir Pkg))+  -- ^ working directory+  -> SymbolicPath Pkg (Dir Dist)   -> String   -> (LBI.Component -> Bool)   -> IO ComponentNames-componentNamesFromLBI verbosity distPref targetsDescr compPred = do-  eLBI <- tryGetPersistBuildConfig distPref+componentNamesFromLBI verbosity mbWorkDir distPref targetsDescr compPred = do+  eLBI <- tryGetPersistBuildConfig mbWorkDir distPref   case eLBI of     Left err -> case err of       -- Note: the build config could have been generated by a custom setup@@ -920,13 +996,16 @@     let verbosity =           fromFlagOrDefault             normal-            (buildVerbosity buildFlags)+            (setupVerbosity $ buildCommonFlags buildFlags)      config <- loadConfigOrSandboxConfig verbosity globalFlags-    distPref <- findSavedDistPref config (benchmarkDistPref benchmarkFlags)+    distPref <- findSavedDistPref config (setupDistPref $ benchmarkCommonFlags benchmarkFlags)     let buildFlags' =           buildFlags-            { buildVerbosity = benchmarkVerbosity benchmarkFlags+            { buildCommonFlags =+                (buildCommonFlags buildFlags)+                  { setupVerbosity = setupVerbosity $ benchmarkCommonFlags benchmarkFlags+                  }             }      let checkFlags = Check $ \_ flags@(configFlags, configExFlags) ->@@ -950,14 +1029,22 @@         []         globalFlags         config-    nixShell verbosity distPref globalFlags config $ do+    nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do       let setupOptions = defaultSetupScriptOptions{useDistPref = distPref}-          benchmarkFlags' = benchmarkFlags{benchmarkDistPref = toFlag distPref}+          benchmarkFlags' =+            benchmarkFlags+              { benchmarkCommonFlags =+                  (benchmarkCommonFlags benchmarkFlags)+                    { setupDistPref = toFlag distPref+                    }+              }+          mbWorkDir = flagToMaybe $ benchmarkWorkingDir benchmarkFlags        -- The package was just configured, so the LBI must be available.       names <-         componentNamesFromLBI           verbosity+          mbWorkDir           distPref           "benchmarks"           (\c -> case c of LBI.CBench{} -> True; _ -> False)@@ -971,13 +1058,21 @@             | otherwise = extraArgs        build verbosity config' distPref buildFlags' extraArgs'-      setupWrapper verbosity setupOptions Nothing Cabal.benchmarkCommand (const benchmarkFlags') (const extraArgs')+      setupWrapper+        verbosity+        setupOptions+        Nothing+        Cabal.benchmarkCommand+        Cabal.benchmarkCommonFlags+        (const (return benchmarkFlags'))+        (const extraArgs')  haddockAction :: HaddockFlags -> [String] -> Action haddockAction haddockFlags extraArgs globalFlags = do-  let verbosity = fromFlag (haddockVerbosity haddockFlags)+  let common = haddockCommonFlags haddockFlags+      verbosity = fromFlag $ setupVerbosity common   config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (haddockDistPref haddockFlags)+  distPref <- findSavedDistPref config (setupDistPref common)   config' <-     reconfigure       configureAction@@ -988,11 +1083,17 @@       []       globalFlags       config-  nixShell verbosity distPref globalFlags config $ do+  let mbWorkDir = flagToMaybe $ setupWorkingDir common+  nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do     let haddockFlags' =           defaultHaddockFlags             `mappend` savedHaddockFlags config'-            `mappend` haddockFlags{haddockDistPref = toFlag distPref}+            `mappend` haddockFlags+              { haddockCommonFlags =+                  (haddockCommonFlags haddockFlags)+                    { setupDistPref = toFlag distPref+                    }+              }         setupScriptOptions =           defaultSetupScriptOptions             { useDistPref = distPref@@ -1002,36 +1103,44 @@       setupScriptOptions       Nothing       haddockCommand-      (const haddockFlags')+      haddockCommonFlags+      (const (return haddockFlags'))       (const extraArgs)     when (haddockForHackage haddockFlags == Flag ForHackage) $ do-      pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)-      let dest = distPref </> name <.> "tar.gz"+      pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig mbWorkDir distPref)+      let dest = getSymbolicPath distPref </> name <.> "tar.gz"           name = display (packageId pkg) ++ "-docs"-          docDir = distPref </> "doc" </> "html"+          docDir = getSymbolicPath distPref </> "doc" </> "html"       createTarGzFile dest docDir name       notice verbosity $ "Documentation tarball created: " ++ dest  cleanAction :: CleanFlags -> [String] -> Action cleanAction cleanFlags extraArgs globalFlags = do+  let common = cleanCommonFlags cleanFlags+      verbosity = fromFlagOrDefault normal $ setupVerbosity common   load <- try (loadConfigOrSandboxConfig verbosity globalFlags)   let config = either (\(SomeException _) -> mempty) id load-  distPref <- findSavedDistPref config (cleanDistPref cleanFlags)+  distPref <- findSavedDistPref config $ setupDistPref common   let setupScriptOptions =         defaultSetupScriptOptions           { useDistPref = distPref           , useWin32CleanHack = True           }-      cleanFlags' = cleanFlags{cleanDistPref = toFlag distPref}+      cleanFlags' =+        cleanFlags+          { cleanCommonFlags =+              (cleanCommonFlags cleanFlags)+                { setupDistPref = toFlag distPref+                }+          }   setupWrapper     verbosity     setupScriptOptions     Nothing     cleanCommand-    (const cleanFlags')+    cleanCommonFlags+    (const (return cleanFlags'))     (const extraArgs)-  where-    verbosity = fromFlagOrDefault normal (cleanVerbosity cleanFlags)  listAction :: ListFlags -> [String] -> Action listAction listFlags extraArgs globalFlags = do@@ -1055,7 +1164,7 @@   withRepoContext verbosity globalFlags' $ \repoContext ->     List.list       verbosity-      (configPackageDB' configFlags)+      (interpretPackageDBStack Nothing (configPackageDB' configFlags))       repoContext       compProgdb       listFlags@@ -1078,7 +1187,7 @@   withRepoContext verbosity globalFlags' $ \repoContext ->     List.info       verbosity-      (configPackageDB' configFlags)+      (interpretPackageDBStack Nothing (configPackageDB' configFlags))       repoContext       comp       progdb@@ -1097,7 +1206,7 @@   withRepoContext verbosity globalFlags' $ \repoContext ->     fetch       verbosity-      (configPackageDB' configFlags)+      (interpretPackageDBStack Nothing (configPackageDB' configFlags))       repoContext       comp       platform@@ -1111,7 +1220,7 @@   let verbosity = fromFlag (freezeVerbosity freezeFlags)   config <- loadConfigOrSandboxConfig verbosity globalFlags   distPref <- findSavedDistPref config NoFlag-  nixShell verbosity distPref globalFlags config $ do+  nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do     let configFlags = savedConfigureFlags config         globalFlags' = savedGlobalFlags config `mappend` globalFlags     (comp, platform, progdb) <- configCompilerAux' configFlags@@ -1119,7 +1228,7 @@     withRepoContext verbosity globalFlags' $ \repoContext ->       freeze         verbosity-        (configPackageDB' configFlags)+        (interpretPackageDBStack Nothing (configPackageDB' configFlags))         repoContext         comp         platform@@ -1132,7 +1241,7 @@   let verbosity = fromFlag (freezeVerbosity freezeFlags)   config <- loadConfigOrSandboxConfig verbosity globalFlags   distPref <- findSavedDistPref config NoFlag-  nixShell verbosity distPref globalFlags config $ do+  nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do     let configFlags = savedConfigureFlags config         globalFlags' = savedGlobalFlags config `mappend` globalFlags     (comp, platform, progdb) <- configCompilerAux' configFlags@@ -1140,7 +1249,7 @@     withRepoContext verbosity globalFlags' $ \repoContext ->       genBounds         verbosity-        (configPackageDB' configFlags)+        (interpretPackageDBStack Nothing (configPackageDB' configFlags))         repoContext         comp         platform@@ -1217,8 +1326,9 @@         []         globalFlags       distPref <- findSavedDistPref config NoFlag-      pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)-      return $ distPref </> display (packageId pkg) ++ "-docs" <.> "tar.gz"+      let mbWorkDir = flagToMaybe $ configWorkingDir $ savedConfigureFlags config+      pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig mbWorkDir distPref)+      return $ getSymbolicPath distPref </> display (packageId pkg) ++ "-docs" <.> "tar.gz"  checkAction :: CheckFlags -> [String] -> Action checkAction checkFlags extraArgs _globalFlags = do@@ -1234,13 +1344,11 @@ formatAction verbosityFlag extraArgs _globalFlags = do   let verbosity = fromFlag verbosityFlag   path <- case extraArgs of-    [] -> do-      cwd <- getCurrentDirectory-      tryFindPackageDesc verbosity cwd-    (p : _) -> return p-  pkgDesc <- readGenericPackageDescription verbosity path+    [] -> relativeSymbolicPath <$> tryFindPackageDesc verbosity Nothing+    (p : _) -> return $ makeSymbolicPath p+  pkgDesc <- readGenericPackageDescription verbosity Nothing path   -- Uses 'writeFileAtomic' under the hood.-  writeGenericPackageDescription path pkgDesc+  writeGenericPackageDescription (getSymbolicPath path) pkgDesc  reportAction :: ReportFlags -> [String] -> Action reportAction reportFlags extraArgs globalFlags = do@@ -1262,9 +1370,10 @@  runAction :: BuildFlags -> [String] -> Action runAction buildFlags extraArgs globalFlags = do-  let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)+  let common = buildCommonFlags buildFlags+      verbosity = fromFlagOrDefault normal $ setupVerbosity common   config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (buildDistPref buildFlags)+  distPref <- findSavedDistPref config $ setupDistPref common   config' <-     reconfigure       configureAction@@ -1275,8 +1384,9 @@       []       globalFlags       config-  nixShell verbosity distPref globalFlags config $ do-    lbi <- getPersistBuildConfig distPref+  let mbWorkDir = flagToMaybe $ setupWorkingDir common+  nixShell verbosity (getSymbolicPath distPref) globalFlags config $ do+    lbi <- getPersistBuildConfig mbWorkDir distPref     (exe, exeArgs) <- splitRunArgs verbosity lbi extraArgs      build verbosity config' distPref buildFlags ["exe:" ++ display (exeName exe)]@@ -1323,7 +1433,7 @@       withRepoContext verbosity globalFlags' $ \repoContext ->         initCmd           verbosity-          (configPackageDB' confFlags')+          (interpretPackageDBStack Nothing (configPackageDB' confFlags'))           repoContext           comp           progdb@@ -1360,10 +1470,11 @@    in case bt of         Simple -> Simple.defaultMainArgs args         Configure ->-          Simple.defaultMainWithHooksArgs-            Simple.autoconfUserHooks+          Simple.defaultMainWithSetupHooksArgs+            Simple.autoconfSetupHooks             args         Make -> Make.defaultMainArgs args+        Hooks -> error "actAsSetupAction Hooks"         Custom -> error "actAsSetupAction Custom"  manpageAction :: [CommandSpec action] -> ManpageFlags -> [String] -> Action

@@ -8,13 +8,19 @@   ( NixStyleFlags (..)   , nixStyleOptions   , defaultNixStyleFlags+  , updNixStyleCommonSetupFlags   ) where  import Distribution.Client.Compat.Prelude import Prelude ()  import Distribution.Simple.Command (OptionField (..), ShowOrParseArgs)-import Distribution.Simple.Setup (BenchmarkFlags, HaddockFlags, TestFlags)+import Distribution.Simple.Setup+  ( BenchmarkFlags (benchmarkCommonFlags)+  , CommonSetupFlags (..)+  , HaddockFlags (..)+  , TestFlags (testCommonFlags)+  ) import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..))  import Distribution.Client.ProjectFlags@@ -125,4 +131,28 @@     , benchmarkFlags = mempty     , projectFlags = defaultProjectFlags     , extraFlags = x+    }++updNixStyleCommonSetupFlags+  :: (CommonSetupFlags -> CommonSetupFlags)+  -> NixStyleFlags a+  -> NixStyleFlags a+updNixStyleCommonSetupFlags setFlag nixFlags =+  nixFlags+    { configFlags =+        let flags = configFlags nixFlags+            common = configCommonFlags flags+         in flags{configCommonFlags = setFlag common}+    , haddockFlags =+        let flags = haddockFlags nixFlags+            common = haddockCommonFlags flags+         in flags{haddockCommonFlags = setFlag common}+    , testFlags =+        let flags = testFlags nixFlags+            common = testCommonFlags flags+         in flags{testCommonFlags = setFlag common}+    , benchmarkFlags =+        let flags = benchmarkFlags nixFlags+            common = benchmarkCommonFlags flags+         in flags{benchmarkCommonFlags = setFlag common}     }

@@ -44,7 +44,7 @@   , CompilerId   , DebugInfoLevel (..)   , OptimisationLevel (..)-  , PackageDB+  , PackageDBCWD   , ProfDetailLevel (..)   , showProfDetailLevel   )@@ -221,7 +221,7 @@   , pkgHashExtraIncludeDirs :: [FilePath]   , pkgHashProgPrefix :: Maybe PathTemplate   , pkgHashProgSuffix :: Maybe PathTemplate-  , pkgHashPackageDbs :: [Maybe PackageDB]+  , pkgHashPackageDbs :: [Maybe PackageDBCWD]   , -- Haddock options     pkgHashDocumentation :: Bool   , pkgHashHaddockHoogle :: Bool@@ -238,8 +238,9 @@   , pkgHashHaddockContents :: Maybe PathTemplate   , pkgHashHaddockIndex :: Maybe PathTemplate   , pkgHashHaddockBaseUrl :: Maybe String-  , pkgHashHaddockLib :: Maybe String+  , pkgHashHaddockResourcesDir :: Maybe String   , pkgHashHaddockOutputDir :: Maybe FilePath+  , pkgHashHaddockUseUnicode :: Bool   --     TODO: [required eventually] pkgHashToolsVersions     ?   --     TODO: [required eventually] pkgHashToolsExtraOptions ?   }@@ -347,8 +348,9 @@           , 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+          , opt "haddock-resources-dir" Nothing (fromMaybe "") pkgHashHaddockResourcesDir           , opt "haddock-output-dir" Nothing (fromMaybe "") pkgHashHaddockOutputDir+          , opt "haddock-use-unicode" False prettyShow pkgHashHaddockUseUnicode           ]             ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs     where

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -71,15 +72,15 @@  import Distribution.Package import Distribution.Simple.Compiler-  ( Compiler-  , PackageDB (..)-  , jsemSupported-  ) import Distribution.Simple.Program import qualified Distribution.Simple.Register as Cabal  import Distribution.Compat.Graph (IsNode (..)) import Distribution.Simple.Utils+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  ) import Distribution.Version  import qualified Data.Map as Map@@ -89,7 +90,7 @@  import Control.Exception (assert, bracket, handle) import System.Directory (doesDirectoryExist, doesFileExist, renameDirectory)-import System.FilePath (makeRelative, takeDirectory, (<.>), (</>))+import System.FilePath (makeRelative, normalise, takeDirectory, (<.>), (</>)) import System.Semaphore (SemaphoreName (..))  import Distribution.Client.Errors@@ -473,7 +474,7 @@   :: Verbosity   -> Compiler   -> ProgramDb-  -> PackageDB+  -> PackageDBCWD   -> IO () createPackageDBIfMissing   verbosity@@ -533,7 +534,7 @@         case pkgBuildStatus of           BuildStatusDownload -> downloadPhase           BuildStatusUnpack tarball -> unpackTarballPhase tarball-          BuildStatusRebuild srcdir status -> rebuildPhase status srcdir+          BuildStatusRebuild srcdir status -> rebuildPhase status (makeSymbolicPath srcdir)           -- TODO: perhaps re-nest the types to make these impossible           BuildStatusPreExisting{} -> unexpectedState           BuildStatusInstalled{} -> unexpectedState@@ -570,7 +571,7 @@       -- 'BuildInplaceOnly' style packages. 'BuildAndInstall' style packages       -- would only start from download or unpack phases.       ---      rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult+      rebuildPhase :: BuildStatusRebuild -> SymbolicPath CWD (Dir Pkg) -> IO BuildResult       rebuildPhase buildStatus srcdir =         assert           (isInplaceBuildStyle $ elabBuildStyle pkg)@@ -579,11 +580,13 @@           srcdir           builddir         where+          distdir = distBuildDirectory (elabDistDirParams sharedPackageConfig pkg)           builddir =-            distBuildDirectory-              (elabDistDirParams sharedPackageConfig pkg)+            makeSymbolicPath $+              makeRelative (normalise $ getSymbolicPath srcdir) distdir+      -- TODO: [nice to have] ^^ do this relative stuff better -      buildAndInstall :: FilePath -> FilePath -> IO BuildResult+      buildAndInstall :: SymbolicPath CWD (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> IO BuildResult       buildAndInstall srcdir builddir =         buildAndInstallUnpackedPackage           verbosity@@ -597,12 +600,9 @@           plan           rpkg           srcdir-          builddir'-        where-          builddir' = makeRelative srcdir builddir-      -- TODO: [nice to have] ^^ do this relative stuff better+          builddir -      buildInplace :: BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult+      buildInplace :: BuildStatusRebuild -> SymbolicPath CWD (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> IO BuildResult       buildInplace buildStatus srcdir builddir =         -- TODO: [nice to have] use a relative build dir rather than absolute         buildInplaceUnpackedPackage@@ -698,8 +698,8 @@   -> DistDirParams   -> BuildStyle   -> Maybe CabalFileText-  -> ( FilePath -- Source directory-       -> FilePath -- Build directory+  -> ( SymbolicPath CWD (Dir Pkg) -- Source directory+       -> SymbolicPath Pkg (Dir Dist) -- Build directory        -> IO a      )   -> IO a@@ -723,15 +723,15 @@       -- this way we avoid breaking those packages       BuildAndInstall ->         let tmpdir = distTempDirectory+            builddir = relativeSymbolicPath $ makeRelativePathEx "dist"          in withTempDirectory verbosity tmpdir "src" $ \unpackdir -> do+              let srcdir = makeSymbolicPath $ unpackdir </> prettyShow pkgid               unpackPackageTarball                 verbosity                 tarball                 unpackdir                 pkgid                 pkgTextOverride-              let srcdir = unpackdir </> prettyShow pkgid-                  builddir = srcdir </> "dist"               buildPkg srcdir builddir        -- In this case we make sure the tarball has been unpacked to the@@ -740,10 +740,14 @@       BuildInplaceOnly{} -> do         let srcrootdir = distUnpackedSrcRootDirectory             srcdir = distUnpackedSrcDirectory pkgid-            builddir = distBuildDirectory dparams+            builddir =+              makeSymbolicPath $+                makeRelative (normalise srcdir) $+                  distBuildDirectory dparams+        -- TODO: [nice to have] ^^ do this relative stuff better+        exists <- doesDirectoryExist srcdir         -- TODO: [nice to have] use a proper file monitor rather         -- than this dir exists test-        exists <- doesDirectoryExist srcdir         unless exists $ do           createDirectoryIfMissingVerbose verbosity True srcrootdir           unpackPackageTarball@@ -758,7 +762,7 @@             srcrootdir             pkgid             dparams-        buildPkg srcdir builddir+        buildPkg (makeSymbolicPath srcdir) builddir  unpackPackageTarball   :: Verbosity

@@ -26,7 +26,7 @@   )  import qualified Data.Set as Set-import Distribution.Client.Init.Types (removeExistingFile)+import Distribution.Client.Init.Types (removeExistingFile, runPromptIO)  ----------------------------- -- Package change detection@@ -291,4 +291,4 @@  invalidatePackageRegFileMonitor :: PackageFileMonitor -> IO () invalidatePackageRegFileMonitor PackageFileMonitor{pkgFileMonitorReg} =-  removeExistingFile (fileMonitorCacheFile pkgFileMonitorReg)+  runPromptIO $ removeExistingFile (fileMonitorCacheFile pkgFileMonitorReg)

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-}@@ -42,7 +43,9 @@ import Distribution.Client.FileMonitor import Distribution.Client.JobControl import Distribution.Client.Setup-  ( filterConfigureFlags+  ( CommonSetupFlags+  , filterCommonFlags+  , filterConfigureFlags   , filterHaddockArgs   , filterHaddockFlags   , filterTestFlags@@ -70,7 +73,8 @@ import Distribution.Simple.BuildPaths (haddockDirName) import Distribution.Simple.Command (CommandUI) import Distribution.Simple.Compiler-  ( PackageDBStack+  ( PackageDBStackCWD+  , coercePackageDBStack   ) import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Simple.LocalBuildInfo@@ -85,6 +89,10 @@  import Distribution.Simple.Utils import Distribution.System (Platform (..))+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  ) import Distribution.Version  import qualified Data.ByteString as BS@@ -126,7 +134,7 @@   | PBInstallPhase       { runCopy :: FilePath -> IO ()       , runRegister-          :: PackageDBStack+          :: PackageDBStackCWD           -> Cabal.RegisterOptions           -> IO InstalledPackageInfo       }@@ -151,9 +159,9 @@   -> ElaboratedSharedConfig   -> ElaboratedInstallPlan   -> ElaboratedReadyPackage-  -> FilePath-  -> FilePath-  -> Maybe (FilePath)+  -> SymbolicPath CWD (Dir Pkg)+  -> SymbolicPath Pkg (Dir Dist)+  -> Maybe FilePath   -- ^ The path to an /initialized/ log file   -> (PackageBuildingPhase -> IO ())   -> IO ()@@ -161,7 +169,7 @@   verbosity   distDirLayout@DistDirLayout{distTempDirectory}   maybe_semaphore-  BuildTimeSettings{buildSettingNumJobs}+  buildTimeSettings@BuildTimeSettings{buildSettingNumJobs}   registerLock   cacheLock   pkgshared@ElaboratedSharedConfig@@ -178,27 +186,27 @@     delegate $       PBConfigurePhase $         annotateFailure mlogFile ConfigureFailed $-          setup configureCommand configureFlags configureArgs+          setup configureCommand Cabal.configCommonFlags configureFlags configureArgs      -- Build phase     delegate $       PBBuildPhase $         annotateFailure mlogFile BuildFailed $ do-          setup buildCommand buildFlags buildArgs+          setup buildCommand Cabal.buildCommonFlags (return . buildFlags) buildArgs      -- Haddock phase     whenHaddock $       delegate $         PBHaddockPhase $           annotateFailure mlogFile HaddocksFailed $ do-            setup haddockCommand haddockFlags haddockArgs+            setup haddockCommand Cabal.haddockCommonFlags (return . haddockFlags) haddockArgs      -- Install phase     delegate $       PBInstallPhase         { runCopy = \destdir ->             annotateFailure mlogFile InstallFailed $-              setup Cabal.copyCommand (copyFlags destdir) copyArgs+              setup Cabal.copyCommand Cabal.copyCommonFlags (return . copyFlags destdir) copyArgs         , runRegister = \pkgDBStack registerOpts ->             annotateFailure mlogFile InstallFailed $ do               -- We register ourselves rather than via Setup.hs. We need to@@ -211,7 +219,8 @@                   verbosity                   compiler                   progdb-                  pkgDBStack+                  Nothing+                  (coercePackageDBStack pkgDBStack)                   ipkg                   registerOpts               return ipkg@@ -222,21 +231,21 @@       delegate $         PBTestPhase $           annotateFailure mlogFile TestsFailed $-            setup testCommand testFlags testArgs+            setup testCommand Cabal.testCommonFlags (return . testFlags) testArgs      -- Bench phase     whenBench $       delegate $         PBBenchPhase $           annotateFailure mlogFile BenchFailed $-            setup benchCommand benchFlags benchArgs+            setup benchCommand Cabal.benchmarkCommonFlags (return . benchFlags) benchArgs      -- Repl phase     whenRepl $       delegate $         PBReplPhase $           annotateFailure mlogFile ReplFailed $-            setupInteractive replCommand replFlags replArgs+            setupInteractive replCommand Cabal.replCommonFlags replFlags replArgs      return ()     where@@ -262,27 +271,31 @@         | hasValidHaddockTargets pkg = action         | otherwise = return () +      mbWorkDir = useWorkingDir scriptOptions+      commonFlags v =+        flip filterCommonFlags v $+          setupHsCommonFlags verbosity mbWorkDir builddir+       configureCommand = Cabal.configureCommand defaultProgramDb       configureFlags v =-        flip filterConfigureFlags v $-          setupHsConfigureFlags+        flip filterConfigureFlags v+          <$> setupHsConfigureFlags+            (\p -> makeSymbolicPath <$> canonicalizePath p)             plan             rpkg             pkgshared-            verbosity-            builddir+            (commonFlags v)       configureArgs _ = setupHsConfigureArgs pkg        buildCommand = Cabal.buildCommand defaultProgramDb-      buildFlags _ = setupHsBuildFlags comp_par_strat pkg pkgshared verbosity builddir+      buildFlags v = setupHsBuildFlags comp_par_strat pkg pkgshared $ commonFlags v       buildArgs _ = setupHsBuildArgs pkg -      copyFlags destdir _ =+      copyFlags destdir v =         setupHsCopyFlags           pkg           pkgshared-          verbosity-          builddir+          (commonFlags v)           destdir       -- In theory, we could want to copy less things than those that were       -- built, but instead, we simply copy the targets that were built.@@ -293,26 +306,23 @@         flip filterTestFlags v $           setupHsTestFlags             pkg-            verbosity-            builddir+            (commonFlags v)       testArgs _ = setupHsTestArgs pkg        benchCommand = Cabal.benchmarkCommand-      benchFlags _ =+      benchFlags v =         setupHsBenchFlags           pkg           pkgshared-          verbosity-          builddir+          (commonFlags v)       benchArgs _ = setupHsBenchArgs pkg        replCommand = Cabal.replCommand defaultProgramDb-      replFlags _ =+      replFlags v =         setupHsReplFlags           pkg           pkgshared-          verbosity-          builddir+          (commonFlags v)       replArgs _ = setupHsReplArgs pkg        haddockCommand = Cabal.haddockCommand@@ -321,8 +331,8 @@           setupHsHaddockFlags             pkg             pkgshared-            verbosity-            builddir+            buildTimeSettings+            (commonFlags v)       haddockArgs v =         flip filterHaddockArgs v $           setupHsHaddockArgs pkg@@ -340,11 +350,12 @@        setup         :: CommandUI flags-        -> (Version -> flags)+        -> (flags -> CommonSetupFlags)+        -> (Version -> IO flags)         -> (Version -> [String])         -> IO ()-      setup cmd flags args =-        withLogging $ \mLogFileHandle ->+      setup cmd getCommonFlags flags args =+        withLogging $ \mLogFileHandle -> do           setupWrapper             verbosity             scriptOptions@@ -356,21 +367,24 @@               }             (Just (elabPkgDescription pkg))             cmd+            getCommonFlags             flags             args        setupInteractive         :: CommandUI flags+        -> (flags -> CommonSetupFlags)         -> (Version -> flags)         -> (Version -> [String])         -> IO ()-      setupInteractive cmd flags args =+      setupInteractive cmd getCommonFlags flags args =         setupWrapper           verbosity           scriptOptions{isInteractive = True}           (Just (elabPkgDescription pkg))           cmd-          flags+          getCommonFlags+          (\v -> return (flags v))           args        generateInstalledPackageInfo :: IO InstalledPackageInfo@@ -379,14 +393,13 @@           verbosity           distTempDirectory           $ \pkgConfDest -> do-            let registerFlags _ =+            let registerFlags v =                   setupHsRegisterFlags                     pkg                     pkgshared-                    verbosity-                    builddir+                    (commonFlags v)                     pkgConfDest-            setup Cabal.registerCommand registerFlags (const [])+            setup (Cabal.registerCommand) Cabal.registerCommonFlags (\v -> return (registerFlags v)) (const [])        withLogging :: (Maybe Handle -> IO r) -> IO r       withLogging action =@@ -411,8 +424,8 @@   -> ElaboratedInstallPlan   -> ElaboratedReadyPackage   -> BuildStatusRebuild-  -> FilePath-  -> FilePath+  -> SymbolicPath CWD (Dir Pkg)+  -> SymbolicPath Pkg (Dir Dist)   -> IO BuildResult buildInplaceUnpackedPackage   verbosity@@ -434,7 +447,7 @@     -- TODO: [code cleanup] there is duplication between the     --      distdirlayout and the builddir here builddir is not     --      enough, we also need the per-package cachedir-    createDirectoryIfMissingVerbose verbosity True builddir+    createDirectoryIfMissingVerbose verbosity True $ getSymbolicPath builddir     createDirectoryIfMissingVerbose       verbosity       True@@ -464,7 +477,7 @@           whenReConfigure $ do             runConfigure             invalidatePackageRegFileMonitor packageFileMonitor-            updatePackageConfigFileMonitor packageFileMonitor srcdir pkg+            updatePackageConfigFileMonitor packageFileMonitor (getSymbolicPath srcdir) pkg         PBBuildPhase{runBuild} -> do           whenRebuild $ do             timestamp <- beginUpdateFileMonitor@@ -475,10 +488,10 @@               `onException` invalidatePackageRegFileMonitor packageFileMonitor              let listSimple =-                  execRebuild srcdir (needElaboratedConfiguredPackage pkg)+                  execRebuild (getSymbolicPath srcdir) (needElaboratedConfiguredPackage pkg)                 listSdist =                   fmap (map monitorFileHashed) $-                    allPackageSourceFiles verbosity srcdir+                    allPackageSourceFiles verbosity (getSymbolicPath srcdir)                 ifNullThen m m' = do                   xs <- m                   if null xs then m' else return xs@@ -511,7 +524,7 @@                       pkg             updatePackageBuildFileMonitor               packageFileMonitor-              srcdir+              (getSymbolicPath srcdir)               timestamp               pkg               buildStatus@@ -558,7 +571,7 @@                   return (Just ipkg)                 else return Nothing -            updatePackageRegFileMonitor packageFileMonitor srcdir mipkg+            updatePackageRegFileMonitor packageFileMonitor (getSymbolicPath srcdir) mipkg         PBTestPhase{runTest} -> runTest         PBBenchPhase{runBench} -> runBench         PBReplPhase{runRepl} -> runRepl@@ -617,8 +630,8 @@   -> ElaboratedSharedConfig   -> ElaboratedInstallPlan   -> ElaboratedReadyPackage-  -> FilePath-  -> FilePath+  -> SymbolicPath CWD (Dir Pkg)+  -> SymbolicPath Pkg (Dir Dist)   -> IO BuildResult buildAndInstallUnpackedPackage   verbosity@@ -638,7 +651,7 @@   rpkg@(ReadyPackage pkg)   srcdir   builddir = do-    createDirectoryIfMissingVerbose verbosity True (srcdir </> builddir)+    createDirectoryIfMissingVerbose verbosity True (interpretSymbolicPath (Just srcdir) builddir)      -- TODO: [code cleanup] deal consistently with talking to older     --      Setup.hs versions, much like we do for ghc, with a proper

@@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}  -- | Handling project configuration. module Distribution.Client.ProjectConfig@@ -18,8 +19,10 @@      -- * Project root   , findProjectRoot+  , getProjectRootUsability   , ProjectRoot (..)-  , BadProjectRoot+  , BadProjectRoot (..)+  , ProjectRootUsability (..)      -- * Project config files   , readProjectConfig@@ -34,6 +37,7 @@   , writeProjectLocalFreezeConfig   , writeProjectConfigFile   , commandLineFlagsToProjectConfig+  , onlyTopLevelProvenance      -- * Packages within projects   , ProjectPackageLocation (..)@@ -93,6 +97,7 @@   ( RepoContext (..)   , withRepoContext'   )+import Distribution.Client.HashValue import Distribution.Client.HttpUtils   ( HttpTransport   , configureTransport@@ -102,12 +107,12 @@ import Distribution.Client.Types import Distribution.Client.Utils.Parsec (renderParseError) +import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.PackageConstraint-  ( PackageProperty (..)-  ) import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SourcePackage +import Distribution.Client.Errors import Distribution.Client.Setup   ( defaultMaxBackjumps   , defaultSolver@@ -115,6 +120,7 @@ import Distribution.Client.SrcDist   ( packageDirToSdist   )+import Distribution.Client.Targets import Distribution.Client.Types.SourceRepo   ( SourceRepoList   , SourceRepositoryPackage (..)@@ -135,11 +141,6 @@   , showPWarning   ) import Distribution.Package-  ( PackageId-  , PackageName-  , UnitId-  , packageId-  ) import Distribution.PackageDescription.Parsec   ( parseGenericPackageDescription   )@@ -186,6 +187,10 @@ import Distribution.Types.SourceRepo   ( RepoType (..)   )+import Distribution.Utils.Generic+  ( toUTF8BS+  , toUTF8LBS+  ) import Distribution.Utils.NubList   ( fromNubList   )@@ -194,24 +199,20 @@   , verbose   ) import Distribution.Version-  ( Version-  )  import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar import qualified Distribution.Client.GZipUtils as GZipUtils import qualified Distribution.Client.Tar as Tar +import Control.Exception (handle) import Control.Monad.Trans (liftIO) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS-import qualified Data.Hashable as Hashable import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set-import Numeric (showHex) -import Distribution.Client.Errors import Network.URI   ( URI (..)   , URIAuth (..)@@ -219,6 +220,15 @@   , uriToString   ) import System.Directory+  ( canonicalizePath+  , doesDirectoryExist+  , doesFileExist+  , doesPathExist+  , getCurrentDirectory+  , getDirectoryContents+  , getHomeDirectory+  , pathIsSymbolicLink+  ) import System.FilePath hiding (combine) import System.IO   ( IOMode (ReadMode)@@ -310,9 +320,34 @@     where       -- TODO: [required eventually] some of these settings need validation, e.g.       -- the flag assignments need checking.+      cabalPkgname = mkPackageName "Cabal"++      profilingDynamicConstraint =+        ( UserConstraint+            (UserAnySetupQualifier cabalPkgname)+            (PackagePropertyVersion $ orLaterVersion (mkVersion [3, 13, 0]))+        , ConstraintSourceProfiledDynamic+        )++      profDynEnabledGlobally = fromFlagOrDefault False (packageConfigProfShared projectConfigLocalPackages)++      profDynEnabledAnyLocally =+        or+          [ fromFlagOrDefault False (packageConfigProfShared ppc)+          | (_, ppc) <- Map.toList (getMapMappend projectConfigSpecificPackage)+          ]++      -- Add a setup.Cabal >= 3.13 constraint if prof+dyn is enabled globally+      -- or any package in the project enables it.+      -- Ideally we'd apply this constraint only on the closure of packages requiring prof+dyn,+      -- but that would require another solver run for marginal advantages that+      -- will further shrink as 3.13 is adopted.+      solverCabalLibConstraints =+        [profilingDynamicConstraint | profDynEnabledGlobally || profDynEnabledAnyLocally]+       solverSettingRemoteRepos = fromNubList projectConfigRemoteRepos       solverSettingLocalNoIndexRepos = fromNubList projectConfigLocalNoIndexRepos-      solverSettingConstraints = projectConfigConstraints+      solverSettingConstraints = solverCabalLibConstraints ++ projectConfigConstraints       solverSettingPreferences = projectConfigPreferences       solverSettingFlagAssignment = packageConfigFlagAssignment projectConfigLocalPackages       solverSettingFlagAssignments =@@ -504,6 +539,24 @@ -- Reading and writing project config files -- +-- | Get @ProjectRootUsability@ of a given file+getProjectRootUsability :: FilePath -> IO ProjectRootUsability+getProjectRootUsability filePath = do+  exists <- doesFileExist filePath+  if exists+    then return ProjectRootUsabilityPresentAndUsable+    else do+      let isUsableAction =+            handle @IOException+              -- NOTE: if any IOException is raised, we assume the file does not exist.+              -- That is what happen when we call @pathIsSymbolicLink@ on a @FilePath@ that does not exist.+              (const $ pure False)+              ((||) <$> pathIsSymbolicLink filePath <*> doesPathExist filePath)+      isUnusable <- isUsableAction+      if isUnusable+        then return ProjectRootUsabilityPresentAndUnusable+        else return ProjectRootUsabilityNotPresent+ -- | Find the root of this project. -- -- The project directory will be one of the following:@@ -527,13 +580,18 @@             "Specifying an absolute path to the project file is deprecated."               <> " Use --project-dir to set the project's directory." -          doesFileExist file >>= \case-            False -> left (BadProjectRootExplicitFile file)-            True -> uncurry projectRoot =<< first dropTrailingPathSeparator . splitFileName <$> canonicalizePath file+          getProjectRootUsability file >>= \case+            ProjectRootUsabilityPresentAndUsable ->+              uncurry projectRoot+                =<< first dropTrailingPathSeparator . splitFileName <$> canonicalizePath file+            ProjectRootUsabilityNotPresent ->+              left (BadProjectRootExplicitFileNotFound file)+            ProjectRootUsabilityPresentAndUnusable ->+              left (BadProjectRootFileBroken file)       | otherwise -> probeProjectRoot mprojectFile     Just dir ->       doesDirectoryExist dir >>= \case-        False -> left (BadProjectRootDir dir)+        False -> left (BadProjectRootDirNotFound dir)         True -> do           projectDir <- canonicalizePath dir @@ -541,13 +599,21 @@             Nothing -> pure $ Right (ProjectRootExplicit projectDir defaultProjectFile)             Just projectFile               | isAbsolute projectFile ->-                  doesFileExist projectFile >>= \case-                    False -> left (BadProjectRootAbsoluteFile projectFile)-                    True -> Right . ProjectRootExplicitAbsolute dir <$> canonicalizePath projectFile+                  getProjectRootUsability projectFile >>= \case+                    ProjectRootUsabilityNotPresent ->+                      left (BadProjectRootAbsoluteFileNotFound projectFile)+                    ProjectRootUsabilityPresentAndUsable ->+                      Right . ProjectRootExplicitAbsolute dir <$> canonicalizePath projectFile+                    ProjectRootUsabilityPresentAndUnusable ->+                      left (BadProjectRootFileBroken projectFile)               | otherwise ->-                  doesFileExist (projectDir </> projectFile) >>= \case-                    False -> left (BadProjectRootDirFile dir projectFile)-                    True -> projectRoot projectDir projectFile+                  getProjectRootUsability (projectDir </> projectFile) >>= \case+                    ProjectRootUsabilityNotPresent ->+                      left (BadProjectRootDirFileNotFound dir projectFile)+                    ProjectRootUsabilityPresentAndUsable ->+                      projectRoot projectDir projectFile+                    ProjectRootUsabilityPresentAndUnusable ->+                      left (BadProjectRootFileBroken projectFile)   where     left = pure . Left @@ -556,7 +622,7 @@  probeProjectRoot :: Maybe FilePath -> IO (Either BadProjectRoot ProjectRoot) probeProjectRoot mprojectFile = do-  startdir <- getCurrentDirectory+  startdir <- System.Directory.getCurrentDirectory   homedir <- getHomeDirectory   probe startdir homedir   where@@ -572,46 +638,51 @@         go dir | isDrive dir || dir == homedir =           case mprojectFile of             Nothing -> return (Right (ProjectRootImplicit startdir))-            Just file -> return (Left (BadProjectRootExplicitFile file))+            Just file -> return (Left (BadProjectRootExplicitFileNotFound file))         go dir = do-          exists <- doesFileExist (dir </> projectFileName)-          if exists-            then return (Right (ProjectRootExplicit dir projectFileName))-            else go (takeDirectory dir)+          getProjectRootUsability (dir </> projectFileName) >>= \case+            ProjectRootUsabilityNotPresent ->+              go (takeDirectory dir)+            ProjectRootUsabilityPresentAndUsable ->+              return (Right $ ProjectRootExplicit dir projectFileName)+            ProjectRootUsabilityPresentAndUnusable ->+              return (Left $ BadProjectRootFileBroken projectFileName)  -- | Errors returned by 'findProjectRoot'. data BadProjectRoot-  = BadProjectRootExplicitFile FilePath-  | BadProjectRootDir FilePath-  | BadProjectRootAbsoluteFile FilePath-  | BadProjectRootDirFile FilePath FilePath-#if MIN_VERSION_base(4,8,0)-  deriving (Show, Typeable)-#else-  deriving (Typeable)--instance Show BadProjectRoot where-  show = renderBadProjectRoot-#endif+  = BadProjectRootExplicitFileNotFound FilePath+  | BadProjectRootDirNotFound FilePath+  | BadProjectRootAbsoluteFileNotFound FilePath+  | BadProjectRootDirFileNotFound FilePath FilePath+  | BadProjectRootFileBroken FilePath+  deriving (Show, Typeable, Eq) -#if MIN_VERSION_base(4,8,0) instance Exception BadProjectRoot where   displayException = renderBadProjectRoot-#else-instance Exception BadProjectRoot-#endif  renderBadProjectRoot :: BadProjectRoot -> String renderBadProjectRoot = \case-  BadProjectRootExplicitFile projectFile ->+  BadProjectRootExplicitFileNotFound projectFile ->     "The given project file '" ++ projectFile ++ "' does not exist."-  BadProjectRootDir dir ->+  BadProjectRootDirNotFound dir ->     "The given project directory '" <> dir <> "' does not exist."-  BadProjectRootAbsoluteFile file ->+  BadProjectRootAbsoluteFileNotFound file ->     "The given project file '" <> file <> "' does not exist."-  BadProjectRootDirFile dir file ->+  BadProjectRootDirFileNotFound dir file ->     "The given project directory/file combination '" <> dir </> file <> "' does not exist."+  BadProjectRootFileBroken file ->+    "The given project file '" <> file <> "' is broken. Is it a broken symbolic link?" +-- | State of the project file, encodes if the file can be used+data ProjectRootUsability+  = -- | The file is present and can be used+    ProjectRootUsabilityPresentAndUsable+  | -- | The file is present but can't be used (e.g. broken symlink)+    ProjectRootUsabilityPresentAndUnusable+  | -- | The file is not present+    ProjectRootUsabilityNotPresent+  deriving (Eq, Show)+ withGlobalConfig   :: Verbosity   -- ^ verbosity@@ -819,21 +890,11 @@ -- | Exception thrown by 'findProjectPackages'. data BadPackageLocations   = BadPackageLocations (Set ProjectConfigProvenance) [BadPackageLocation]-#if MIN_VERSION_base(4,8,0)   deriving (Show, Typeable)-#else-  deriving (Typeable) -instance Show BadPackageLocations where-  show = renderBadPackageLocations-#endif--#if MIN_VERSION_base(4,8,0) instance Exception BadPackageLocations where   displayException = renderBadPackageLocations-#else-instance Exception BadPackageLocations-#endif+ -- TODO: [nice to have] custom exception subclass for Doc rendering, colour etc  data BadPackageLocation@@ -1505,11 +1566,8 @@         . showChar ' '         . showsPrec 11 ws -instance Exception CabalFileParseError-#if MIN_VERSION_base(4,8,0)-  where+instance Exception CabalFileParseError where   displayException = renderCabalFileParseError-#endif  renderCabalFileParseError :: CabalFileParseError -> String renderCabalFileParseError (CabalFileParseError filePath contents errors _ warnings) =@@ -1601,7 +1659,7 @@ localFileNameForRemoteTarball uri =   mangleName uri     ++ "-"-    ++ showHex locationHash ""+    ++ showHashValue locationHash   where     mangleName =       truncateString 10@@ -1611,15 +1669,15 @@         . dropTrailingPathSeparator         . uriPath -    locationHash :: Word-    locationHash = fromIntegral (Hashable.hash (uriToString id uri ""))+    locationHash :: HashValue+    locationHash = hashValue (toUTF8LBS (uriToString id uri ""))  -- | The name to use for a local file or dir for a remote 'SourceRepo'. -- This is deterministic based on the source repo identity details, and -- intended to produce non-clashing file names for different repos. localFileNameForRemoteRepo :: SourceRepoList -> FilePath localFileNameForRemoteRepo SourceRepositoryPackage{srpType, srpLocation} =-  mangleName srpLocation ++ "-" ++ showHex locationHash ""+  mangleName srpLocation ++ "-" ++ showHashValue locationHash   where     mangleName =       truncateString 10@@ -1628,9 +1686,10 @@         . dropTrailingPathSeparator      -- just the parts that make up the "identity" of the repo-    locationHash :: Word+    locationHash :: HashValue     locationHash =-      fromIntegral (Hashable.hash (show srpType, srpLocation))+      hashValue $+        LBS.fromChunks [toUTF8BS srpLocation, toUTF8BS (show srpType)]  -- | Truncate a string, with a visual indication that it is truncated. truncateString :: Int -> String -> String@@ -1651,21 +1710,11 @@  data BadPerPackageCompilerPaths   = BadPerPackageCompilerPaths [(PackageName, String)]-#if MIN_VERSION_base(4,8,0)   deriving (Show, Typeable)-#else-  deriving (Typeable) -instance Show BadPerPackageCompilerPaths where-  show = renderBadPerPackageCompilerPaths-#endif--#if MIN_VERSION_base(4,8,0) instance Exception BadPerPackageCompilerPaths where   displayException = renderBadPerPackageCompilerPaths-#else-instance Exception BadPerPackageCompilerPaths-#endif+ -- TODO: [nice to have] custom exception subclass for Doc rendering, colour etc  renderBadPerPackageCompilerPaths :: BadPerPackageCompilerPaths -> String@@ -1705,3 +1754,9 @@        ] of     [] -> return ()     ps -> throwIO (BadPerPackageCompilerPaths ps)++-- | Filter out non-top-level project configs.+onlyTopLevelProvenance :: Set ProjectConfigProvenance -> Set ProjectConfigProvenance+onlyTopLevelProvenance = Set.filter $ \case+  Implicit -> False+  Explicit ps -> isTopLevelConfigPath ps

@@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-}@@ -84,6 +85,7 @@   ( CompilerInfo (..)   , DebugInfoLevel (..)   , OptimisationLevel (..)+  , interpretPackageDB   ) import Distribution.Simple.InstallDirs (CopyDest (NoCopyDest)) import Distribution.Simple.LocalBuildInfo@@ -100,6 +102,7 @@   ) import Distribution.Simple.Setup   ( BenchmarkFlags (..)+  , CommonSetupFlags (..)   , ConfigFlags (..)   , DumpBuildInfo (DumpBuildInfo, NoDumpBuildInfo)   , Flag (..)@@ -139,7 +142,9 @@   , toNubList   ) +import Distribution.Client.HttpUtils import Distribution.Client.ParseUtils+import Distribution.Client.ReplFlags (multiReplOption) import Distribution.Deprecated.ParseUtils   ( PError (..)   , PWarning (..)@@ -159,6 +164,7 @@   , (+++)   ) import qualified Distribution.Deprecated.ReadP as Parse+import Distribution.Fields.ConfVar (parseConditionConfVarFromClause) import Distribution.Parsec (ParsecParser, parsecToken) import Distribution.Simple.Command   ( CommandUI (commandOptions)@@ -171,6 +177,10 @@ import Distribution.Types.PackageVersionConstraint   ( PackageVersionConstraint   )+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  )  import qualified Data.ByteString.Char8 as BS import qualified Data.Map as Map@@ -185,11 +195,6 @@   ) import qualified Text.PrettyPrint as Disp -import Distribution.Fields.ConfVar (parseConditionConfVarFromClause)--import Distribution.Client.HttpUtils-import Distribution.Client.ReplFlags (multiReplOption)- ------------------------------------------------------------------ -- Handle extended project config files with conditionals and imports. --@@ -504,6 +509,7 @@           , packageConfigHaddockInternal = packageConfigHaddockInternal pc           , packageConfigHaddockQuickJump = packageConfigHaddockQuickJump pc           , packageConfigHaddockLinkedSource = packageConfigHaddockLinkedSource pc+          , packageConfigHaddockUseUnicode = packageConfigHaddockUseUnicode pc           }       ) @@ -680,17 +686,25 @@       , globalStoreDir = projectConfigStoreDir       } = globalFlags +    projectConfigPackageDBs = (fmap . fmap) (interpretPackageDB Nothing) projectConfigPackageDBs_+     ConfigFlags-      { configDistPref = projectConfigDistDir+      { configCommonFlags = commonFlags       , configHcFlavor = projectConfigHcFlavor       , configHcPath = projectConfigHcPath       , configHcPkg = projectConfigHcPkg       , -- configProgramPathExtra    = projectConfigProgPathExtra DELETE ME       configInstallDirs = projectConfigInstallDirs       , -- configUserInstall         = projectConfigUserInstall,-      configPackageDBs = projectConfigPackageDBs+      configPackageDBs = projectConfigPackageDBs_       } = configFlags +    CommonSetupFlags+      { setupDistPref = projectConfigAbsoluteDistDir+      } = commonFlags++    projectConfigDistDir = fmap getSymbolicPath projectConfigAbsoluteDistDir+     ConfigExFlags       { configCabalVersion = projectConfigCabalVersion       , configExConstraints = projectConfigConstraints@@ -758,6 +772,7 @@         , configFullyStaticExe = packageConfigFullyStaticExe         , configProfExe = packageConfigProfExe         , configProf = packageConfigProf+        , configProfShared = packageConfigProfShared         , configProfDetail = packageConfigProfDetail         , configProfLibDetail = packageConfigProfLibDetail         , configConfigureArgs = packageConfigConfigureArgs@@ -769,10 +784,6 @@         , configSplitObjs = packageConfigSplitObjs         , configStripExes = packageConfigStripExes         , configStripLibs = packageConfigStripLibs-        , configExtraLibDirs = packageConfigExtraLibDirs-        , configExtraLibDirsStatic = packageConfigExtraLibDirsStatic-        , configExtraFrameworkDirs = packageConfigExtraFrameworkDirs-        , configExtraIncludeDirs = packageConfigExtraIncludeDirs         , configConfigurationsFlags = packageConfigFlagAssignment         , configTests = packageConfigTests         , configBenchmarks = packageConfigBenchmarks@@ -783,6 +794,10 @@         , configRelocatable = packageConfigRelocatable         , configCoverageFor = _         } = configFlags+      packageConfigExtraLibDirs = fmap getSymbolicPath $ configExtraLibDirs configFlags+      packageConfigExtraLibDirsStatic = fmap getSymbolicPath $ configExtraLibDirsStatic configFlags+      packageConfigExtraFrameworkDirs = fmap getSymbolicPath $ configExtraFrameworkDirs configFlags+      packageConfigExtraIncludeDirs = fmap getSymbolicPath $ configExtraIncludeDirs configFlags       packageConfigProgramPaths = MapLast (Map.fromList configProgramPaths)       packageConfigProgramArgs = MapMappend (Map.fromListWith (++) configProgramArgs) @@ -811,8 +826,9 @@         , haddockContents = packageConfigHaddockContents         , haddockIndex = packageConfigHaddockIndex         , haddockBaseUrl = packageConfigHaddockBaseUrl-        , haddockLib = packageConfigHaddockLib+        , haddockResourcesDir = packageConfigHaddockResourcesDir         , haddockOutputDir = packageConfigHaddockOutputDir+        , haddockUseUnicode = packageConfigHaddockUseUnicode         } = haddockFlags        TestFlags@@ -859,9 +875,13 @@         } = globalFlags        ConfigFlags-        { configVerbosity = projectConfigVerbosity+        { configCommonFlags = commonFlags         } = configFlags +      CommonSetupFlags+        { setupVerbosity = projectConfigVerbosity+        } = commonFlags+       InstallFlags         { installDryRun = projectConfigDryRun         , installOnlyDownload = projectConfigOnlyDownload@@ -951,11 +971,16 @@           , globalProgPathExtra = projectConfigProgPathExtra           } +      commonFlags =+        mempty+          { setupVerbosity = projectConfigVerbosity+          , setupDistPref = fmap makeSymbolicPath $ projectConfigDistDir+          }+       configFlags =         mempty-          { configVerbosity = projectConfigVerbosity-          , configDistPref = projectConfigDistDir-          , configPackageDBs = projectConfigPackageDBs+          { configCommonFlags = commonFlags+          , configPackageDBs = fmap (fmap (fmap unsafeMakeSymbolicPath)) projectConfigPackageDBs           , configInstallDirs = projectConfigInstallDirs           } @@ -1033,9 +1058,12 @@       , legacyBenchmarkFlags = mempty       }     where+      commonFlags =+        mempty+       configFlags =         ConfigFlags-          { configArgs = mempty+          { configCommonFlags = commonFlags           , configPrograms_ = mempty           , configProgramPaths = mempty           , configProgramArgs = mempty@@ -1052,6 +1080,7 @@           , configFullyStaticExe = mempty           , configProfExe = mempty           , configProf = mempty+          , configProfShared = mempty           , configProfDetail = mempty           , configProfLibDetail = mempty           , configConfigureArgs = mempty@@ -1060,9 +1089,6 @@           , configProgSuffix = mempty           , configInstallDirs = projectConfigInstallDirs           , configScratchDir = mempty-          , configDistPref = mempty-          , configCabalFilePath = mempty-          , configVerbosity = mempty           , configUserInstall = mempty -- projectConfigUserInstall,           , configPackageDBs = mempty           , configGHCiLib = mempty@@ -1093,6 +1119,7 @@           , configDumpBuildInfo = mempty           , configAllowDependingOnPrivateLibs = mempty           , configCoverageFor = mempty+          , configIgnoreBuildTools = mempty           }        haddockFlags =@@ -1110,9 +1137,11 @@     , legacyBenchmarkFlags = benchmarkFlags     }   where+    commonFlags =+      mempty     configFlags =       ConfigFlags-        { configArgs = mempty+        { configCommonFlags = commonFlags         , configPrograms_ = configPrograms_ mempty         , configProgramPaths = Map.toList (getMapLast packageConfigProgramPaths)         , configProgramArgs = Map.toList (getMapMappend packageConfigProgramArgs)@@ -1129,6 +1158,7 @@         , configFullyStaticExe = packageConfigFullyStaticExe         , configProfExe = packageConfigProfExe         , configProf = packageConfigProf+        , configProfShared = packageConfigProfShared         , configProfDetail = packageConfigProfDetail         , configProfLibDetail = packageConfigProfLibDetail         , configConfigureArgs = packageConfigConfigureArgs@@ -1137,9 +1167,6 @@         , configProgSuffix = packageConfigProgSuffix         , configInstallDirs = mempty         , configScratchDir = mempty-        , configDistPref = mempty-        , configCabalFilePath = mempty-        , configVerbosity = mempty         , configUserInstall = mempty         , configPackageDBs = mempty         , configGHCiLib = packageConfigGHCiLib@@ -1147,13 +1174,13 @@         , configSplitObjs = packageConfigSplitObjs         , configStripExes = packageConfigStripExes         , configStripLibs = packageConfigStripLibs-        , configExtraLibDirs = packageConfigExtraLibDirs-        , configExtraLibDirsStatic = packageConfigExtraLibDirsStatic-        , configExtraFrameworkDirs = packageConfigExtraFrameworkDirs+        , configExtraLibDirs = fmap makeSymbolicPath $ packageConfigExtraLibDirs+        , configExtraLibDirsStatic = fmap makeSymbolicPath $ packageConfigExtraLibDirsStatic+        , configExtraFrameworkDirs = fmap makeSymbolicPath $ packageConfigExtraFrameworkDirs         , configConstraints = mempty         , configDependencies = mempty         , configPromisedDependencies = mempty-        , configExtraIncludeDirs = packageConfigExtraIncludeDirs+        , configExtraIncludeDirs = fmap makeSymbolicPath $ packageConfigExtraIncludeDirs         , configIPID = mempty         , configCID = mempty         , configDeterministic = mempty@@ -1170,6 +1197,7 @@         , configDumpBuildInfo = packageConfigDumpBuildInfo         , configAllowDependingOnPrivateLibs = mempty         , configCoverageFor = mempty+        , configIgnoreBuildTools = mempty         }      installFlags =@@ -1180,7 +1208,8 @@      haddockFlags =       HaddockFlags-        { haddockProgramPaths = mempty+        { haddockCommonFlags = commonFlags+        , haddockProgramPaths = mempty         , haddockProgramArgs = mempty         , haddockHoogle = packageConfigHaddockHoogle         , haddockHtml = packageConfigHaddockHtml@@ -1196,21 +1225,17 @@         , haddockQuickJump = packageConfigHaddockQuickJump         , haddockHscolourCss = packageConfigHaddockHscolourCss         , haddockContents = packageConfigHaddockContents-        , haddockDistPref = mempty         , haddockKeepTempFiles = mempty-        , haddockVerbosity = mempty-        , haddockCabalFilePath = mempty         , haddockIndex = packageConfigHaddockIndex         , haddockBaseUrl = packageConfigHaddockBaseUrl-        , haddockLib = packageConfigHaddockLib+        , haddockResourcesDir = packageConfigHaddockResourcesDir         , haddockOutputDir = packageConfigHaddockOutputDir-        , haddockArgs = mempty+        , haddockUseUnicode = packageConfigHaddockUseUnicode         }      testFlags =       TestFlags-        { testDistPref = mempty-        , testVerbosity = mempty+        { testCommonFlags = commonFlags         , testHumanLog = packageConfigTestHumanLog         , testMachineLog = packageConfigTestMachineLog         , testShowDetails = packageConfigTestShowDetails@@ -1222,8 +1247,7 @@      benchmarkFlags =       BenchmarkFlags-        { benchmarkDistPref = mempty-        , benchmarkVerbosity = mempty+        { benchmarkCommonFlags = commonFlags         , benchmarkOptions = packageConfigBenchmarkOptions         } @@ -1485,26 +1509,26 @@             "extra-include-dirs"             showTokenQ             parseTokenQ-            configExtraIncludeDirs-            (\v conf -> conf{configExtraIncludeDirs = v})+            (fmap getSymbolicPath . configExtraIncludeDirs)+            (\v conf -> conf{configExtraIncludeDirs = fmap makeSymbolicPath v})         , newLineListField             "extra-lib-dirs"             showTokenQ             parseTokenQ-            configExtraLibDirs-            (\v conf -> conf{configExtraLibDirs = v})+            (fmap getSymbolicPath . configExtraLibDirs)+            (\v conf -> conf{configExtraLibDirs = fmap makeSymbolicPath v})         , newLineListField             "extra-lib-dirs-static"             showTokenQ             parseTokenQ-            configExtraLibDirsStatic-            (\v conf -> conf{configExtraLibDirsStatic = v})+            (fmap getSymbolicPath . configExtraLibDirsStatic)+            (\v conf -> conf{configExtraLibDirsStatic = fmap makeSymbolicPath v})         , newLineListField             "extra-framework-dirs"             showTokenQ             parseTokenQ-            configExtraFrameworkDirs-            (\v conf -> conf{configExtraFrameworkDirs = v})+            (fmap getSymbolicPath . configExtraFrameworkDirs)+            (\v conf -> conf{configExtraFrameworkDirs = fmap makeSymbolicPath v})         , newLineListField             "extra-prog-path"             showTokenQ@@ -1532,11 +1556,13 @@         , "program-suffix"         , "library-vanilla"         , "library-profiling"+        , "library-vanilla"         , "shared"         , "static"         , "executable-dynamic"         , "executable-static"         , "profiling"+        , "profiling-shared"         , "executable-profiling"         , "profiling-detail"         , "library-profiling-detail"@@ -1606,8 +1632,9 @@             , "index-location"             , "keep-temp-files"             , "base-url"-            , "lib"+            , "resources-dir"             , "output-dir"+            , "use-unicode"             ]           . commandOptionsToFields        )

@@ -69,7 +69,7 @@   , CompilerFlavor   , DebugInfoLevel (..)   , OptimisationLevel (..)-  , PackageDB+  , PackageDBCWD   , ProfDetailLevel   ) import Distribution.Simple.InstallDirs@@ -198,7 +198,7 @@     -- projectConfigUserInstall       :: Flag Bool,      projectConfigInstallDirs :: InstallDirs (Flag PathTemplate)-  , projectConfigPackageDBs :: [Maybe PackageDB]+  , projectConfigPackageDBs :: [Maybe PackageDBCWD]   , -- configuration used both by the solver and other phases     projectConfigRemoteRepos :: NubList RemoteRepo   -- ^ Available Hackage servers.@@ -265,6 +265,7 @@   , packageConfigFullyStaticExe :: Flag Bool   , packageConfigProf :: Flag Bool -- TODO: [code cleanup] sort out   , packageConfigProfLib :: Flag Bool --      this duplication+  , packageConfigProfShared :: Flag Bool   , packageConfigProfExe :: Flag Bool --      and consistency   , packageConfigProfDetail :: Flag ProfDetailLevel   , packageConfigProfLibDetail :: Flag ProfDetailLevel@@ -305,8 +306,9 @@   , 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+  , packageConfigHaddockResourcesDir :: Flag String -- TODO: [required eventually] use this   , packageConfigHaddockOutputDir :: Flag FilePath -- TODO: [required eventually] use this+  , packageConfigHaddockUseUnicode :: Flag Bool -- TODO: [required eventually] use this   , packageConfigHaddockForHackage :: Flag HaddockTarget   , -- Test options     packageConfigTestHumanLog :: Flag PathTemplate

@@ -216,6 +216,7 @@ import Distribution.Utils.NubList   ( fromNubList   )+import Distribution.Utils.Path (makeSymbolicPath) import Distribution.Verbosity import Distribution.Version   ( mkVersion@@ -1042,13 +1043,20 @@        showConfigureFlags :: ElaboratedConfiguredPackage -> String       showConfigureFlags elab =-        let fullConfigureFlags =-              setupHsConfigureFlags-                elaboratedPlan-                (ReadyPackage elab)-                elaboratedShared+        let commonFlags =+              setupHsCommonFlags                 verbosity-                "$builddir"+                Nothing -- omit working directory+                (makeSymbolicPath "$builddir")+            fullConfigureFlags =+              runIdentity $+                ( setupHsConfigureFlags+                    (\_ -> return (error "unused"))+                    elaboratedPlan+                    (ReadyPackage elab)+                    elaboratedShared+                    commonFlags+                )             -- \| Given a default value @x@ for a flag, nub @Flag x@             -- into @NoFlag@.  This gives us a tidier command line             -- rendering.@@ -1056,7 +1064,7 @@             nubFlag x (Setup.Flag x') | x == x' = Setup.NoFlag             nubFlag _ f = f -            (tryLibProfiling, tryExeProfiling) =+            (tryLibProfiling, tryLibProfilingShared, tryExeProfiling) =               computeEffectiveProfiling fullConfigureFlags              partialConfigureFlags =@@ -1067,7 +1075,8 @@                     nubFlag tryExeProfiling (configProfExe fullConfigureFlags)                 , configProfLib =                     nubFlag tryLibProfiling (configProfLib fullConfigureFlags)-                    -- Maybe there are more we can add+                , configProfShared =+                    nubFlag tryLibProfilingShared (configProfShared fullConfigureFlags)                 }          in -- Not necessary to "escape" it, it's just for user output             unwords . ("" :) $@@ -1406,11 +1415,7 @@         " The build process terminated with exit code " ++ show n        _ -> " The exception was:\n  "-#if MIN_VERSION_base(4,8,0)              ++ displayException e-#else-             ++ show e-#endif      buildFailureException :: BuildFailureReason -> Maybe SomeException     buildFailureException reason =

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -39,7 +40,6 @@ import qualified Distribution.Compat.Binary as Binary import Distribution.Compat.Graph (Graph, Node) import qualified Distribution.Compat.Graph as Graph-import Distribution.Compiler (CompilerFlavor (GHC, GHCJS)) import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Package import qualified Distribution.PackageDescription as PD@@ -49,15 +49,6 @@   , exeExtension   ) import Distribution.Simple.Compiler-  ( Compiler-  , CompilerId (..)-  , PackageDB (..)-  , PackageDBStack-  , compilerFlavor-  , compilerId-  , compilerVersion-  , showCompilerId-  ) import Distribution.Simple.GHC   ( GhcEnvironmentFileEntry (..)   , GhcImplInfo (supportsPkgEnvFiles)@@ -70,6 +61,10 @@ import Distribution.Types.Version   ( mkVersion   )+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  ) import Distribution.Verbosity  import Distribution.Client.Compat.Prelude@@ -225,7 +220,7 @@           | elabSetupScriptCliVersion elab < mkVersion [3, 7, 0, 0] =               "build-info" J..= J.Null           | otherwise =-              "build-info" J..= J.String (buildInfoPref dist_dir)+              "build-info" J..= J.String (getSymbolicPath $ buildInfoPref $ makeSymbolicPath dist_dir)          packageLocationToJ :: PackageLocation (Maybe FilePath) -> J.Value         packageLocationToJ pkgloc =@@ -866,7 +861,7 @@   :: FilePath   -> ElaboratedInstallPlan   -> PostBuildProjectStatus-  -> [GhcEnvironmentFileEntry]+  -> [GhcEnvironmentFileEntry FilePath] renderGhcEnvironmentFile   projectRootDir   elaboratedInstallPlan@@ -972,7 +967,7 @@         elabRequiresRegistration pkg           && installedUnitId pkg `Set.member` packagesProbablyUpToDate -selectGhcEnvironmentFilePackageDbs :: ElaboratedInstallPlan -> PackageDBStack+selectGhcEnvironmentFilePackageDbs :: ElaboratedInstallPlan -> PackageDBStackCWD selectGhcEnvironmentFilePackageDbs elaboratedInstallPlan =   -- If we have any inplace packages then their package db stack is the   -- one we should use since it'll include the store + the local db but@@ -982,7 +977,7 @@     ([], pkgs) -> checkSamePackageDBs pkgs     (pkgs, _) -> checkSamePackageDBs pkgs   where-    checkSamePackageDBs :: [ElaboratedConfiguredPackage] -> PackageDBStack+    checkSamePackageDBs :: [ElaboratedConfiguredPackage] -> PackageDBStackCWD     checkSamePackageDBs pkgs =       case ordNub (map elabBuildPackageDBStack pkgs) of         [packageDbs] -> packageDbs@@ -1014,14 +1009,14 @@           InstallPlan.PreExisting _ -> Nothing       ] -relativePackageDBPaths :: FilePath -> PackageDBStack -> PackageDBStack+relativePackageDBPaths :: FilePath -> PackageDBStackCWD -> PackageDBStackCWD relativePackageDBPaths relroot = map (relativePackageDBPath relroot) -relativePackageDBPath :: FilePath -> PackageDB -> PackageDB+relativePackageDBPath :: FilePath -> PackageDBCWD -> PackageDBCWD relativePackageDBPath relroot pkgdb =   case pkgdb of     GlobalPackageDB -> GlobalPackageDB     UserPackageDB -> UserPackageDB     SpecificPackageDB path -> SpecificPackageDB relpath       where-        relpath = makeRelative relroot path+        relpath = makeRelative (normalise relroot) path

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-}@@ -74,6 +75,7 @@      -- * Setup.hs CLI flags for building   , setupHsScriptOptions+  , setupHsCommonFlags   , setupHsConfigureFlags   , setupHsConfigureArgs   , setupHsBuildFlags@@ -136,6 +138,10 @@ import Distribution.Utils.LogProgress import Distribution.Utils.MapAccum import Distribution.Utils.NubList+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  )  import qualified Hackage.Security.Client as Sec @@ -159,6 +165,8 @@   , componentName   , pkgComponents   )++import Distribution.Simple.BuildWay import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Simple.Program import Distribution.Simple.Program.Db@@ -184,6 +192,7 @@ import Distribution.Backpack.ModuleShape  import Distribution.Simple.Utils+import Distribution.Verbosity import Distribution.Version  import qualified Distribution.InstalledPackageInfo as IPI@@ -386,13 +395,13 @@           localPackages <- phaseReadLocalPackages (projectConfig <> cliConfig)           return (projectConfig, localPackages) -    sequence_-      [ do-        info verbosity . render . vcat $-          text "this build was affected by the following (project) config files:"-            : [text "-" <+> docProjectConfigPath path]-      | Explicit path <- Set.toList $ projectConfigProvenance projectConfig-      ]+    let configfiles =+          [ text "-" <+> docProjectConfigPath path+          | Explicit path <- Set.toList . (if verbosity >= verbose then id else onlyTopLevelProvenance) $ projectConfigProvenance projectConfig+          ]+    unless (null configfiles) $+      notice (verboseStderr verbosity) . render . vcat $+        text "Configuration is affected by the following files:" : configfiles      return (projectConfig <> cliConfig, localPackages)     where@@ -459,7 +468,7 @@         , packageConfigProgramPathExtra         }     } = do-    let fileMonitorCompiler = newFileMonitor . distProjectCacheFile $ "compiler"+    let fileMonitorCompiler = newFileMonitor $ distProjectCacheFile "compiler"      progsearchpath <- liftIO $ getSystemSearchPath     rerunIfChanged@@ -474,9 +483,10 @@       )       $ do         liftIO $ info verbosity "Compiler settings changed, reconfiguring..."-        progdb <- liftIO $ prependProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb+        let extraPath = fromNubList packageConfigProgramPathExtra+        progdb <- liftIO $ prependProgramSearchPath verbosity extraPath [] defaultProgramDb         let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb-        result@(_, _, progdb'') <-+        (comp, plat, progdb'') <-           liftIO $             Cabal.configCompilerEx               hcFlavor@@ -493,7 +503,12 @@         -- programs it cares about, and those are the ones we monitor here.         monitorFiles (programsMonitorFiles progdb'') -        return result+        -- Configure the unconfigured programs in the program database,+        -- as we can't serialise unconfigured programs.+        -- See also #2241 and #9840.+        finalProgDb <- liftIO $ configureAllKnownPrograms verbosity progdb''++        return (comp, plat, finalProgDb)     where       hcFlavor = flagToMaybe projectConfigHcFlavor       hcPath = flagToMaybe projectConfigHcPath@@ -650,7 +665,7 @@         -> (Compiler, Platform, ProgramDb)         -> [PackageSpecifier UnresolvedSourcePackage]         -> InstalledPackageIndex-        -> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)+        -> Rebuild (SolverInstallPlan, Maybe PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)       phaseRunSolver         projectConfig@ProjectConfig           { projectConfigShared@@ -710,7 +725,7 @@                     dieWithException verbosity $ PhaseRunSolverErr msg                   Right plan -> return (plan, pkgConfigDB, tis, ar)           where-            corePackageDbs :: [PackageDB]+            corePackageDbs :: PackageDBStackCWD             corePackageDbs =               Cabal.interpretPackageDbFlags False (projectConfigPackageDBs projectConfigShared) @@ -762,7 +777,7 @@       phaseElaboratePlan         :: ProjectConfig         -> (Compiler, Platform, ProgramDb)-        -> PkgConfigDb+        -> Maybe PkgConfigDb         -> SolverInstallPlan         -> [PackageSpecifier (SourcePackage (PackageLocation loc))]         -> Rebuild@@ -941,7 +956,7 @@   -> Compiler   -> ProgramDb   -> Platform-  -> PackageDBStack+  -> PackageDBStackCWD   -> Rebuild InstalledPackageIndex getInstalledPackages verbosity compiler progdb platform packagedbs = do   monitorFiles . map monitorFileOrDirectory@@ -949,7 +964,8 @@       ( IndexUtils.getInstalledPackagesMonitorFiles           verbosity           compiler-          packagedbs+          Nothing -- use ambient working directory+          (coercePackageDBStack packagedbs)           progdb           platform       )@@ -995,7 +1011,7 @@     $ repos   return sourcePkgDbWithTIS -getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild PkgConfigDb+getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild (Maybe PkgConfigDb) getPkgConfigDb verbosity progdb = do   dirs <- liftIO $ getPkgConfigDbDirs verbosity progdb   -- Just monitor the dirs so we'll notice new .pc files.@@ -1195,7 +1211,7 @@   -> SolverSettings   -> InstalledPackageIndex   -> SourcePackageDb-  -> PkgConfigDb+  -> Maybe PkgConfigDb   -> [PackageSpecifier UnresolvedSourcePackage]   -> Map PackageName (Map OptionalStanza Bool)   -> Progress String String SolverInstallPlan@@ -1518,7 +1534,7 @@   -> Platform   -> Compiler   -> ProgramDb-  -> PkgConfigDb+  -> Maybe PkgConfigDb   -> DistDirLayout   -> StoreDirLayout   -> SolverInstallPlan@@ -1614,13 +1630,18 @@                 (map fst src_comps)             let whyNotPerComp = why_not_per_component src_comps             case NE.nonEmpty whyNotPerComp of-              Nothing -> return comps+              Nothing -> do+                elaborationWarnings+                return comps               Just notPerCompReasons -> do                 checkPerPackageOk comps notPerCompReasons-                return-                  [ elaborateSolverToPackage notPerCompReasons spkg g $-                      comps ++ maybeToList setupComponent-                  ]+                pkgComp <-+                  elaborateSolverToPackage+                    notPerCompReasons+                    spkg+                    g+                    (comps ++ maybeToList setupComponent)+                return [pkgComp]           Left cns ->             dieProgress $               hang@@ -1628,6 +1649,7 @@                 4                 (vcat (map (text . componentNameStanza) cns))         where+          bt = PD.buildType (elabPkgDescription elab0)           -- You are eligible to per-component build if this list is empty           why_not_per_component g =             cuz_buildtype ++ cuz_spec ++ cuz_length ++ cuz_flag@@ -1643,11 +1665,12 @@               -- type, and teach all of the code paths how to handle it.               -- Once you've implemented this, swap it for the code below.               cuz_buildtype =-                case PD.buildType (elabPkgDescription elab0) of+                case bt of                   PD.Configure -> [CuzBuildType CuzConfigureBuildType]                   PD.Custom -> [CuzBuildType CuzCustomBuildType]+                  PD.Hooks -> [CuzBuildType CuzHooksBuildType]                   PD.Make -> [CuzBuildType CuzMakeBuildType]-                  _ -> []+                  PD.Simple -> []               -- cabal-format versions prior to 1.8 have different build-depends semantics               -- for now it's easier to just fallback to legacy-mode when specVersion < 1.8               -- see, https://github.com/haskell/cabal/issues/4121@@ -1681,7 +1704,7 @@                   <+> fsep (punctuate comma $ map (text . whyNotPerComponent) $ toList reasons)           -- TODO: Maybe exclude Backpack too -          elab0 = elaborateSolverToCommon spkg+          (elab0, elaborationWarnings) = elaborateSolverToCommon spkg           pkgid = elabPkgSourceId elab0           pd = elabPkgDescription elab0 @@ -1691,7 +1714,7 @@           -- have to add dependencies on this from all other components           setupComponent :: Maybe ElaboratedConfiguredPackage           setupComponent-            | PD.buildType (elabPkgDescription elab0) == PD.Custom =+            | bt `elem` [PD.Custom, PD.Hooks] =                 Just                   elab0                     { elabModuleShape = emptyModuleShape@@ -1915,7 +1938,7 @@                             ++ " from "                             ++ prettyShow (elabPkgSourceId elab0)                       )-                      (pkgConfigDbPkgVersion pkgConfigDB pn)+                      (pkgConfigDB >>= \db -> pkgConfigDbPkgVersion db pn)                   )                 | PkgconfigDependency pn _ <-                     PD.pkgconfigDepends@@ -1977,7 +2000,7 @@         -> SolverPackage UnresolvedPkgLoc         -> ComponentsGraph         -> [ElaboratedConfiguredPackage]-        -> ElaboratedConfiguredPackage+        -> LogProgress ElaboratedConfiguredPackage       elaborateSolverToPackage         pkgWhyNotPerComponent         pkg@( SolverPackage@@ -1988,13 +2011,14 @@                 _exe_deps0               )         compGraph-        comps =+        comps = do           -- Knot tying: the final elab includes the           -- pkgInstalledId, which is calculated by hashing many           -- of the other fields of the elaboratedPackage.-          elab+          elaborationWarnings+          return elab           where-            elab0@ElaboratedConfiguredPackage{..} =+            (elab0@ElaboratedConfiguredPackage{..}, elaborationWarnings) =               elaborateSolverToCommon pkg              elab1 =@@ -2080,7 +2104,7 @@        elaborateSolverToCommon         :: SolverPackage UnresolvedPkgLoc-        -> ElaboratedConfiguredPackage+        -> (ElaboratedConfiguredPackage, LogProgress ())       elaborateSolverToCommon         pkg@( SolverPackage                 (SourcePackage pkgid gdesc srcloc descOverride)@@ -2089,7 +2113,7 @@                 deps0                 _exe_deps0               ) =-          elaboratedPackage+          (elaboratedPackage, wayWarnings pkgid)           where             elaboratedPackage = ElaboratedConfiguredPackage{..} @@ -2157,6 +2181,13 @@             elabBuildHaddocks =               perPkgOptionFlag pkgid False packageConfigDocumentation +            -- `documentation: true` should imply `-haddock` for GHC+            addHaddockIfDocumentationEnabled :: ConfiguredProgram -> ConfiguredProgram+            addHaddockIfDocumentationEnabled cp@ConfiguredProgram{..} =+              if programId == "ghc" && elabBuildHaddocks+                then cp{programOverrideArgs = "-haddock" : programOverrideArgs}+                else cp+             elabPkgSourceLocation = srcloc             elabPkgSourceHash = Map.lookup pkgid sourcePackageHashes             elabLocalToProject = isLocalToProject pkg@@ -2190,13 +2221,14 @@             elabBuildOptions =               LBC.BuildOptions                 { withVanillaLib = perPkgOptionFlag pkgid True packageConfigVanillaLib -- TODO: [required feature]: also needs to be handled recursively-                , withSharedLib = pkgid `Set.member` pkgsUseSharedLibrary+                , withSharedLib = canBuildSharedLibs && pkgid `Set.member` pkgsUseSharedLibrary                 , withStaticLib = perPkgOptionFlag pkgid False packageConfigStaticLib                 , withDynExe = perPkgOptionFlag pkgid False packageConfigDynExe                 , withFullyStaticExe = perPkgOptionFlag pkgid False packageConfigFullyStaticExe                 , withGHCiLib = perPkgOptionFlag pkgid False packageConfigGHCiLib -- TODO: [required feature] needs to default to enabled on windows still                 , withProfExe = perPkgOptionFlag pkgid False packageConfigProf-                , withProfLib = pkgid `Set.member` pkgsUseProfilingLibrary+                , withProfLib = canBuildProfilingLibs && pkgid `Set.member` pkgsUseProfilingLibrary+                , withProfLibShared = canBuildProfilingSharedLibs && pkgid `Set.member` pkgsUseProfilingLibraryShared                 , exeCoverage = perPkgOptionFlag pkgid False packageConfigCoverage                 , libCoverage = perPkgOptionFlag pkgid False packageConfigCoverage                 , withOptimization = perPkgOptionFlag pkgid NormalOptimisation packageConfigOptimization@@ -2236,7 +2268,7 @@               Map.fromList                 [ (programId prog, args)                 | prog <- configuredPrograms compilerprogdb-                , let args = programOverrideArgs prog+                , let args = programOverrideArgs $ addHaddockIfDocumentationEnabled prog                 , not (null args)                 ]                 <> perPkgOptionMapMappend pkgid packageConfigProgramArgs@@ -2265,8 +2297,9 @@             elabHaddockContents = perPkgOptionMaybe pkgid packageConfigHaddockContents             elabHaddockIndex = perPkgOptionMaybe pkgid packageConfigHaddockIndex             elabHaddockBaseUrl = perPkgOptionMaybe pkgid packageConfigHaddockBaseUrl-            elabHaddockLib = perPkgOptionMaybe pkgid packageConfigHaddockLib+            elabHaddockResourcesDir = perPkgOptionMaybe pkgid packageConfigHaddockResourcesDir             elabHaddockOutputDir = perPkgOptionMaybe pkgid packageConfigHaddockOutputDir+            elabHaddockUseUnicode = perPkgOptionFlag pkgid False packageConfigHaddockUseUnicode              elabTestMachineLog = perPkgOptionMaybe pkgid packageConfigTestMachineLog             elabTestHumanLog = perPkgOptionMaybe pkgid packageConfigTestHumanLog@@ -2355,35 +2388,112 @@       pkgsUseSharedLibrary :: Set PackageId       pkgsUseSharedLibrary =         packagesWithLibDepsDownwardClosedProperty needsSharedLib++      needsSharedLib pkgid =+        fromMaybe+          compilerShouldUseSharedLibByDefault+          -- Case 1: --enable-shared or --disable-shared is passed explicitly, honour that.+          ( case pkgSharedLib of+              Just v -> Just v+              Nothing -> case pkgDynExe of+                -- case 2: If --enable-executable-dynamic is passed then turn on+                -- shared library generation.+                Just True ->+                  -- Case 3: If --enable-profiling is passed, then we are going to+                  -- build profiled dynamic, so no need for shared libraries.+                  case pkgProf of+                    Just True -> if canBuildProfilingSharedLibs then Nothing else Just True+                    _ -> Just True+                -- But don't necessarily turn off shared library generation if+                -- --disable-executable-dynamic is passed. The shared objects might+                -- be needed for something different.+                _ -> Nothing+          )         where-          needsSharedLib pkg =-            fromMaybe-              compilerShouldUseSharedLibByDefault-              (liftM2 (||) pkgSharedLib pkgDynExe)-            where-              pkgid = packageId pkg-              pkgSharedLib = perPkgOptionMaybe pkgid packageConfigSharedLib-              pkgDynExe = perPkgOptionMaybe pkgid packageConfigDynExe+          pkgSharedLib = perPkgOptionMaybe pkgid packageConfigSharedLib+          pkgDynExe = perPkgOptionMaybe pkgid packageConfigDynExe+          pkgProf = perPkgOptionMaybe pkgid packageConfigProf        -- TODO: [code cleanup] move this into the Cabal lib. It's currently open       -- coded in Distribution.Simple.Configure, but should be made a proper       -- function of the Compiler or CompilerInfo.       compilerShouldUseSharedLibByDefault =         case compilerFlavor compiler of-          GHC -> GHC.isDynamic compiler+          GHC -> GHC.compilerBuildWay compiler == DynWay && canBuildSharedLibs           GHCJS -> GHCJS.isDynamic compiler           _ -> False +      compilerShouldUseProfilingLibByDefault =+        case compilerFlavor compiler of+          GHC -> GHC.compilerBuildWay compiler == ProfWay && canBuildProfilingLibs+          _ -> False++      compilerShouldUseProfilingSharedLibByDefault =+        case compilerFlavor compiler of+          GHC -> GHC.compilerBuildWay compiler == ProfDynWay && canBuildProfilingSharedLibs+          _ -> False++      -- Returns False if we definitely can't build shared libs+      canBuildWayLibs predicate = case predicate compiler of+        Just can_build -> can_build+        -- If we don't know for certain, just assume we can+        -- which matches behaviour in previous cabal releases+        Nothing -> True++      canBuildSharedLibs = canBuildWayLibs dynamicSupported+      canBuildProfilingLibs = canBuildWayLibs profilingVanillaSupported+      canBuildProfilingSharedLibs = canBuildWayLibs profilingDynamicSupported++      wayWarnings pkg = do+        when+          (needsProfilingLib pkg && not canBuildProfilingLibs)+          (warnProgress (text "Compiler does not support building p libraries, profiling is disabled"))+        when+          (needsSharedLib pkg && not canBuildSharedLibs)+          (warnProgress (text "Compiler does not support building dyn libraries, dynamic libraries are disabled"))+        when+          (needsProfilingLibShared pkg && not canBuildProfilingSharedLibs)+          (warnProgress (text "Compiler does not support building p_dyn libraries, profiling dynamic libraries are disabled."))+       pkgsUseProfilingLibrary :: Set PackageId       pkgsUseProfilingLibrary =         packagesWithLibDepsDownwardClosedProperty needsProfilingLib++      needsProfilingLib pkg =+        fromFlagOrDefault compilerShouldUseProfilingLibByDefault (profBothFlag <> profLibFlag)         where-          needsProfilingLib pkg =-            fromFlagOrDefault False (profBothFlag <> profLibFlag)-            where-              pkgid = packageId pkg-              profBothFlag = lookupPerPkgOption pkgid packageConfigProf-              profLibFlag = lookupPerPkgOption pkgid packageConfigProfLib+          pkgid = packageId pkg+          profBothFlag = lookupPerPkgOption pkgid packageConfigProf+          profLibFlag = lookupPerPkgOption pkgid packageConfigProfLib++      pkgsUseProfilingLibraryShared :: Set PackageId+      pkgsUseProfilingLibraryShared =+        packagesWithLibDepsDownwardClosedProperty needsProfilingLibShared++      needsProfilingLibShared pkg =+        fromMaybe+          compilerShouldUseProfilingSharedLibByDefault+          -- case 1: If --enable-profiling-shared is passed explicitly, honour that+          ( case profLibSharedFlag of+              Just v -> Just v+              Nothing -> case pkgDynExe of+                Just True ->+                  case pkgProf of+                    -- case 2: --enable-executable-dynamic + --enable-profiling+                    -- turn on shared profiling libraries+                    Just True -> if canBuildProfilingSharedLibs then Just True else Nothing+                    _ -> Nothing+                -- But don't necessarily turn off shared library generation is+                -- --disable-executable-dynamic is passed. The shared objects might+                -- be needed for something different.+                _ -> Nothing+          )+        where+          pkgid = packageId pkg+          profLibSharedFlag = perPkgOptionMaybe pkgid packageConfigProfShared+          pkgDynExe = perPkgOptionMaybe pkgid packageConfigDynExe+          pkgProf = perPkgOptionMaybe pkgid packageConfigProf+       -- TODO: [code cleanup] unused: the old deprecated packageConfigProfExe        libDepGraph =@@ -2400,7 +2510,7 @@             libDepGraph             [ Graph.nodeKey pkg             | pkg <- SolverInstallPlan.toList solverPlan-            , property pkg -- just the packages that satisfy the property+            , property (packageId pkg) -- just the packages that satisfy the property             -- TODO: [nice to have] this does not check the config consistency,             -- e.g. a package explicitly turning off profiling, but something             -- depending on it that needs profiling. This really needs a separate@@ -3657,8 +3767,8 @@   -> ElaboratedInstallPlan   -> ElaboratedSharedConfig   -> DistDirLayout-  -> FilePath-  -> FilePath+  -> SymbolicPath CWD (Dir Pkg)+  -> SymbolicPath Pkg (Dir Dist)   -> Bool   -> Lock   -> SetupScriptOptions@@ -3675,7 +3785,14 @@   cacheLock =     SetupScriptOptions       { useCabalVersion = thisVersion elabSetupScriptCliVersion-      , useCabalSpecVersion = Just elabSetupScriptCliVersion+      , useCabalSpecVersion =+          if PD.buildType elabPkgDescription == PD.Hooks+            then -- NB: we don't want to commit to a Cabal version here:+            --   - all that should matter for Hooks build-type is the+            --     version of Cabal-hooks, not of Cabal,+            --   - if we commit to a Cabal version, the logic in+              Nothing+            else Just elabSetupScriptCliVersion       , useCompiler = Just pkgConfigCompiler       , usePlatform = Just pkgConfigPlatform       , usePackageDB = elabSetupPackageDBStack@@ -3793,24 +3910,31 @@ -- TODO: [code cleanup] perhaps reorder this code -- based on the ElaboratedInstallPlan + ElaboratedSharedConfig, -- make the various Setup.hs {configure,build,copy} flags- setupHsConfigureFlags-  :: ElaboratedInstallPlan+  :: Monad m+  => (FilePath -> m (SymbolicPath Pkg (Dir PkgDB)))+  -- ^ How to transform a path which is relative to cabal-install cwd to one which+  -- is relative to the route of the package about to be compiled. The simplest way+  -- to do this is to convert the potentially relative path into an absolute path.+  -> ElaboratedInstallPlan   -> ElaboratedReadyPackage   -> ElaboratedSharedConfig-  -> Verbosity-  -> FilePath-  -> Cabal.ConfigFlags+  -> Cabal.CommonSetupFlags+  -> m Cabal.ConfigFlags setupHsConfigureFlags+  mkSymbolicPath   plan   (ReadyPackage elab@ElaboratedConfiguredPackage{..})   sharedConfig@ElaboratedSharedConfig{..}-  verbosity-  builddir =-    sanityCheckElaboratedConfiguredPackage-      sharedConfig-      elab-      (Cabal.ConfigFlags{..})+  configCommonFlags = do+    -- explicitly clear, then our package db stack+    -- TODO: [required eventually] have to do this differently for older Cabal versions+    configPackageDBs <- (traverse . traverse . traverse) mkSymbolicPath (Nothing : map Just elabBuildPackageDBStack)+    return $+      sanityCheckElaboratedConfiguredPackage+        sharedConfig+        elab+        Cabal.ConfigFlags{..}     where       Cabal.ConfigFlags         { configVanillaLib@@ -3821,6 +3945,7 @@         , configGHCiLib         , -- , configProfExe -- overridden         configProfLib+        , configProfShared         , -- , configProf -- overridden         configProfDetail         , configProfLibDetail@@ -3837,11 +3962,6 @@       configProfExe = mempty       configProf = toFlag $ LBC.withProfExe elabBuildOptions -      configArgs = mempty -- unused, passed via args-      configDistPref = toFlag builddir-      configCabalFilePath = mempty-      configVerbosity = toFlag verbosity-       configInstantiateWith = Map.toList elabInstantiatedWith        configDeterministic = mempty -- doesn't matter, configIPID/configCID overridese@@ -3882,10 +4002,10 @@        configConfigurationsFlags = elabFlagAssignment       configConfigureArgs = elabConfigureScriptArgs-      configExtraLibDirs = elabExtraLibDirs-      configExtraLibDirsStatic = elabExtraLibDirsStatic-      configExtraFrameworkDirs = elabExtraFrameworkDirs-      configExtraIncludeDirs = elabExtraIncludeDirs+      configExtraLibDirs = fmap makeSymbolicPath $ elabExtraLibDirs+      configExtraLibDirsStatic = fmap makeSymbolicPath $ elabExtraLibDirsStatic+      configExtraFrameworkDirs = fmap makeSymbolicPath $ elabExtraFrameworkDirs+      configExtraIncludeDirs = fmap makeSymbolicPath $ elabExtraIncludeDirs       configProgPrefix = maybe mempty toFlag elabProgPrefix       configProgSuffix = maybe mempty toFlag elabProgSuffix @@ -3907,7 +4027,7 @@         ]        configPromisedDependencies =-        [ cidToGivenComponent cid+        [ cidToPromisedComponent cid         | (cid, is_internal) <- elabLibDependencies elab         , is_internal         ]@@ -3920,10 +4040,6 @@             ]           ElabComponent _ -> [] -      -- explicitly clear, then our package db stack-      -- TODO: [required eventually] have to do this differently for older Cabal versions-      configPackageDBs = Nothing : map Just elabBuildPackageDBStack-       configTests = case elabPkgOrComp of         ElabPackage pkg -> toFlag (TestStanzas `optStanzaSetMember` pkgStanzasEnabled pkg)         ElabComponent _ -> mempty@@ -3938,6 +4054,7 @@       configPrograms_ = mempty -- never use, shouldn't exist       configUseResponseFiles = mempty       configAllowDependingOnPrivateLibs = Flag $ not $ libraryVisibilitySupported pkgConfigCompiler+      configIgnoreBuildTools = mempty        cidToGivenComponent :: ConfiguredId -> GivenComponent       cidToGivenComponent (ConfiguredId srcid mb_cn cid) = GivenComponent (packageName srcid) ln cid@@ -3947,8 +4064,17 @@             Just _ -> error "non-library dependency"             Nothing -> LMainLibName -      configCoverageFor = determineCoverageFor elabPkgSourceId plan+      configCoverageFor = determineCoverageFor elab plan +      cidToPromisedComponent :: ConfiguredId -> PromisedComponent+      cidToPromisedComponent (ConfiguredId srcid mb_cn cid) =+        PromisedComponent srcid ln cid+        where+          ln = case mb_cn of+            Just (CLibName lname) -> lname+            Just _ -> error "non-library dependency"+            Nothing -> LMainLibName+ setupHsConfigureArgs   :: ElaboratedConfiguredPackage   -> [String]@@ -3961,27 +4087,37 @@         (error "setupHsConfigureArgs: trying to configure setup")         (compComponentName comp) +setupHsCommonFlags+  :: Verbosity+  -> Maybe (SymbolicPath CWD (Dir Pkg))+  -> SymbolicPath Pkg (Dir Dist)+  -> Cabal.CommonSetupFlags+setupHsCommonFlags verbosity mbWorkDir builddir =+  Cabal.CommonSetupFlags+    { setupDistPref = toFlag builddir+    , setupVerbosity = toFlag verbosity+    , setupCabalFilePath = mempty+    , setupWorkingDir = maybeToFlag mbWorkDir+    , setupTargets = []+    }+ setupHsBuildFlags   :: Flag String   -> ElaboratedConfiguredPackage   -> ElaboratedSharedConfig-  -> Verbosity-  -> FilePath+  -> Cabal.CommonSetupFlags   -> Cabal.BuildFlags-setupHsBuildFlags par_strat elab _ verbosity builddir =+setupHsBuildFlags par_strat elab _ common =   Cabal.BuildFlags-    { buildProgramPaths = mempty -- unused, set at configure time+    { buildCommonFlags = common+    , buildProgramPaths = mempty -- unused, set at configure time     , buildProgramArgs = mempty -- unused, set at configure time-    , buildVerbosity = toFlag verbosity-    , buildDistPref = toFlag builddir     , buildNumJobs = mempty -- TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs),     , buildUseSemaphore =         if elabSetupScriptCliVersion elab >= mkVersion [3, 11, 0, 0]           then -- Cabal 3.11 is the first version that supports parallelism semaphores             par_strat           else mempty-    , buildArgs = mempty -- unused, passed via args not flags-    , buildCabalFilePath = mempty     }  setupHsBuildArgs :: ElaboratedConfiguredPackage -> [String]@@ -3996,13 +4132,11 @@  setupHsTestFlags   :: ElaboratedConfiguredPackage-  -> Verbosity-  -> FilePath+  -> Cabal.CommonSetupFlags   -> Cabal.TestFlags-setupHsTestFlags (ElaboratedConfiguredPackage{..}) verbosity builddir =+setupHsTestFlags (ElaboratedConfiguredPackage{..}) common =   Cabal.TestFlags-    { testDistPref = toFlag builddir-    , testVerbosity = toFlag verbosity+    { testCommonFlags = common     , testMachineLog = maybe mempty toFlag elabTestMachineLog     , testHumanLog = maybe mempty toFlag elabTestHumanLog     , testShowDetails = maybe (Flag Cabal.Always) toFlag elabTestShowDetails@@ -4020,13 +4154,11 @@ setupHsBenchFlags   :: ElaboratedConfiguredPackage   -> ElaboratedSharedConfig-  -> Verbosity-  -> FilePath+  -> Cabal.CommonSetupFlags   -> Cabal.BenchmarkFlags-setupHsBenchFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir =+setupHsBenchFlags (ElaboratedConfiguredPackage{..}) _ common =   Cabal.BenchmarkFlags-    { benchmarkDistPref = toFlag builddir-    , benchmarkVerbosity = toFlag verbosity+    { benchmarkCommonFlags = common     , benchmarkOptions = elabBenchmarkOptions     } @@ -4037,15 +4169,13 @@ setupHsReplFlags   :: ElaboratedConfiguredPackage   -> ElaboratedSharedConfig-  -> Verbosity-  -> FilePath+  -> Cabal.CommonSetupFlags   -> Cabal.ReplFlags-setupHsReplFlags _ sharedConfig verbosity builddir =+setupHsReplFlags _ sharedConfig common =   Cabal.ReplFlags-    { replProgramPaths = mempty -- unused, set at configure time+    { replCommonFlags = common+    , replProgramPaths = mempty -- unused, set at configure time     , replProgramArgs = mempty -- unused, set at configure time-    , replVerbosity = toFlag verbosity-    , replDistPref = toFlag builddir     , replReload = mempty -- only used as callback from repl     , replReplOptions = pkgConfigReplOptions sharedConfig -- runtime override for repl flags     }@@ -4057,88 +4187,81 @@ setupHsCopyFlags   :: ElaboratedConfiguredPackage   -> ElaboratedSharedConfig-  -> Verbosity-  -> FilePath+  -> Cabal.CommonSetupFlags   -> FilePath   -> Cabal.CopyFlags-setupHsCopyFlags _ _ verbosity builddir destdir =+setupHsCopyFlags _ _ common destdir =   Cabal.CopyFlags-    { copyArgs = [] -- TODO: could use this to only copy what we enabled+    { copyCommonFlags = common     , copyDest = toFlag (InstallDirs.CopyTo destdir)-    , copyDistPref = toFlag builddir-    , copyVerbosity = toFlag verbosity-    , copyCabalFilePath = mempty     }  setupHsRegisterFlags   :: ElaboratedConfiguredPackage   -> ElaboratedSharedConfig-  -> Verbosity-  -> FilePath+  -> Cabal.CommonSetupFlags   -> FilePath   -> Cabal.RegisterFlags setupHsRegisterFlags   ElaboratedConfiguredPackage{..}   _-  verbosity-  builddir+  common   pkgConfFile =     Cabal.RegisterFlags-      { regPackageDB = mempty -- misfeature+      { registerCommonFlags = common+      , regPackageDB = mempty -- misfeature       , regGenScript = mempty -- never use-      , regGenPkgConf = toFlag (Just pkgConfFile)+      , regGenPkgConf = toFlag (Just (makeSymbolicPath pkgConfFile))       , regInPlace = case elabBuildStyle of           BuildInplaceOnly{} -> toFlag True           BuildAndInstall -> toFlag False       , regPrintId = mempty -- never use-      , regDistPref = toFlag builddir-      , regArgs = []-      , regVerbosity = toFlag verbosity-      , regCabalFilePath = mempty       }  setupHsHaddockFlags   :: ElaboratedConfiguredPackage   -> ElaboratedSharedConfig-  -> Verbosity-  -> FilePath+  -> BuildTimeSettings+  -> Cabal.CommonSetupFlags   -> Cabal.HaddockFlags-setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) (ElaboratedSharedConfig{..}) verbosity builddir =-  Cabal.HaddockFlags-    { 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-    , haddockHtmlLocation = maybe mempty toFlag elabHaddockHtmlLocation-    , haddockForHackage = toFlag elabHaddockForHackage-    , haddockForeignLibs = toFlag elabHaddockForeignLibs-    , haddockExecutables = toFlag elabHaddockExecutables-    , haddockTestSuites = toFlag elabHaddockTestSuites-    , haddockBenchmarks = toFlag elabHaddockBenchmarks-    , haddockInternal = toFlag elabHaddockInternal-    , haddockCss = maybe mempty toFlag elabHaddockCss-    , haddockLinkedSource = toFlag elabHaddockLinkedSource-    , haddockQuickJump = toFlag elabHaddockQuickJump-    , haddockHscolourCss = maybe mempty toFlag elabHaddockHscolourCss-    , haddockContents = maybe mempty toFlag elabHaddockContents-    , haddockDistPref = toFlag builddir-    , 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-    , haddockOutputDir = maybe mempty toFlag elabHaddockOutputDir-    , haddockArgs = mempty-    }+setupHsHaddockFlags+  (ElaboratedConfiguredPackage{..})+  (ElaboratedSharedConfig{..})+  (BuildTimeSettings{buildSettingKeepTempFiles = keepTmpFiles})+  common =+    Cabal.HaddockFlags+      { haddockCommonFlags = common+      , 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+      , haddockHtmlLocation = maybe mempty toFlag elabHaddockHtmlLocation+      , haddockForHackage = toFlag elabHaddockForHackage+      , haddockForeignLibs = toFlag elabHaddockForeignLibs+      , haddockExecutables = toFlag elabHaddockExecutables+      , haddockTestSuites = toFlag elabHaddockTestSuites+      , haddockBenchmarks = toFlag elabHaddockBenchmarks+      , haddockInternal = toFlag elabHaddockInternal+      , haddockCss = maybe mempty toFlag elabHaddockCss+      , haddockLinkedSource = toFlag elabHaddockLinkedSource+      , haddockQuickJump = toFlag elabHaddockQuickJump+      , haddockHscolourCss = maybe mempty toFlag elabHaddockHscolourCss+      , haddockContents = maybe mempty toFlag elabHaddockContents+      , haddockKeepTempFiles = toFlag keepTmpFiles+      , haddockIndex = maybe mempty toFlag elabHaddockIndex+      , haddockBaseUrl = maybe mempty toFlag elabHaddockBaseUrl+      , haddockResourcesDir = maybe mempty toFlag elabHaddockResourcesDir+      , haddockOutputDir = maybe mempty toFlag elabHaddockOutputDir+      , haddockUseUnicode = toFlag elabHaddockUseUnicode+      }  setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String] -- TODO: Does the issue #3335 affects test as well@@ -4294,8 +4417,9 @@     , pkgHashHaddockContents = elabHaddockContents     , pkgHashHaddockIndex = elabHaddockIndex     , pkgHashHaddockBaseUrl = elabHaddockBaseUrl-    , pkgHashHaddockLib = elabHaddockLib+    , pkgHashHaddockResourcesDir = elabHaddockResourcesDir     , pkgHashHaddockOutputDir = elabHaddockOutputDir+    , pkgHashHaddockUseUnicode = elabHaddockUseUnicode     }   where     ElaboratedConfiguredPackage{..} = normaliseConfiguredPackage shared pkg@@ -4360,13 +4484,14 @@  -- The list of non-pre-existing libraries without module holes, i.e. the -- main library and sub-libraries components of all the local packages in--- the project that do not require instantiations or are instantiations.+-- the project that are dependencies of the components being built and that do+-- not require instantiations or are instantiations. determineCoverageFor-  :: PackageId-  -- ^ The 'PackageId' of the package or component being configured+  :: ElaboratedConfiguredPackage+  -- ^ The package or component being configured   -> ElaboratedInstallPlan   -> Flag [UnitId]-determineCoverageFor configuredPkgSourceId plan =+determineCoverageFor configuredPkg plan =   Flag     $ mapMaybe       ( \case@@ -4379,15 +4504,18 @@     $ Graph.toList     $ InstallPlan.toGraph plan   where-    shouldCoverPkg elab@ElaboratedConfiguredPackage{elabModuleShape, elabPkgSourceId, elabLocalToProject} =+    libDeps = elabLibDependencies configuredPkg+    shouldCoverPkg elab@ElaboratedConfiguredPackage{elabModuleShape, elabPkgSourceId = pkgSID, elabLocalToProject} =       elabLocalToProject         && not (isIndefiniteOrInstantiation elabModuleShape)         -- TODO(#9493): We can only cover libraries in the same package         -- as the testsuite-        && configuredPkgSourceId == elabPkgSourceId+        && elabPkgSourceId configuredPkg == pkgSID         -- Libraries only! We don't cover testsuite modules, so we never need         -- the paths to their mix dirs. Furthermore, we do not install testsuites...         && maybe False (\case CLibName{} -> True; CNotLibName{} -> False) (elabComponentName elab)+        -- We only want coverage for libraries which are dependencies of the given one+        && pkgSID `elem` map (confSrcId . fst) libDeps      isIndefiniteOrInstantiation :: ModuleShape -> Bool     isIndefiniteOrInstantiation = not . Set.null . modShapeRequires

@@ -59,17 +59,17 @@ -- @since 3.12.0.0 packageSetupScriptStyle :: PackageDescription -> SetupScriptStyle packageSetupScriptStyle pkg-  | buildType pkg == Custom+  | customOrHooks   , Just setupbi <- setupBuildInfo pkg -- does have a custom-setup stanza   , not (defaultSetupDepends setupbi) -- but not one we added ourselves     =       SetupCustomExplicitDeps-  | buildType pkg == Custom+  | customOrHooks   , Just setupbi <- setupBuildInfo pkg -- does have a custom-setup stanza   , defaultSetupDepends setupbi -- that we had to add ourselves     =       SetupCustomImplicitDeps-  | buildType pkg == Custom+  | customOrHooks   , Nothing <- setupBuildInfo pkg -- we get this case pre-solver     =       SetupCustomImplicitDeps@@ -79,6 +79,8 @@       SetupNonCustomExternalLib   | otherwise =       SetupNonCustomInternalLib+  where+    customOrHooks = buildType pkg `elem` [Custom, Hooks]  -- | Part of our Setup.hs handling policy is implemented by getting the solver -- to work out setup dependencies for packages. The solver already handles@@ -131,11 +133,10 @@      -- For other build types (like Simple) if we still need to compile an     -- external Setup.hs, it'll be one of the simple ones that only depends-    -- on Cabal and base.+    -- on Cabal.     SetupNonCustomExternalLib ->       Just         [ Dependency cabalPkgname cabalConstraint mainLibSet-        , Dependency basePkgname anyVersion mainLibSet         ]       where         cabalConstraint = orLaterVersion (csvToVersion (specVersion pkg))@@ -215,9 +216,8 @@         fromMaybe [] $           Graph.closure libDepGraph (CD.setupDeps deps) -cabalPkgname, basePkgname :: PackageName+cabalPkgname :: PackageName cabalPkgname = mkPackageName "Cabal"-basePkgname = mkPackageName "base"  legacyCustomSetupPkgs :: Compiler -> Platform -> [PackageName] legacyCustomSetupPkgs compiler (Platform _ os) =

@@ -86,6 +86,7 @@ import Distribution.Backpack import Distribution.Backpack.ModuleShape +import Distribution.Compat.Graph (IsNode (..)) import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.ModuleName (ModuleName) import Distribution.Package@@ -106,20 +107,19 @@   , ReplOptions   , TestShowDetails   )+import Distribution.Simple.Utils (ordNub)+import Distribution.Solver.Types.ComponentDeps (ComponentDeps)+import qualified Distribution.Solver.Types.ComponentDeps as CD+import Distribution.Solver.Types.OptionalStanza import Distribution.System import Distribution.Types.ComponentRequestedSpec import qualified Distribution.Types.LocalBuildConfig as LBC import Distribution.Types.PackageDescription (PackageDescription (..)) import Distribution.Types.PkgconfigVersion+import Distribution.Utils.Path (getSymbolicPath) import Distribution.Verbosity (normal) import Distribution.Version -import Distribution.Compat.Graph (IsNode (..))-import Distribution.Simple.Utils (ordNub)-import Distribution.Solver.Types.ComponentDeps (ComponentDeps)-import qualified Distribution.Solver.Types.ComponentDeps as CD-import Distribution.Solver.Types.OptionalStanza- import qualified Data.ByteString.Lazy as LBS import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map@@ -262,13 +262,13 @@   -- that a user enabled tests globally, and some local packages   -- just happen not to have any tests.  (But perhaps we should   -- warn if ALL local packages don't have any tests.)-  , elabPackageDbs :: [Maybe PackageDB]-  , elabSetupPackageDBStack :: PackageDBStack-  , elabBuildPackageDBStack :: PackageDBStack-  , elabRegisterPackageDBStack :: PackageDBStack-  , elabInplaceSetupPackageDBStack :: PackageDBStack-  , elabInplaceBuildPackageDBStack :: PackageDBStack-  , elabInplaceRegisterPackageDBStack :: PackageDBStack+  , elabPackageDbs :: [Maybe PackageDBCWD]+  , elabSetupPackageDBStack :: PackageDBStackCWD+  , elabBuildPackageDBStack :: PackageDBStackCWD+  , elabRegisterPackageDBStack :: PackageDBStackCWD+  , elabInplaceSetupPackageDBStack :: PackageDBStackCWD+  , elabInplaceBuildPackageDBStack :: PackageDBStackCWD+  , elabInplaceRegisterPackageDBStack :: PackageDBStackCWD   , elabPkgDescriptionOverride :: Maybe CabalFileText   , -- TODO: make per-component variants of these flags     elabBuildOptions :: LBC.BuildOptions@@ -300,8 +300,9 @@   , elabHaddockContents :: Maybe PathTemplate   , elabHaddockIndex :: Maybe PathTemplate   , elabHaddockBaseUrl :: Maybe String-  , elabHaddockLib :: Maybe String+  , elabHaddockResourcesDir :: Maybe String   , elabHaddockOutputDir :: Maybe FilePath+  , elabHaddockUseUnicode :: Bool   , elabTestMachineLog :: Maybe PathTemplate   , elabTestHumanLog :: Maybe PathTemplate   , elabTestShowDetails :: Maybe TestShowDetails@@ -457,9 +458,7 @@     BuildInplaceOnly{} ->       Just         ( pkgPathEnvVar (elabPkgDescription pkg) "datadir"-        , Just $-            srcPath (elabPkgSourceLocation pkg)-              </> dataDir (elabPkgDescription pkg)+        , Just dataDirPath         )   where     srcPath (LocalUnpackedPackage path) = path@@ -473,7 +472,17 @@         "calling dataDirEnvVarForPackage on a not-downloaded repo is an error"     unpackedPath =       distUnpackedSrcDirectory distDirLayout $ elabPkgSourceId pkg+    rawDataDir = getSymbolicPath $ dataDir (elabPkgDescription pkg)+    pkgDir = srcPath (elabPkgSourceLocation pkg)+    dataDirPath+      | null rawDataDir =+          pkgDir+      | otherwise =+          pkgDir </> rawDataDir +-- NB: rawDataDir may be absolute, in which case+-- (</>) drops its first argument.+ instance Package ElaboratedConfiguredPackage where   packageId = elabPkgSourceId @@ -754,6 +763,7 @@ data NotPerComponentBuildType   = CuzConfigureBuildType   | CuzCustomBuildType+  | CuzHooksBuildType   | CuzMakeBuildType   deriving (Eq, Show, Generic) @@ -771,6 +781,7 @@     "build-type is " ++ case bt of       CuzConfigureBuildType -> "Configure"       CuzCustomBuildType -> "Custom"+      CuzHooksBuildType -> "Hooks"       CuzMakeBuildType -> "Make"   CuzCabalSpecVersion -> "cabal-version is less than 1.8"   CuzNoBuildableComponents -> "there are no buildable components"

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} 

@@ -1,3 +1,5 @@+{-# LANGUAGE DataKinds #-}+ module Distribution.Client.Reconfigure (Check (..), reconfigure) where  import Distribution.Client.Compat.Prelude@@ -8,10 +10,11 @@ import Distribution.Simple.Configure (localBuildInfoFile) import Distribution.Simple.Setup (Flag, flagToMaybe, toFlag) import Distribution.Simple.Utils-  ( defaultPackageDesc+  ( defaultPackageDescCwd   , existsAndIsMoreRecentThan   , info   )+import Distribution.Utils.Path  import Distribution.Client.Config (SavedConfig (..)) import Distribution.Client.Configure (readConfigFlags)@@ -21,7 +24,8 @@   ( userPackageEnvironmentFile   ) import Distribution.Client.Setup-  ( ConfigExFlags+  ( CommonSetupFlags (..)+  , ConfigExFlags   , ConfigFlags (..)   , GlobalFlags (..)   )@@ -80,7 +84,7 @@   -- ^ configure action   -> Verbosity   -- ^ Verbosity setting-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -- ^ \"dist\" prefix   -> Flag (Maybe Int)   -- ^ -j flag for reinstalling add-source deps.@@ -104,7 +108,7 @@   globalFlags   config =     do-      savedFlags@(_, _) <- readConfigFlags dist+      savedFlags@(_, _) <- readConfigFlags $ getSymbolicPath dist        useNix <- fmap isJust (findNixExpr globalFlags config)       alreadyInNixShell <- inNixShell@@ -121,7 +125,7 @@           -- No, because 'nixShell' doesn't spawn a new process if it is already           -- running in a Nix shell. -          nixInstantiate verbosity dist False globalFlags config+          nixInstantiate verbosity (getSymbolicPath dist) False globalFlags config           return config         else do           let checks :: Check (ConfigFlags, ConfigExFlags)@@ -138,12 +142,18 @@           when frc $ configureAction flags extraArgs globalFlags           return config'     where+      mbWorkDir = flagToMaybe $ configWorkingDir $ savedConfigureFlags config       -- Changing the verbosity does not require reconfiguration, but the new       -- verbosity should be used if reconfiguring.       checkVerb :: Check (ConfigFlags, b)       checkVerb = Check $ \_ (configFlags, configExFlags) -> do-        let configFlags' :: ConfigFlags-            configFlags' = configFlags{configVerbosity = toFlag verbosity}+        let common = configCommonFlags configFlags+            configFlags' :: ConfigFlags+            configFlags' =+              configFlags+                { configCommonFlags =+                    common{setupVerbosity = toFlag verbosity}+                }         return (mempty, (configFlags', configExFlags))        -- Reconfiguration is required if @--build-dir@ changes.@@ -151,18 +161,25 @@       checkDist = Check $ \_ (configFlags, configExFlags) -> do         -- Always set the chosen @--build-dir@ before saving the flags,         -- or bad things could happen.-        savedDist <- findSavedDistPref config (configDistPref configFlags)+        let common = configCommonFlags configFlags+        savedDist <- findSavedDistPref config (setupDistPref common)         let distChanged :: Bool             distChanged = dist /= savedDist         when distChanged $ info verbosity "build directory changed"         let configFlags' :: ConfigFlags-            configFlags' = configFlags{configDistPref = toFlag dist}+            configFlags' =+              configFlags+                { configCommonFlags =+                    common{setupDistPref = toFlag dist}+                }         return (Any distChanged, (configFlags', configExFlags))        checkOutdated :: Check (ConfigFlags, b)       checkOutdated = Check $ \_ flags@(configFlags, _) -> do-        let buildConfig :: FilePath-            buildConfig = localBuildInfoFile dist+        let common = configCommonFlags configFlags+            buildConfig, userCabalConfig :: FilePath+            buildConfig = interpretSymbolicPath mbWorkDir $ localBuildInfoFile dist+            userCabalConfig = userPackageEnvironmentFile          -- Has the package ever been configured? If not, reconfiguration is         -- required.@@ -173,7 +190,7 @@         -- to force reconfigure. Note that it's possible to use @cabal.config@         -- even without sandboxes.         userPackageEnvironmentFileModified <--          existsAndIsMoreRecentThan userPackageEnvironmentFile buildConfig+          existsAndIsMoreRecentThan userCabalConfig buildConfig         when userPackageEnvironmentFileModified $           info             verbosity@@ -185,11 +202,12 @@         -- Is the configuration older than the package description?         descrFile <-           maybe-            (defaultPackageDesc verbosity)+            (relativeSymbolicPath <$> defaultPackageDescCwd verbosity)             return-            (flagToMaybe (configCabalFilePath configFlags))-        outdated <- existsAndIsMoreRecentThan descrFile buildConfig-        when outdated $ info verbosity (descrFile ++ " was changed")+            (flagToMaybe (setupCabalFilePath common))+        let descrPath = interpretSymbolicPath mbWorkDir descrFile+        outdated <- existsAndIsMoreRecentThan descrPath buildConfig+        when outdated $ info verbosity (getSymbolicPath descrFile ++ " was changed")          let failed :: Any             failed =

@@ -1,4 +1,5 @@ -----------------------------------------------------------------------------+{-# LANGUAGE DataKinds #-}  ----------------------------------------------------------------------------- @@ -26,20 +27,30 @@   , PackageDescription (..)   , TestSuite (..)   )-import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)+import Distribution.Simple (PackageDBX (..))+import Distribution.Simple.Build (addInternalBuildTools) import Distribution.Simple.BuildPaths (exeExtension) import Distribution.Simple.Compiler (CompilerFlavor (..), compilerFlavor)+import Distribution.Simple.Flag (fromFlag) import Distribution.Simple.LocalBuildInfo   ( ComponentName (..)   , LocalBuildInfo (..)   , buildDir   , depLibraryPaths+  , interpretSymbolicPathLBI+  , mbWorkDirLBI   )+import Distribution.Simple.Program.Db+import Distribution.Simple.Program.Find+import Distribution.Simple.Program.Run+import Distribution.Simple.Register (internalPackageDBPath)++import Distribution.Simple.Setup (ConfigFlags (..)) import Distribution.Simple.Utils   ( addLibraryPath   , dieWithException   , notice-  , rawSystemExitWithEnv+  , rawSystemExitWithEnvCwd   , warn   ) import Distribution.System (Platform (..))@@ -49,8 +60,7 @@  import Distribution.Client.Errors import Distribution.Compat.Environment (getEnvironment)-import System.Directory (getCurrentDirectory)-import System.FilePath ((<.>), (</>))+import Distribution.Utils.Path  -- | Return the executable to run and any extra arguments that should be -- forwarded to it. Die in case of error.@@ -133,42 +143,61 @@ -- | Run a given executable. run :: Verbosity -> LocalBuildInfo -> Executable -> [String] -> IO () run verbosity lbi exe exeArgs = do-  curDir <- getCurrentDirectory-  let buildPref = buildDir lbi+  let distPref = fromFlag $ configDistPref $ configFlags lbi+      buildPref = buildDir lbi       pkg_descr = localPkgDescr lbi-      dataDirEnvVar =-        ( pkgPathEnvVar pkg_descr "datadir"-        , curDir </> dataDir pkg_descr-        )+      i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path+      mbWorkDir = mbWorkDirLBI lbi+      internalPkgDb = internalPackageDBPath lbi distPref+      lbiForExe =+        lbi+          { withPackageDB = withPackageDB lbi ++ [SpecificPackageDB internalPkgDb]+          , -- Include any build-tool-depends on build tools internal to the current package.+            withPrograms =+              addInternalBuildTools+                pkg_descr+                lbi+                (buildInfo exe)+                (withPrograms lbi)+          }    (path, runArgs) <-     let exeName' = prettyShow $ exeName exe-     in case compilerFlavor (compiler lbi) of+     in case compilerFlavor (compiler lbiForExe) of           GHCJS -> do             let (script, cmd, cmdArgs) =                   GHCJS.runCmd-                    (withPrograms lbi)-                    (buildPref </> exeName' </> exeName')+                    (withPrograms lbiForExe)+                    (i buildPref </> exeName' </> exeName')             script' <- tryCanonicalizePath script             return (cmd, cmdArgs ++ [script'])           _ -> do             p <-               tryCanonicalizePath $-                buildPref </> exeName' </> (exeName' <.> exeExtension (hostPlatform lbi))+                i buildPref </> exeName' </> (exeName' <.> exeExtension (hostPlatform lbiForExe))             return (p, []) -  env <- (dataDirEnvVar :) <$> getEnvironment+  -- Compute the appropriate environment for running the executable+  existingEnv <- getEnvironment+  let progDb = withPrograms lbiForExe+      pathVar = progSearchPath progDb+      envOverrides = progOverrideEnv progDb+  newPath <- programSearchPathAsPATHVar pathVar+  overrideEnv <- fromMaybe [] <$> getEffectiveEnvironment ([("PATH", Just newPath)] ++ envOverrides)+  let env = overrideEnv ++ existingEnv+   -- Add (DY)LD_LIBRARY_PATH if needed   env' <--    if withDynExe lbi+    if withDynExe lbiForExe       then do-        let (Platform _ os) = hostPlatform lbi-        clbi <- case componentNameTargets' pkg_descr lbi (CExeName (exeName exe)) of+        let (Platform _ os) = hostPlatform lbiForExe+        clbi <- case componentNameTargets' pkg_descr lbiForExe (CExeName (exeName exe)) of           [target] -> return (targetCLBI target)           [] -> dieWithException verbosity CouldNotFindExecutable           _ -> dieWithException verbosity FoundMultipleMatchingExes-        paths <- depLibraryPaths True False lbi clbi+        paths <- depLibraryPaths True False lbiForExe clbi         return (addLibraryPath os paths env)       else return env+   notice verbosity $ "Running " ++ prettyShow (exeName exe) ++ "..."-  rawSystemExitWithEnv verbosity path (runArgs ++ exeArgs) env'+  rawSystemExitWithEnvCwd verbosity mbWorkDir path (runArgs ++ exeArgs) env'

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} @@ -28,7 +29,8 @@   , loadConfig   ) import Distribution.Client.Setup-  ( ConfigFlags (..)+  ( CommonSetupFlags (..)+  , ConfigFlags (..)   , GlobalFlags (..)   , configCompilerAux'   )@@ -56,8 +58,14 @@   , fromFlagOrDefault   ) import Distribution.System (Platform)+import Distribution.Utils.Path hiding+  ( (<.>)+  , (</>)+  ) -import System.Directory (getCurrentDirectory)+import System.Directory+  ( getCurrentDirectory+  )  -- * Basic sandbox functions. @@ -116,11 +124,11 @@       return config'  -- | Return the saved \"dist/\" prefix, or the default prefix.-findSavedDistPref :: SavedConfig -> Flag FilePath -> IO FilePath+findSavedDistPref :: SavedConfig -> Flag (SymbolicPath Pkg (Dir Dist)) -> IO (SymbolicPath Pkg (Dir Dist)) findSavedDistPref config flagDistPref = do   let defDistPref = useDistPref defaultSetupScriptOptions       flagDistPref' =-        configDistPref (savedConfigureFlags config)+        (setupDistPref (configCommonFlags $ savedConfigureFlags config))           `mappend` flagDistPref   findDistPref defDistPref flagDistPref' @@ -134,8 +142,9 @@   :: ConfigFlags   -> IO (Compiler, Platform, ProgramDb) getPersistOrConfigCompiler configFlags = do-  distPref <- findDistPrefOrDefault (configDistPref configFlags)-  mlbi <- maybeGetPersistBuildConfig distPref+  let common = configCommonFlags configFlags+  distPref <- findDistPrefOrDefault (setupDistPref common)+  mlbi <- maybeGetPersistBuildConfig (flagToMaybe $ setupWorkingDir common) distPref   case mlbi of     Nothing -> do configCompilerAux' configFlags     Just lbi ->